16_STACKABLE.pm: successor of STACKABLE_CC added

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

fhem/FHEM/00_CUL.pm

@@ -45,7 +45,7 @@ my %sets = (
 
 my @ampllist = (24, 27, 30, 33, 36, 38, 40, 42); # rAmpl(dB)
 
-my $sccMods = "STACKABLE_CC:TSSTACKED"; # for noansi
+my $sccMods = "STACKABLE_CC:TSSTACKED:STACKABLE";
 my $culNameRe = "^(CUL|TSCUL)\$";
 
 my $clientsSlowRF    = ":FS20:FHT.*:KS300:USF1000:BS:HMS: ".
@@ -80,6 +80,7 @@ my %matchListSlowRF = (
     "K:CUL_TCM97001"  => "^s[A-F0-9]+",
     "L:CUL_REDIRECT"  => "^o+",
     "M:TSSTACKED"=>"^\\*",
+    "N:STACKABLE"=>"^\\*",
 );
 
 my %matchListHomeMatic = (
@@ -88,6 +89,7 @@ my %matchListHomeMatic = (
     "D:CUL_IR"    => "^I............",
     "H:STACKABLE_CC"=>"^\\*",
     "M:TSSTACKED"=>"^\\*",
+    "N:STACKABLE"=>"^\\*",
 );
 
 my %matchListMAX = (
@@ -96,6 +98,7 @@ my %matchListMAX = (
     "D:CUL_IR"    => "^I............",
     "H:STACKABLE_CC"=>"^\\*",
     "M:TSSTACKED"=>"^\\*",
+    "N:STACKABLE"=>"^\\*",
 );
 
 my %matchListWMBus = (
@@ -104,6 +107,7 @@ my %matchListWMBus = (
     "D:CUL_IR"    => "^I............",
     "H:STACKABLE_CC"=>"^\\*",
     "M:TSSTACKED"=>"^\\*",
+    "N:STACKABLE"=>"^\\*",
 );
 
 my %matchListKOPP_FC = (
@@ -112,6 +116,7 @@ my %matchListKOPP_FC = (
     "D:CUL_IR"    => "^I............",
     "H:STACKABLE_CC"=>"^\\*",
     "M:TSSTACKED"=>"^\\*",
+    "N:STACKABLE"=>"^\\*",
 );
 
 
@@ -505,7 +510,7 @@ CUL_DoInit($)
     $fhtid =~ s/[\r\n]//g;
     Log3 $name, 5, "GOT CUL fhtid: $fhtid";
     if(!defined($fhtid) || $fhtid ne $hash->{FHTID}) {
-      Log3 $name, 2, "Setting CUL fhtid from $fhtid to " . $hash->{FHTID};
+      Log3 $name, 2, "Setting $name fhtid from $fhtid to " . $hash->{FHTID};
       CUL_SimpleWrite($hash, "T01" . $hash->{FHTID});
     }
   }
@@ -833,10 +838,6 @@ CUL_Parse($$$$@)
 {
   my ($hash, $iohash, $name, $rmsg, $initstr) = @_;
 
-  if($rmsg =~ m/^\*/) {                           # STACKABLE_CC
-    Dispatch($hash, $rmsg, undef);
-    return;
-  }
   if($rmsg =~ m/^V/) {                            # CUN* keepalive
     Log3 $name, 4, "CUL_Parse: $name $rmsg";
     return;
@@ -885,10 +886,6 @@ CUL_Parse($$$$@)
       $dmsg = sprintf("81%02x04xx0909a001%s00%s",
                        $len/2+7, substr($dmsg,1,6), substr($dmsg,7));
       $dmsg = lc($dmsg);
-
-    } else {
-      ;                                            # => 09_CUL_FHTTK.pm
-
     }
 
   } elsif($fn eq "H" && $len >= 13) {              # Reformat for 12_HMS.pm
@@ -920,16 +917,6 @@ CUL_Parse($$$$@)
     $dmsg = lc($dmsg);
   } elsif($fn eq "i" && $len >= 7) {              # IT
     $dmsg = lc($dmsg);
-  } elsif($fn eq "Y" && $len >= 3) {               # SOMFY RTS
-    ;
-  } elsif($fn eq "S" && $len >= 33) {              # CUL_ESA / ESA2000 / Native
-    ;
-  } elsif($fn eq "E" && $len >= 11) {              # CUL_EM / Native
-    ;
-  } elsif($fn eq "R" && $len >= 11) {              # CUL_HOERMANN / Native
-    ;
-  } elsif($fn eq "I" && $len >= 12) {              # IR-CUL/CUN/CUNO
-    ;
   } elsif($fn eq "A" && $len >= 20) {              # AskSin/BidCos/HomeMatic
     my $src = substr($dmsg,9,6);
     if($modules{CUL_HM}{defptr}{$src}){
@@ -944,16 +931,6 @@ CUL_Parse($$$$@)
     $dmsg .= "::$rssi" if (defined($rssi));
   } elsif($fn eq "t" && $len >= 5)  {              # TX3
     $dmsg = "TX".substr($dmsg,1);                  # t.* is occupied by FHTTK
-  } elsif($fn eq "s" && $len >= 5)  {              # CUL_TCM97001
-    ;
-  } elsif($fn eq "o" && $len >= 5)  {              # CUL_REDIRECT
-    ;
-  } elsif($fn eq "k" && $len >= 20) {              # KOPP_FC
-    ;
-  } else {
-    DoTrigger($name, "UNKNOWNCODE $dmsg");
-    Log3 $name, 2, "$name: unknown message $dmsg";
-    return;
   }
 
   $hash->{"${name}_MSGCNT"}++;
@@ -1005,23 +982,7 @@ CUL_SimpleWrite(@)
   my ($hash, $msg, $nonl) = @_;
   return if(!$hash);
   ($hash, $msg) = CUL_prefix(1, $hash, $msg);
-
+  DevIo_SimpleWrite($hash, $msg, 2, !$nonl);
-  my $name = $hash->{NAME};
-  if (AttrVal($name,"rfmode","") eq "HomeMatic"){
-    Log3 $name, 4, "CUL_send:  $name".join(" ",unpack('A2A2A2A4A6A6A*',$msg));
-  }
-  else{
-    Log3 $name, 5, "SW: $msg";
-  }
-
-  $msg .= "\n" unless($nonl);
-
-  $hash->{USBDev}->write($msg)    if($hash->{USBDev});
-  syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
-  syswrite($hash->{DIODev}, $msg) if($hash->{DIODev});
-
-  # Some linux installations are broken with 0.001, T01 returns no answer
-  select(undef, undef, undef, 0.01);
 }
 
 sub

fhem/FHEM/00_ZWCUL.pm

@@ -20,7 +20,6 @@ sub ZWCUL_Parse($$$$$);
 sub ZWCUL_Read($@);
 sub ZWCUL_ReadAnswer($$$);
 sub ZWCUL_Ready($);
-sub ZWCUL_SimpleWrite($$);
 sub ZWCUL_Write($$$);
 sub ZWCUL_ProcessSendStack($);
 
@@ -89,9 +88,9 @@ ZWCUL_Define($$)
   setReadingsVal($hash, "homeId",       # ZWDongle compatibility
           "HomeId:$hash->{homeId} CtrlNodeIdHex:$hash->{nodeIdHex}", TimeNow());
 
-  $hash->{Clients} = ":ZWave:STACKABLE_CC:";
+  $hash->{Clients} = ":ZWave:STACKABLE:";
   my %matchList = ( "1:ZWave" => ".*",
-                    "2:STACKABLE_CC"=>"^\\*");
+                    "2:STACKABLE"=>"^\\*" );
   $hash->{MatchList} = \%matchList;
 
   if($dev eq "none") {
@@ -127,7 +126,7 @@ ZWCUL_DoInit($)
 
   my ($err, $ver, $try) = ("", "", 0);
   while($try++ < 3 && $ver !~ m/^V/) {
-    ZWCUL_SimpleWrite($hash, "V");
+    DevIo_SimpleWrite($hash, "V\n", 2);
     ($err, $ver) = ZWCUL_ReadAnswer($hash, "Version", "^V");
     return "$name: $err" if($err && ($err !~ m/Timeout/ || $try == 3));
     $ver = "" if(!$ver);
@@ -141,8 +140,8 @@ ZWCUL_DoInit($)
   $ver =~ s/[\r\n]//g;
   $hash->{VERSION} = $ver;
 
-  ZWCUL_SimpleWrite($hash, "zi".$hash->{homeIdSet}.$hash->{nodeIdHex});
+  DevIo_SimpleWrite($hash, "zi".$hash->{homeIdSet}.$hash->{nodeIdHex}."\n", 2);
-  ZWCUL_SimpleWrite($hash, $hash->{initString});
+  DevIo_SimpleWrite($hash, $hash->{initString}."\n", 2);
 
   readingsSingleUpdate($hash, "state", "Initialized", 1);
   return undef;
@@ -154,7 +153,7 @@ sub
 ZWCUL_Undef($$) 
 {
   my ($hash,$arg) = @_;
-  ZWCUL_SimpleWrite($hash, "zx");
+  DevIo_SimpleWrite($hash, "zx\n", 2);
   DevIo_CloseDev($hash); 
   return undef;
 }
@@ -164,7 +163,7 @@ ZWCUL_tmp9600($$)
 {
   my ($hash, $on) = @_;
   $hash->{baudRate} = ($on ? "9600" : AttrVal($hash->{NAME},"dataRate","40k"));
-  ZWCUL_SimpleWrite($hash, $on ? $on : $hash->{initString});
+  DevIo_SimpleWrite($hash, ($on ? $on : $hash->{initString})."\n", 2);
 }
 
 #####################################
@@ -243,7 +242,7 @@ ZWCUL_cmd($$@)
   }
 
   $cmd = sprintf($cmd, @a);
-  ZWCUL_SimpleWrite($hash,  $cmd);
+  DevIo_SimpleWrite($hash,  $cmd."\n", 2);
   
   return undef if($type eq "set");
 
@@ -256,23 +255,6 @@ ZWCUL_cmd($$@)
 sub ZWCUL_Set() { return ZWCUL_cmd("set", \%sets, @_); };
 sub ZWCUL_Get() { return ZWCUL_cmd("get", \%gets, @_); };
 
-#####################################
-sub
-ZWCUL_SimpleWrite($$)
-{
-  my ($hash, $msg) = @_;
-  return if(!$hash);
-
-  my $name = $hash->{NAME};
-  Log3 $name, 5, "SW: $msg";
-  $msg .= "\n";
-
-  $hash->{USBDev}->write($msg)    if($hash->{USBDev});
-  syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
-  syswrite($hash->{DIODev}, $msg) if($hash->{DIODev});
-  select(undef, undef, undef, 0.001);
-}
-
 #####################################
 sub
 ZWCUL_Write($$$)
@@ -302,7 +284,11 @@ ZWCUL_Write($$$)
                     length($p)/2+($s100 ? 11 : 10), $targetId, $p);
     $msg .= ($s100 ? zwlib_checkSum_16($msg) : zwlib_checkSum_8($msg));
 
-    ZWCUL_SimpleWrite($hash, "zs".$msg);
+    DevIo_SimpleWrite($hash, "zs".$msg, 2);
+
+  } elsif($hash->{STACKED}) {      
+    DevIo_SimpleWrite($hash, $msg, 2);
+
   }
 }
 
@@ -380,7 +366,7 @@ ZWCUL_Parse($$$$$)
 {
   my ($hash, $iohash, $name, $rmsg, $nodispatch) = @_;
 
-  if($rmsg =~ m/^\*/) {                           # STACKABLE_CC
+  if($rmsg =~ m/^\*/) {                           # STACKABLE
     Dispatch($hash, $rmsg, undef);
     return;
   }
@@ -626,7 +612,7 @@ ZWCUL_Attr($$$$)
               ($value eq "9600" ? "9" : "4"));
     $hash->{initString} = ($hash->{homeIdSet} =~ m/^0*$/ ? "zm$sfx":"zr$sfx");
     $hash->{baudRate} = $value;
-    ZWCUL_SimpleWrite($hash, $hash->{initString});
+    DevIo_SimpleWrite($hash, $hash->{initString}, 2);
 
   }
 

fhem/FHEM/16_STACKABLE.pm

@@ -0,0 +1,217 @@
+##############################################
+# $Id$
+package main;
+use strict;
+use warnings;
+
+#####################################
+sub
+STACKABLE_Initialize($)
+{
+  my ($hash) = @_;
+  $hash->{Match}     = "^\\*";
+  $hash->{DefFn}     = "STACKABLE_Define";
+  $hash->{UndefFn}   = "STACKABLE_Undef";
+  $hash->{ParseFn}   = "STACKABLE_Parse";
+  $hash->{NotifyFn}  = "STACKABLE_Notify";
+  $hash->{AttrList}  = "IODev ignore:1,0 binary:1,0 writePrefix";
+
+  $hash->{noRawInform} = 1;     # Our message was already sent as raw.
+  $hash->{noAutocreatedFilelog} = 1;
+
+  $hash->{IOOpenFn}  = "STACKABLE_IOOpenFn";
+  $hash->{IOReadFn}  = "STACKABLE_IOReadFn";
+  $hash->{IOWriteFn} = "STACKABLE_IOWriteFn";
+}
+
+
+#####################################
+sub
+STACKABLE_Define($$)
+{
+  my ($hash, $def) = @_;
+  my @a = split("[ \t][ \t]*", $def);
+
+  return "wrong syntax: define <name> STACKABLE baseDevice"
+    if(int(@a) != 3);
+
+  my $io = $defs{$a[2]};
+  return "$a[2] is not a valid device"
+    if(!$io);
+  return "$io->{NAME} already has a stacked device: $io->{STACKED}"
+    if($io->{STACKED});
+
+  $io->{STACKED} = $hash->{NAME};
+  $hash->{IODev} = $io;
+  delete($io->{".clientArray"}); # Force a recompute
+  $hash->{STATE} = "Defined";
+  notifyRegexpChanged($hash, $a[2]);
+
+  return undef;
+}
+
+#####################################
+sub
+STACKABLE_Parse($$)
+{
+  my ($iohash,$msg) = @_;
+
+  return "UNDEFINED $iohash->{NAME}_STACKABLE STACKABLE $iohash->{NAME}"
+    if(!$iohash->{STACKED});
+
+  my $name = $iohash->{STACKED};
+  return "" if(IsIgnored($name));
+
+  $msg =~ s/^.//; # Cut off prefix *
+  my $sh = $defs{$name};
+
+  my $ch = $sh->{".clientHash"};
+  if($ch) {
+    delete $ch->{IOReadFn};
+    $ch->{IODevRxBuffer} = (AttrVal($name,"binary",0) ?
+                                pack("H*",$msg) : $msg."\n");
+    CallFn($ch->{NAME}, "ReadFn", $ch);
+    $ch->{IOReadFn} = "STACKABLE_IOReadFn";
+  } else {
+    Log 1, "$name: no client device assigned";
+  }
+  return "";
+}
+
+sub
+STACKABLE_Undef($$)
+{
+  my ($hash, $arg) = @_;
+  delete $hash->{IODev}{STACKED};
+  return undef;
+}
+
+sub
+STACKABLE_Notify($$)
+{
+  my ($me, $src) = @_;
+
+  my $eva = deviceEvents($src,0);
+  return undef if(!$eva || !@$eva);
+  my $evt = $eva->[0];
+  my $tgt = $me->{".clientHash"};
+
+  if($evt eq "DISCONNECTED") {
+    DevIo_Disconnected($tgt);
+    my ($dev, undef) = split("@", $tgt->{DeviceName});
+    delete $readyfnlist{"$tgt->{NAME}.$dev"}; # no polling by child devices
+    delete $tgt->{DevIoJustClosed};
+
+  } elsif($evt eq "CONNECTED") {
+    CallFn($tgt->{NAME}, "ReadyFn", $tgt);
+
+  }
+  return undef;
+}
+
+sub
+STACKABLE_IOOpenFn($)
+{
+  my ($hash) = @_;
+  $hash->{FD} = $hash->{IODev}{IODev}{FD};     # Lets fool the client
+  $hash->{IODev}{".clientHash"} = $hash;
+  $hash->{IOReadFn} = "STACKABLE_IOReadFn";
+  return 1;
+}
+
+sub
+STACKABLE_IOReadFn($) # used by synchronuous get
+{
+  my ($hash) = @_;
+  my $me = $hash->{IODev};
+  my $buf = "";
+  while($buf !~ m/\n/) {
+    $buf .= DevIo_SimpleRead($me->{IODev}); # may block
+  }
+  $buf =~ s/^.//;
+  if(AttrVal($me->{NAME},"binary",0)) {
+    $buf =~ s/[\r\n]//g;
+    return pack("H*",$buf);
+  } else {
+    return $buf;
+  }
+}
+
+sub
+STACKABLE_IOWriteFn($$)
+{
+  my ($hash, $msg) = @_;
+  my $myhash = $hash->{IODev};
+  my $myname = $myhash->{NAME};
+
+  my $prf = AttrVal($myname,"writePrefix","*");
+  if(AttrVal($myname,"binary",0)) {
+    return IOWrite($myhash, "", $prf.unpack("H*",$msg));
+  } else {
+    $msg =~ s/[\r\n]//g;
+    return IOWrite($myhash, "", $prf.$msg);
+  }
+}
+
+1;
+
+
+=pod
+=item summary    Module for stacked IO devices like the Busware SCC
+=item summary_DE Modul fuer gestapelte IO Ger&auml;te wie das Busware SCC
+=begin html
+
+<a name="STACKABLE"></a>
+<h3>STACKABLE</h3>
+<ul>
+  This module is a more generic version of the STACKABLE_CC module, and is used
+  for stacked IO devices like the Busware SCC. It works by adding/removing a
+  prefix (default is *) to the command, and redirecting the output to the
+  module, which is using it.
+
+  <a name="STACKABLEdefine"></a>
+  <b>Define</b>
+  <ul>
+    <code>define &lt;name&gt; STACKABLE &lt;baseDevice&gt;</code> <br>
+    <br>
+    &lt;baseDevice&gt; is the name of the unterlying device.<br>
+    Example:
+    <ul><code>
+      define CUL_1 CUL /dev/ttyAMA0@38400<br>
+      attr   CUL_1 rfmode SlowRF<br><br>
+      define CUL_1_SCC STACKABLE CUL1<br>
+      define CUL_2 CUL FHEM:DEVIO:CUL_1_SCC:9600 0000<br>
+      attr   CUL_2 rfmode HomeMatic<br><br>
+      define CUL_2_SCC STACKABLE CUL2<br>
+      define CUL_3 ZWCUL FHEM:DEVIO:CUL_2_SCC:9600 12345678 01<br>
+    </code></ul>
+    <b>Note:</b>If you rename the base CUL or a STACKABLE, which is a base for
+    another one, the definition of the next one has to be adjusted, and FHEM
+    has to be restarted.
+  </ul>
+
+  <a name="STACKABLEset"></a>
+  <b>Set</b> <ul>N/A</ul><br>
+
+  <a name="STACKABLEget"></a>
+  <b>Get</b> <ul>N/A</ul><br>
+
+  <a name="STACKABLEattr"></a>
+  <b>Attributes</b>
+  <ul>
+    <li><a name="#writePrefix">writePrefix</a><br>
+      The prefix used when writing data, default is *.
+      "readPrefix" is hardcoded to *.
+      </li><br>
+
+    <li><a name="#binary">binary</a><br>
+      If set to true, read data is converted to binary from hex before offering
+      it to the client IO device (e.g. TCM). Default is 0 (off).
+      </li><br>
+  </ul>
+</ul>
+
+=end html
+
+
+=cut

fhem/FHEM/DevIo.pm

@@ -9,7 +9,7 @@ sub DevIo_OpenDev($$$;$);
 sub DevIo_SetHwHandshake($);
 sub DevIo_SimpleRead($);
 sub DevIo_SimpleReadWithTimeout($$);
-sub DevIo_SimpleWrite($$$);
+sub DevIo_SimpleWrite($$$;$);
 sub DevIo_TimeoutRead($$);
 
 sub
@@ -115,15 +115,16 @@ DevIo_TimeoutRead($$)
 ########################
 # Input is HEX, with header and CRC
 sub
-DevIo_SimpleWrite($$$)
+DevIo_SimpleWrite($$$;$)
 {
-  my ($hash, $msg, $type) = @_; # Type: 0:binary, 1:hex, 2:ASCII
+  my ($hash, $msg, $type, $addnl) = @_; # Type: 0:binary, 1:hex, 2:ASCII
   return if(!$hash);
 
   my $name = $hash->{NAME};
   Log3 ($name, 5, $type ? "SW: $msg" : "SW: ".unpack("H*",$msg));
 
   $msg = pack('H*', $msg) if($type && $type == 1);
+  $msg .= "\n" if($addnl);
   if($hash->{USBDev}){
     $hash->{USBDev}->write($msg);