From 8ed0ec6d7e9ee6726adb408b459ba3011aa3dde3 Mon Sep 17 00:00:00 2001
From: odroegehorn <>
Date: Sun, 16 Oct 2011 13:32:35 +0000
Subject: [PATCH] IR-Send Update in CUL_IR

git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@1077 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
 FHEM/10_CUL_IR.pm | 284 +++++++++++++++++++++++++---------------------
 1 file changed, 156 insertions(+), 128 deletions(-)

diff --git a/FHEM/10_CUL_IR.pm b/FHEM/10_CUL_IR.pm
index d765a30e8..f9d422d9c 100644
--- a/FHEM/10_CUL_IR.pm
+++ b/FHEM/10_CUL_IR.pm
@@ -14,13 +14,14 @@ sub CUL_IR_Define($$);
 sub CUL_IR_Undef($$);
 sub CUL_IR_Initialize($);
 sub CUL_IR_Parse($$);
-#sub CUL_IR_SendCmd($$$$);
+sub CUL_IR_SendCmd($$);
 sub CUL_IR_Set($@);
 sub CUL_IR_Attr(@);
 
 
 my %sets = (
-  "irLearnForSec" => ""
+  "irLearnForSec" => "",
+  "irSend" => ""
 );
 
 
@@ -34,7 +35,7 @@ CUL_IR_Initialize($)
   $hash->{UndefFn}   = "CUL_IR_Undef";  
   $hash->{ParseFn}   = "CUL_IR_Parse";
   $hash->{SetFn}     = "CUL_IR_Set";
-  $hash->{AttrFn}  	 = "CUL_IR_Attr";  
+  $hash->{AttrFn}       = "CUL_IR_Attr";  
   $hash->{AttrList}  = "do_not_notify:1,0 ignore:0,1 " .
                        "loglevel:0,1,2,3,4,5,6 learnprefix learncount " .
                        "Button.* Group.* irReceive:OFF,ON,ON_NR";
@@ -56,55 +57,55 @@ CUL_IR_Define($$)
   #Assign CUL/CUN within definition as IODev
   for my $p (sort { $defs{$b}{NR} <=> $defs{$a}{NR} } keys %defs) {
   
-  	my $cl = $defs{$p}{Clients};
-	  $cl = $modules{$defs{$p}{TYPE}}{Clients} if(!$cl);
+      my $cl = $defs{$p}{Clients};
+      $cl = $modules{$defs{$p}{TYPE}}{Clients} if(!$cl);
 
     if((defined($cl) && $cl =~ m/:CUL_IR:/) &&
        $defs{$p}{NAME} eq $a[2]) {    
-      	$hash->{IODev} = $defs{$p}; 
-      	last;  
-		}
-	}
-	if(!$hash->{IODev}) {
-  	Log 3, "No I/O device found for $hash->{NAME}";
-  	return "Wrong IODev specified or IODev doesn't support CUL_IR";
+          $hash->{IODev} = $defs{$p}; 
+          last;  
+        }
+    }
+    if(!$hash->{IODev}) {
+      Log 3, "No I/O device found for $hash->{NAME}";
+      return "Wrong IODev specified or IODev doesn't support CUL_IR";
   }
   
   #Check if we have already an CUL_IR Device for IODEV
   foreach my $name (keys %{ $modules{CUL_IR}{defptr} }) {
      $testhash = ($modules{CUL_IR}{defptr}{$name})
-    	if($modules{CUL_IR}{defptr}{$name}->{IODev} == $hash->{IODev});
+        if($modules{CUL_IR}{defptr}{$name}->{IODev} == $hash->{IODev});
   }
-	if ($testhash) {	#found another CUL_IR for this IODEV!!
-  	Log 2, "CUL_IR already defined for this I/O device";
-  	return "CUL_IR already defined for this I/O device, it's: $testhash->{NAME}";
-	}  
+    if ($testhash) {    #found another CUL_IR for this IODEV!!
+      Log 2, "CUL_IR already defined for this I/O device";
+      return "CUL_IR already defined for this I/O device, it's: $testhash->{NAME}";
+    }  
 
-	#Everything is fine, let's finish definition
+    #Everything is fine, let's finish definition
   $modules{CUL_IR}{defptr}{("IR_" . $a[2])} = $hash;
   $hash->{STATE} = "Initialized";
   if (!$attr{$hash->{NAME}}{'learnprefix'}) {
-  	$attr{$hash->{NAME}}{'learnprefix'} = "A";
+      $attr{$hash->{NAME}}{'learnprefix'} = "A";
   }
   if (!$attr{$hash->{NAME}}{'learncount'}) {
-  	$attr{$hash->{NAME}}{'learncount'} = 0;
+      $attr{$hash->{NAME}}{'learncount'} = 0;
   }
   
- 	Log 4, "Sending $hash->{IODev}->{NAME}: Ir";
+     Log 4, "Sending $hash->{IODev}->{NAME}: Ir";
   my $msg = CallFn($hash->{IODev}->{NAME}, "GetFn", $hash->{IODev}, (" ", "raw", "Ir"));
- 	Log 4, "Answer from $hash->{IODev}->{NAME}: $msg";
+     Log 4, "Answer from $hash->{IODev}->{NAME}: $msg";
 
   if ($msg =~ m/raw => 00/) {
-		$hash->{irReceive} = "OFF";
-	} elsif ($msg =~ m/raw => 01/) {
- 		$hash->{irReceive} = "ON";
- 	} elsif ($msg =~ m/raw => 02/) {
- 		$hash->{irReceive} = "ON_NR";
-	} elsif ($msg =~ m/No answer/) {
-  		$hash->{irReceive} = "NoAnswer";
+        $hash->{irReceive} = "OFF";
+    } elsif ($msg =~ m/raw => 01/) {
+         $hash->{irReceive} = "ON";
+     } elsif ($msg =~ m/raw => 02/) {
+         $hash->{irReceive} = "ON_NR";
+    } elsif ($msg =~ m/No answer/) {
+          $hash->{irReceive} = "NoAnswer";
   } else {
-  	Log 2, "CUL_IR IODev device didn't answer Ir command correctly: $msg";
-  	$hash->{irReceive} = "UNKNOWN";
+      Log 2, "CUL_IR IODev device didn't answer Ir command correctly: $msg";
+      $hash->{irReceive} = "UNKNOWN";
   }
    
   return undef;
@@ -137,64 +138,64 @@ CUL_IR_Parse($$)
       
   foreach my $name (keys %{ $modules{CUL_IR}{defptr} }) {
      $myhash = ($modules{CUL_IR}{defptr}{$name})
-    	if($modules{CUL_IR}{defptr}{$name}->{IODev} == $iohash);
+        if($modules{CUL_IR}{defptr}{$name}->{IODev} == $iohash);
   }
 
-	if(!$myhash) {
-		Log 4, "IR-Message from $iohash->{NAME}: $msg";
-  	Log 2, "No CUL_IR device found for $iohash->{NAME}, please define a new one";
-  	return "UNDEFINED CUL_IR_$iohash->{NAME} CUL_IR $iohash->{NAME}";
+    if(!$myhash) {
+        Log 4, "IR-Message from $iohash->{NAME}: $msg";
+      Log 2, "No CUL_IR device found for $iohash->{NAME}, please define a new one";
+      return "UNDEFINED CUL_IR_$iohash->{NAME} CUL_IR $iohash->{NAME}";
   }
 
- 	Log 4, "IR-Reception: $msg";
+     Log 4, "IR-Reception: $msg";
 
-	# Search for Button-Group
+    # Search for Button-Group
   foreach my $name (keys %{ $attr{$myhash->{NAME}} }) {
-   	if ($name =~ m/^Group.*/) {
-   		my ($ir, $cmd) = split("[ \t]", $attr{$myhash->{NAME}}{$name}, 2);
-   		if ($msg =~ m/$ir.*/) {
-  			if (!$cmd) {
-    			 Log 5, "Group found; IR:$ir Def:-";
-   			} else {
-     			 Log 5, "Group found; IR:$ir Def:$cmd";
-   			   AnalyzeCommandChain(undef, $cmd);
-   			}
-   		}
-  	}
+       if ($name =~ m/^Group.*/) {
+           my ($ir, $cmd) = split("[ \t]", $attr{$myhash->{NAME}}{$name}, 2);
+           if ($msg =~ m/$ir.*/) {
+              if (!$cmd) {
+                 Log 5, "Group found; IR:$ir Def:-";
+               } else {
+                  Log 5, "Group found; IR:$ir Def:$cmd";
+                  AnalyzeCommandChain(undef, $cmd);
+               }
+           }
+      }
   }
 
-	# Search for single Button(s)
+    # Search for single Button(s)
   foreach my $name (keys %{ $attr{$myhash->{NAME}} }) {
-   	if ($name =~ m/^Button.*/) {
-   		my ($ir, $cmd) = split("[ \t]", $attr{$myhash->{NAME}}{$name}, 2);
-   		if ($msg eq $ir) {
-   			$found++;
-   			if (!$cmd) {
-   			  Log 5, "Button found; IR:$ir Def:-";
-   			} else {
-   			  Log 5, "Button found; IR:$ir Def:$cmd";
-   			  AnalyzeCommandChain(undef, $cmd);
-   			}
-   		}
-  	}
+       if ($name =~ m/^Button.*/) {
+           my ($ir, $cmd) = split("[ \t]", $attr{$myhash->{NAME}}{$name}, 2);
+           if ($msg eq $ir) {
+               $found++;
+               if (!$cmd) {
+                 Log 5, "Button found; IR:$ir Def:-";
+               } else {
+                 Log 5, "Button found; IR:$ir Def:$cmd";
+                 AnalyzeCommandChain(undef, $cmd);
+               }
+           }
+      }
   }
   
-  if (!$found) {	# No Button identified yet !!
-  	if (!$myhash->{irLearn}) {  # OK, No Learning, then leave
-	  	return "";
-  	} else {	# Let's learn Buttons
-  		my $buttonname = "";
-  		if (!$attr{$myhash->{NAME}}{'learncount'}) {
-  			$attr{$myhash->{NAME}}{'learncount'} = 0;
-  		}
-  		if (!$attr{$myhash->{NAME}}{'learnprefix'}) {	# is the learnprefix there?
-  			$buttonname = sprintf("Button%03d", $attr{$myhash->{NAME}}{'learncount'});  	
-  		} else {
-				$buttonname = sprintf("Button%s%03d", $attr{$myhash->{NAME}}{'learnprefix'}, $attr{$myhash->{NAME}}{'learncount'});  	
-			}
-			$attr{$myhash->{NAME}}{'learncount'}++;	
-			$attr{$myhash->{NAME}}{$buttonname} = $msg;
-  	}
+  if (!$found) {    # No Button identified yet !!
+      if (!$myhash->{irLearn}) {  # OK, No Learning, then leave
+          return "";
+      } else {    # Let's learn Buttons
+          my $buttonname = "";
+          if (!$attr{$myhash->{NAME}}{'learncount'}) {
+              $attr{$myhash->{NAME}}{'learncount'} = 0;
+          }
+          if (!$attr{$myhash->{NAME}}{'learnprefix'}) {    # is the learnprefix there?
+              $buttonname = sprintf("Button%03d", $attr{$myhash->{NAME}}{'learncount'});      
+          } else {
+                $buttonname = sprintf("Button%s%03d", $attr{$myhash->{NAME}}{'learnprefix'}, $attr{$myhash->{NAME}}{'learncount'});      
+            }
+            $attr{$myhash->{NAME}}{'learncount'}++;    
+            $attr{$myhash->{NAME}}{$buttonname} = $msg;
+      }
   }
 
   return "";
@@ -215,7 +216,7 @@ CUL_IR_Set($@)
 
   return "\"set CUL_IR\" needs at least one parameter" if(@a < 2);
   return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
-  	if(!defined($sets{$a[1]}));
+      if(!defined($sets{$a[1]}));
 
   my $name = shift @a;
   my $type = shift @a;
@@ -231,42 +232,69 @@ CUL_IR_Set($@)
     InternalTimer(gettimeofday()+$arg, "CUL_IR_RemoveIRLearn", $hash, 1);
   } 
   
+  if($type eq "irSend") { ####################################
+    return "Usage: set $name irSend <IR-Code | ButtonName>"
+        if(!$arg || $arg !~ m/^\w+$/); 
+        CUL_IR_SendCmd ($hash, $arg);
+  } 
+
   return $ret;
 }
 
     
 ###################################
-#sub
-#CUL_IR_SendCmd($$$$)
-#{
-#  my ($hash, $cmd, $sleep, $waitforack) = @_;
-#  my $io = $hash->{IODev};
-#  my $l4 = GetLogLevel($hash->{NAME},4);
-#
-#  select(undef, undef, undef, 0.1*$sleep) if($sleep);
-#
-#  $cmd =~ m/^(..)(.*)$/;
-#  my ($mn, $cmd2) = ($1, $2);
-#
-#  if($mn eq "++") {
-#    $mn = $io->{HM_CMDNR} ? ($io->{HM_CMDNR} +1) : 1;
-#    $mn = 0 if($mn > 255);
+sub
+CUL_IR_SendCmd($$)
+{
+  my ($hash, $arg) = @_;
+  my $l4 = GetLogLevel($hash->{NAME},4);
+  my $found  = 0;
+  my $ir;
+  my $cmd;
+  my $bcmd;
 
-#  } else {
-#    $mn = hex($mn);
-
-#  }
-
-#  $io->{HM_CMDNR} = $mn;
-#  $cmd = sprintf("As%02X%02x%s", length($cmd2)/2+1, $mn, $cmd2);
-#  Log $l4, "CUL_IR SEND $cmd";
-#  IOWrite($hash, "", $cmd);
-#  if($waitforack) {
-#    $hash->{ackWaiting} = $cmd;
-#    $hash->{ackCmdSent} = 1;
-#    InternalTimer(gettimeofday()+0.4, "CUL_IR_Resend", $hash, 0);
-#  }
-#}
+  if ($arg =~ m/^Button.*/) {        #Argument is a ButtonName
+      # Search for single Button(s)
+      foreach my $name (keys %{ $attr{$hash->{NAME}} }) {
+           if ($name eq $arg) {
+               ($ir, $bcmd) = split("[ \t]", $attr{$hash->{NAME}}{$name}, 2);
+               $found++;
+           }
+      }
+      if (!$found) { 
+          Log 2, "$hash->{NAME}->irSend: No Button found with name $arg, please define/learn a new one";
+          return "$hash->{NAME}: Unknown button name $arg";
+      }
+      $cmd = sprintf("Is%s", substr($ir, 1));
+  } else {
+      if (length ($arg) == 12) {
+          if ($arg  =~ m/^[0-9A-F]+$/) {
+              $cmd = sprintf("Is%s", $arg);
+          } else {
+                  Log 2, "$hash->{NAME}->irSend: Wrong IR-Code";
+                  return "$hash->{NAME}: Wrong IR-Code";
+          }
+      } elsif (length ($arg) == 13) {
+              if (substr($arg, 0, 1) eq "I") {
+                  if (substr($arg, 1) =~ m/^[0-9A-F]+$/) {
+                      $cmd = sprintf("Is%s", substr($arg, 1));
+                  } else {
+                          Log 2, "$hash->{NAME}->irSend: Wrong IR-Code";
+                          return "$hash->{NAME}: Wrong IR-Code";
+                  }
+              } else {
+                  Log 2, "$hash->{NAME}->irSend: Wrong IR-Code";
+                  return "$hash->{NAME}: Wrong IR-Code";
+              }
+      } else {
+              Log 2, "$hash->{NAME}->irSend: Wrong IR-Code";
+              return "$hash->{NAME}: Wrong IR-Code";
+      }
+          
+  }
+  Log $l4, "$hash->{NAME} SEND $cmd";
+  IOWrite($hash, "", $cmd);
+}
 
 sub
 CUL_IR_Attr(@)
@@ -280,31 +308,31 @@ CUL_IR_Attr(@)
     my $reccommand = "";
 
     if($a[3] eq "OFF") {
-    	$reccommand = "00";
+        $reccommand = "00";
     } elsif ($a[3] eq "ON") {
-    	$reccommand = "01";
+        $reccommand = "01";
     } else {
-    	$reccommand = "02";    	
+        $reccommand = "02";        
     }
 
-	  my $io = $hash->{IODev};
-	    	
-  	Log 4, "Sending $io->{NAME}: Ir$reccommand";
-	  my $msg = CallFn($io->{NAME}, "GetFn", $io, (" ", "raw", "Ir".$reccommand));
-  	Log 4, "Answer from $io->{NAME}: $msg";
+      my $io = $hash->{IODev};
+            
+      Log 4, "Sending $io->{NAME}: Ir$reccommand";
+      my $msg = CallFn($io->{NAME}, "GetFn", $io, (" ", "raw", "Ir".$reccommand));
+      Log 4, "Answer from $io->{NAME}: $msg";
 
     if ($msg =~ m/raw => 00/) {
-  		$hash->{irReceive} = "OFF";
-  	} elsif ($msg =~ m/raw => 01/) {
-  		$hash->{irReceive} = "ON";
-  	} elsif ($msg =~ m/raw => 02/) {
-  		$hash->{irReceive} = "ON_NR";
-  	} elsif ($msg =~ m/No answer/) {
-  		$hash->{irReceive} = "NoAnswer";
-	  } else {
-  		Log 2, "CUL_IR IODev device didn't answer Ir command correctly: $msg";
-  		$hash->{irReceive} = "UNKNOWN";
-  	}
+          $hash->{irReceive} = "OFF";
+      } elsif ($msg =~ m/raw => 01/) {
+          $hash->{irReceive} = "ON";
+      } elsif ($msg =~ m/raw => 02/) {
+          $hash->{irReceive} = "ON_NR";
+      } elsif ($msg =~ m/No answer/) {
+          $hash->{irReceive} = "NoAnswer";
+      } else {
+          Log 2, "CUL_IR IODev device didn't answer Ir command correctly: $msg";
+          $hash->{irReceive} = "UNKNOWN";
+      }
 
     Log 2, "Switched $name irReceive to $hash->{irReceive}";