pilight_xyz: send raw code, setExtensions

git-svn-id: https://svn.fhem.de/fhem/trunk@8994 2b470e98-0d58-463d-a4d8-8e2adae1ed80

fhem/CHANGED

@@ -1,5 +1,8 @@
 # Add changes at the top of the list. Keep it in ASCII, and 80-char wide.
 # Do not insert empty lines here, update check depends on it.
+  - feature: 30_pilight_dimmer.pm: SetExtensions (on-for-timer, etc.)
+  - feature: 30_pilight_switch.pm: SetExtensions (on-for-timer, etc.)
+  - feature: 30_pilight_raw.pm: send raw codes to pilight
   - feature: 95_Dashboard: added new attribute dashboard_tabXdevices which
                supports devspec definitions for shown dashboard groups.
                Storage of current opened tab and restore when opening dashboard.

fhem/FHEM/10_pilight_ctrl.pm

@@ -1,5 +1,5 @@
 ##############################################
-# $Id: 10_pilight_ctrl.pm 1.08 2015-06-23 Risiko $
+# $Id: 10_pilight_ctrl.pm 1.09 2015-07-21 Risiko $
 #
 # Usage
 # 
@@ -33,6 +33,7 @@
 # V 1.07 2015-06-23 - FIX:  reading state always contains a valid value, checking reading state removed
 # V 1.08 2015-06-23 - FIX:  clear send queue by reset
 # V 1.08 2015-06-23 - NEW:  attribute SendTimeout for abort sending command non blocking
+# V 1.09 2015-07-21 - NEW:  support submodule pilight_raw to send raw codes
 ############################################## 
 package main;
 
@@ -54,7 +55,8 @@ sub pilight_ctrl_Reset($);
 my %sets = ( "reset:noArg" => "", "disconnect:noArg" => "");
 my %matchList = ( "1:pilight_switch" => "^PISWITCH",
                   "2:pilight_dimmer" => "^PISWITCH|^PIDIMMER|^PISCREEN",
-                  "3:pilight_temp"   => "^PITEMP") ;
+                  "3:pilight_temp"   => "^PITEMP",
+                  "4:pilight_raw"    => "^PIRAW") ;
                   
 my @idList   = ("id","systemcode","gpio"); 
 my @unitList = ("unit","unitcode","programcode");
@@ -80,7 +82,7 @@ sub pilight_ctrl_Initialize($)
   $hash->{StateFn} = "pilight_ctrl_State";
   $hash->{AttrList}= "ignoreProtocol brands ContactAsSwitch SendTimeout ".$readingFnAttributes;
   
-  $hash->{Clients} = ":pilight_switch:pilight_dimmer:pilight_temp:";
+  $hash->{Clients} = ":pilight_switch:pilight_dimmer:pilight_temp:pilight_raw:";
   #$hash->{MatchList} = \%matchList; #only for autocreate
 }
 
@@ -387,8 +389,8 @@ sub pilight_ctrl_Write($@)
   my $id = $defs{$cName}->{ID};
   my $unit = $defs{$cName}->{UNIT};
   
-  $id = "\"".$id."\""   if (!isdigit($id));
+  $id = "\"".$id."\""     if (defined($id) && !isdigit($id));
-  $unit = "\"".$unit."\"" if (!isdigit($unit));
+  $unit = "\"".$unit."\"" if (defined($unit) && !isdigit($unit));
         
   my $code;
   switch($cType){
@@ -418,6 +420,9 @@ sub pilight_ctrl_Write($@)
         $code .= ",\"dimlevel\":$args[0]" if (defined($args[0]));
         $code .= "}";
     }
+    case m/raw/ {
+      $code = "{\"protocol\":[\"$proto\"],\"code\":\"$state\"}";
+    }
     else  {Log3 $me, 3, "$me(Write): unsupported client ($cName) -> $cType"; return;}
   }
   

fhem/FHEM/30_pilight_dimmer.pm

@@ -1,5 +1,5 @@
 ##############################################
-# $Id: 30_pilight_dimmer.pm 0.54 2015-05-30 Risiko $
+# $Id: 30_pilight_dimmer.pm 0.55 2015-07-27 Risiko $
 #
 # Usage
 # 
@@ -14,6 +14,7 @@
 # V 0.52 2015-05-25 - CHG: attributes dimlevel_on, dimlevel_off 
 # V 0.53 2015-05-30 - FIX: set dimlevel 0
 # V 0.54 2015-05-30 - FIX: StateFn
+# V 0.55 2015-07-27 - NEW: SetExtensions on-for-timer
 ############################################## 
 
 package main;
@@ -24,6 +25,8 @@ use Time::HiRes qw(gettimeofday);
 use JSON;
 use Switch;  #libswitch-perl
 
+use SetExtensions;
+
 sub pilight_dimmer_Initialize($)
 {
   my ($hash) = @_;
@@ -179,33 +182,37 @@ sub pilight_dimmer_ConvDimToDev($$)
 #####################################
 sub pilight_dimmer_Set($$)
 {  
-  my ($hash, @a) = @_;
+  my ($hash, $me, $cmd, @a) = @_;
-  my $me = shift @a;
+  
-
+  return "no set value specified" unless defined($cmd);
-  return "no set value specified" if(int(@a) < 1);
+  
   my $dimlevel_max_dev =  AttrVal($me, "dimlevel_max_device",15);
   my $dimlevel_step =  AttrVal($me, "dimlevel_step",1);  
   my $dimlevel_max =  AttrVal($me, "dimlevel_max",$dimlevel_max_dev);
   
-  my $canSet = "on:noArg off:noArg";
+  my %sets = ("on:noArg"=>0, "off:noArg"=>0);
-  $canSet .= " up:noArg down:noArg" if ($hash->{helper}{ISSCREEN});
+  $sets{"dimlevel:slider,0,$dimlevel_step,$dimlevel_max"} = 1;
   
-  return "Unknown argument ?, choose one of $canSet dimlevel:slider,0,$dimlevel_step,$dimlevel_max" if($a[0] eq "?");
+  $sets{"up:noArg"} = 0 if ($hash->{helper}{ISSCREEN});
+  $sets{"down:noArg"} = 0 if ($hash->{helper}{ISSCREEN});
+  
+  my @match = grep( $_ =~ /^$cmd($|:)/, keys %sets );
+  return SetExtensions($hash, join(" ", keys %sets), $me, $cmd, @a) unless @match == 1;
+  return "$cmd expects $sets{$match[0]} parameters" unless (@a eq $sets{$match[0]});
   
-  my $set = $a[0];
   my $dimlevel = undef;
   my $currlevel = ReadingsVal($me,"dimlevel",0);
   
-  if ($set =~ m/up|down/ and !$hash->{helper}{ISSCREEN}) {
+  if ($cmd =~ m/up|down/ and !$hash->{helper}{ISSCREEN}) {
     Log3 $me, 1, "$me(Set): up|down not supported";
     return undef;
   }
   
   if ($hash->{helper}{OWN_DIM} == 1) {
-    switch($set) {
+    switch($cmd) {
       case "dimlevel" {
-        $dimlevel = pilight_dimmer_ConvDimToDev($me,$a[1]);
+        $dimlevel = pilight_dimmer_ConvDimToDev($me,$a[0]);
-        $set = "on";
+        $cmd = "on";
       }
       case "on"   { 
         my $dimlevel_on = AttrVal($me, "dimlevel_on",$currlevel);
@@ -214,19 +221,19 @@ sub pilight_dimmer_Set($$)
       }
     }
   } else { # device without dimlevel support
-    switch($set) {
+    switch($cmd) {
       case "dimlevel" {
-        my $newlevel = $a[1];
+        my $newlevel = $a[0];
         my $cnt = int(($newlevel - $currlevel) / $dimlevel_step);      
         
         return undef if ($cnt==0);
-        $set = "up"  if ($cnt>0);
+        $cmd = "up"  if ($cnt>0);
-        $set = "down" if ($cnt<0);
+        $cmd = "down" if ($cnt<0);
         
         $cnt = abs($cnt) - 1; # correction for loop -1 
         
         if ($newlevel == 0) {
-          $set = "off";
+          $cmd = "off";
           $cnt=0; #break for loop
           my $dimlevel_off = AttrVal($me, "dimlevel_off",$newlevel);          
           readingsSingleUpdate($hash,"dimlevel",$dimlevel_off,1);
@@ -235,7 +242,7 @@ sub pilight_dimmer_Set($$)
         Log3 $me, 5, "$me(Set): cnt $cnt";
         
         for (my $i=0; $i < $cnt; $i++) {
-           pilight_dimmer_Write($hash,$set,undef);
+           pilight_dimmer_Write($hash,$cmd,undef);
         }
       }
       case "on" { 
@@ -257,9 +264,9 @@ sub pilight_dimmer_Set($$)
     }
   }
   
-  delete $hash->{helper}{DEV_DIMLEVEL} if ($set eq "off");
+  delete $hash->{helper}{DEV_DIMLEVEL} if ($cmd eq "off");
   
-  pilight_dimmer_Write($hash,$set,$dimlevel); 
+  pilight_dimmer_Write($hash,$cmd,$dimlevel); 
   #keinen Trigger bei Set auslösen
   #Aktualisierung erfolgt in Parse
   my $skipTrigger = 1; 
@@ -329,6 +336,9 @@ sub pilight_dimmer_State($$$$)
     <li>
       <b>dimlevel</b>
     </li>
+    <li>
+      <a href="#setExtensions">set extensions</a> are supported<br>
+    </li>
   </ul>
   <br>
   <a name="pilight_dimmer_readings"></a>

fhem/FHEM/30_pilight_raw.pm

@@ -0,0 +1,157 @@
+##############################################
+# $Id: 30_pilight_raw.pm 0.11 2015-07-27 Risiko $
+#
+# Usage
+# 
+# define <name> pilight_raw
+#
+# Changelog
+#
+# V 0.10 2015-07-21 - initial beta version
+# V 0.11 2015-07-27 - SetExtensions on-for-timer
+############################################## 
+
+package main;
+
+use strict;
+use warnings;
+use Switch;  #libswitch-perl
+
+use SetExtensions;
+
+my %sets = ("on:noArg"=>0, "off:noArg"=>0, "code:textField-long"=>1);
+
+sub pilight_raw_Parse($$);
+sub pilight_raw_Define($$);
+
+sub pilight_raw_Initialize($)
+{
+  my ($hash) = @_;
+
+  $hash->{DefFn}    = "pilight_raw_Define";
+  $hash->{Match}    = "^PIRAW";
+  $hash->{SetFn}    = "pilight_raw_Set";
+  $hash->{AttrList} = "onCode:textField-long offCode:textField-long ".$readingFnAttributes;
+}
+
+#####################################
+sub pilight_raw_Define($$)
+{
+  my ($hash, $def) = @_;
+  my @a = split("[ \t][ \t]*", $def);
+
+  if(@a < 2) {
+    my $msg = "wrong syntax: define <name> pilight_raw";
+    Log3 undef, 2, $msg;
+    return $msg;
+  }
+
+  my $me = $a[0];
+  
+  $hash->{PROTOCOL} = "raw"; 
+  #$attr{$me}{verbose} = 5;
+  
+  $modules{pilight_raw}{defptr}{"raw"}{$me} = $hash;
+  AssignIoPort($hash);
+  return undef;
+}
+
+#####################################
+sub pilight_raw_Set($$)
+{  
+  my ($hash, $me, $cmd, @a) = @_;
+
+  my $v = join(" ", @a);
+  Log3 $me, 4, "$me(Set): $v";
+  
+  #-- check argument
+  return "no set value specified" unless defined($cmd);
+  my @match = grep( $_ =~ /^$cmd($|:)/, keys %sets );
+  return SetExtensions($hash, join(" ", keys %sets), $me, $cmd, @a) unless @match == 1;
+  #return "$cmd expects $sets{$match[0]} parameters" unless (@a eq $sets{$match[0]});
+  
+  my $code_on = $attr{$me}{onCode};
+  my $code_off = $attr{$me}{offCode};
+  my $code = "";
+  my $updateReading = 0;
+  
+  switch($cmd){
+    case "on"    { $code = $code_on; $updateReading = 1;}
+    case "off"   { $code = $code_off; $updateReading = 1;}
+    case "code"  { $v =~ s/code//g; $code=$v;}
+  }  
+  
+  if($code eq "") {
+    Log3 $me, 2, "$me(Set): No value for code given"; 
+    return "No value for code given";
+  }
+  
+  my $msg = "$me,$code";
+  IOWrite($hash, $msg);
+  
+  readingsSingleUpdate($hash,"state",$cmd,1) if($updateReading == 1);
+  return undef;
+}
+
+
+1;
+
+=pod
+=begin html
+
+<a name="pilight_raw"></a>
+<h3>pilight_raw</h3>
+<ul>
+  With pilight_raw it si possible to send raw codes<br>
+  You have to define the base device pilight_ctrl first.<br>
+  <br>
+  <a name="pilight_raw_define"></a>
+  <b>Define</b>
+  <ul>
+    <code>define &lt;name&gt; pilight_raw</code>    
+  </ul>
+  <br>
+  <a name="pilight_raw_set"></a>
+  <p><b>Set</b></p>
+  <ul>
+    <li>
+      <b>on</b>
+      Send 'onCode' as raw code
+    </li>
+    <li>
+      <b>off</b>
+      Send 'offCode' as raw code
+    </li>
+    <li>
+      <b>code <value></b>
+      Send <value> as raw code
+    </li>
+    <li>
+      <a href="#setExtensions">set extensions</a> are supported<br>
+    </li>
+  </ul>  
+  <br>
+  <a name="pilight_raw_readings"></a>
+  <p><b>Readings</b></p>
+  <ul>    
+    <li>
+      state<br>
+      state on or off
+    </li>
+  </ul>
+  <br>
+  <a name="pilight_raw_attr"></a>
+  <b>Attributes</b>
+  <ul>
+    <li><a name="onCode">onCode</a><br>
+        raw code for state on
+    </li>
+    <li><a name="offCode">onCode</a><br>
+        raw code for state off
+    </li>
+  </ul>
+</ul>
+
+=end html
+
+=cut

fhem/FHEM/30_pilight_switch.pm

@@ -1,5 +1,5 @@
 ##############################################
-# $Id: 30_pilight_switch.pm 0.13 2015-05-30 Risiko $
+# $Id: 30_pilight_switch.pm 0.14 2015-07-27 Risiko $
 #
 # Usage
 # 
@@ -11,6 +11,7 @@
 # V 0.11 2015-03-29 - FIX:  $readingFnAttributes
 # V 0.12 2015-05-18 - FIX:  add version information
 # V 0.13 2015-05-30 - FIX:  StateFn, noArg
+# V 0.14 2015-07-27 - NEW:  SetExtensions on-for-timer
 ############################################## 
 
 package main;
@@ -20,6 +21,10 @@ use warnings;
 use Time::HiRes qw(gettimeofday);
 use JSON;
 
+use SetExtensions;
+
+my %sets = ("on:noArg"=>0, "off:noArg"=>0);
+
 sub pilight_switch_Parse($$);
 sub pilight_switch_Define($$);
 
@@ -111,19 +116,19 @@ sub pilight_switch_Parse($$)
 #####################################
 sub pilight_switch_Set($$)
 {  
-  my ($hash, @a) = @_;
+  my ($hash, $me, $cmd, @a) = @_;
-  my $me = shift @a;
+  return "no set value specified" unless defined($cmd);
-
-  return "no set value specified" if(int(@a) < 1);
-  return "Unknown argument ?, choose one of on:noArg off:noArg" if($a[0] eq "?");
-
-  my $v = join(" ", @a);
-  Log3 $me, 4, "$me(Set): $v";
-
-  #readingsSingleUpdate($hash,"state",$v,1);
   
-  my $msg = "$me,$v";
+  my @match = grep( $_ =~ /^$cmd($|:)/, keys %sets );
+  return SetExtensions($hash, join(" ", keys %sets), $me, $cmd, @a) unless @match == 1;
+  return "$cmd expects $sets{$match[0]} parameters" unless (@a eq $sets{$match[0]});
+  
+  my $v = join(" ", @a);
+  Log3 $me, 4, "$me(Set): $cmd $v";
+
+  my $msg = "$me,$cmd";
   IOWrite($hash, $msg);
+  
   #keinen Trigger bei Set auslösen
   #Aktualisierung erfolgt in Parse
   my $skipTrigger = 1; 
@@ -166,6 +171,9 @@ sub pilight_switch_Set($$)
     <li>
       <b>off</b>
     </li>
+    <li>
+      <a href="#setExtensions">set extensions</a> are supported<br>
+    </li>
   </ul>
   <br>
   <a name="pilight_switch_readings"></a>

fhem/MAINTAINER.txt

@@ -115,6 +115,7 @@ FHEM/30_ENECSYSGW.pm         akw                  http://forum.fhem.de Sonstige
 FHEM/30_pilight_dimmer.pm    risiko               http://forum.fhem.de Sonstige Systeme
 FHEM/30_pilight_switch.pm    risiko               http://forum.fhem.de Sonstige Systeme
 FHEM/30_pilight_temp.pm      risiko               http://forum.fhem.de Sonstige Systeme
+FHEM/30_pilight_raw.pm       risiko               http://forum.fhem.de Sonstige Systeme
 FHEM/31_HUEDevice.pm         justme1968           http://forum.fhem.de Beleuchtung
 FHEM/31_MilightDevice.pm     mattwire             http://forum.fhem.de Beleuchtung
 FHEM/31_ENECSYSINV.pm        akw                  http://forum.fhem.de Sonstige Systeme