# $Id$ ############################################################################## # # 67_ECMDDevice.pm # Copyright by Dr. Boris Neubert # e-mail: omega at online dot de # # This file is part of fhem. # # Fhem is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # Fhem is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with fhem. If not, see . # ############################################################################## package main; use strict; use warnings; use Time::HiRes qw(gettimeofday); sub ECMDDevice_Get($@); sub ECMDDevice_Set($@); sub ECMDDevice_Attr($@); sub ECMDDevice_Define($$); ################################### sub ECMDDevice_Initialize($) { my ($hash) = @_; $hash->{Match} = ".+"; $hash->{GetFn} = "ECMDDevice_Get"; $hash->{SetFn} = "ECMDDevice_Set"; $hash->{DefFn} = "ECMDDevice_Define"; $hash->{ParseFn} = "ECMDDevice_Parse"; $hash->{AttrFn} = "ECMDDevice_Attr"; $hash->{AttrList} = "IODev class ". $readingFnAttributes; } ################################### sub ECMDDevice_AnalyzeCommand($$) { my ($hash, $ecmd)= @_; Log3 $hash, 5, "ECMDDevice: Analyze command >$ecmd<"; return AnalyzePerlCommand(undef, $ecmd); } ############################# sub ECMDDevice_GetDeviceParams($) { my ($hash)= @_; my $classname= $hash->{fhem}{classname}; my $IOhash= $hash->{IODev}; if(defined($IOhash->{fhem}{classDefs}{$classname}{params})) { my $params= $IOhash->{fhem}{classDefs}{$classname}{params}; return split("[ \t]+", $params); } return; } ############################# sub ECMDDevice_DeviceParams2Specials($) { my ($hash)= @_; my %specials= ( "%NAME" => $hash->{NAME}, "%TYPE" => $hash->{TYPE} ); my @deviceparams= ECMDDevice_GetDeviceParams($hash); foreach my $param (@deviceparams) { $specials{"%".$param}= $hash->{fhem}{params}{$param}; } return %specials; } sub ECMDDevice_GetCachedSpecials($) { my($hash)= @_; if(!defined($hash->{fhem}{cache}{specials})) { my %specials= ECMDDevice_DeviceParams2Specials($hash); $hash->{fhem}{cache}{specials}= \%specials; } return %{$hash->{fhem}{cache}{specials}} } sub ECMDDevice_ReplaceSpecials($%) { my ($s, %specials)= @_; return $s unless(defined($s)); # perform macro substitution foreach my $special (keys %specials) { $s =~ s/$special/$specials{$special}/g; } return $s; } ################################### sub ECMDDevice_Changed($$$) { my ($hash, $cmd, $value)= @_; #Debug "Device changed: $cmd $value"; readingsBeginUpdate($hash); readingsBulkUpdate($hash, $cmd, $value) if(defined($value) && $value ne ""); my $state; my $classname= $hash->{fhem}{classname}; my $IOhash= $hash->{IODev}; if(defined($IOhash->{fhem}{classDefs}{$classname}{state})) { if($cmd eq $IOhash->{fhem}{classDefs}{$classname}{state}) { $state= defined($value) ? $value : "?"; #Debug "cmd= $cmd, setting state to $state (OVERRIDE)"; } } else { $state= $cmd; $state.= " $value" if(defined($value) && $value ne ""); #Debug "cmd= $cmd, setting state to $state (DEFAULT)"; } readingsBulkUpdate($hash, "state", $state) if(defined($state)); readingsEndUpdate($hash, 1); my $name= $hash->{NAME}; #Log3 $hash, 4 , "ECMDDevice $name $state" if(defined($state)); return $state; } ################################### sub ECMDDevice_PostProc($$$) { my ($hash, $postproc, $value)= @_; if($postproc) { my %specials= ECMDDevice_GetCachedSpecials($hash); my $command= ECMDDevice_ReplaceSpecials($postproc, %specials); $_= $value; Log3 $hash, 5, "Postprocessing \"" . escapeLogLine($value) . "\" with perl command $command."; $value= AnalyzePerlCommand(undef, $command); Log3 $hash, 5, "Postprocessed value is \"" . escapeLogLine($value) . "\"."; } return $value; } sub ECMDDevice_EvalCommand($$$) { my ($hash, $command, $value)= @_; if($command) { $_= $value; Log3 $hash, 5, "Postprocessing \"" . escapeLogLine($value) . "\" with perl command $command."; $value= AnalyzePerlCommand(undef, $command); Log3 $hash, 5, "Postprocessed value is \"" . escapeLogLine($value) . "\"."; } return $value; } sub ECMDDevice_GetCachedReadingsCommand($$$) { my ($hash, $classDef, $reading)= @_; my $command= $hash->{fhem}{cache}{readings}{command}{$reading}; if(!defined($command)) { my %specials= ECMDDevice_GetCachedSpecials($hash); my $postproc= $classDef->{readings}{$reading}{postproc}; if($postproc) { $command= ECMDDevice_ReplaceSpecials($postproc, %specials); } else { $command= undef; } $hash->{fhem}{cache}{readings}{command}{$reading}= $command; } return $command; } ################################### sub ECMDDevice_Get($@) { my ($hash, @a)= @_; my $name= $hash->{NAME}; my $type= $hash->{TYPE}; return "get $name needs at least one argument" if(int(@a) < 2); my $cmdname= $a[1]; my $IOhash= $hash->{IODev}; my $classname= $hash->{fhem}{classname}; if(!defined($IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname})) { my $gets= $IOhash->{fhem}{classDefs}{$classname}{gets}; return "$name error: unknown argument $cmdname, choose one of " . (join " ", sort keys %$gets); } my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{cmd}; my $expect= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{expect}; my $params= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params}; my $postproc= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{postproc}; my %specials= ECMDDevice_GetCachedSpecials($hash); # add specials for command if($params) { shift @a; shift @a; my @params= split('[\s]+', $params); return "Wrong number of parameters." if($#a != $#params); my $i= 0; foreach my $param (@params) { Log3 $hash, 5, "Parameter %". $param . " is " . $a[$i]; $specials{"%".$param}= $a[$i++]; } } $ecmd= ECMDDevice_ReplaceSpecials($ecmd, %specials); my $r = ECMDDevice_AnalyzeCommand($hash, $ecmd); my $v= IOWrite($hash, $r, $expect); $v= ECMDDevice_PostProc($hash, $postproc, $v); return ECMDDevice_Changed($hash, $cmdname, $v); } ############################# sub ECMDDevice_Set($@) { my ($hash, @a)= @_; my $name= $hash->{NAME}; my $type= $hash->{TYPE}; return "set $name needs at least one argument" if(int(@a) < 2); my $cmdname= $a[1]; my $IOhash= $hash->{IODev}; my $classname= $hash->{fhem}{classname}; if(!defined($IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname})) { my $sets= $IOhash->{fhem}{classDefs}{$classname}{sets}; return "Unknown argument $cmdname, choose one of " . join(' ', sort keys %$sets); } my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{cmd}; my $expect= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{expect}; my $params= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{params}; my $postproc= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{postproc}; my %specials= ECMDDevice_GetCachedSpecials($hash); # add specials for command if($params) { shift @a; shift @a; my @params= split('[\s]+', $params); return "Wrong number of parameters." if($#a != $#params); my $i= 0; foreach my $param (@params) { $specials{"%".$param}= $a[$i++]; } } $ecmd= ECMDDevice_ReplaceSpecials($ecmd, %specials); my $r = ECMDDevice_AnalyzeCommand($hash, $ecmd); my $v= IOWrite($hash, $r, $expect); $v= ECMDDevice_PostProc($hash, $postproc, $v); ECMDDevice_Changed($hash, $cmdname, $v); # was: return ECMDDevice_Changed($hash, $cmdname, $v); return undef; } ############################# sub ECMDDevice_GetCachedReadingsMatch($$$) { my ($hash, $classDef, $r)= @_; my $regex= $hash->{fhem}{cache}{readings}{match}{$r}; if(!defined($regex)) { my %specials= ECMDDevice_GetCachedSpecials($hash); $regex= ECMDDevice_ReplaceSpecials($classDef->{readings}{$r}{match}, %specials); $hash->{fhem}{cache}{readings}{match}{$r}= $regex; } return $regex; } ############################# sub ECMDDevice_Parse($$) { # we never come here if $msg does not match $hash->{MATCH} in the first place # NOTE: we will update all matching readings for all devices, not just the first! my ($IOhash, $message) = @_; # IOhash points to the ECMD, not to the ECMDDevice my @matches; my $name= $IOhash->{NAME}; my $ts= gettimeofday(); if(defined(AttrVal($name, "partial", undef))) { if(!defined($IOhash->{fhem}{partial})) { $IOhash->{fhem}{partial}{ts}= $ts; $IOhash->{fhem}{partial}{msg}= ""; } #Debug "$name: partial message \"" . escapeLogLine($IOhash->{fhem}{partial}{msg}) . "\" recorded at $ts"; if($IOhash->{fhem}{partial}{msg} ne "") { # clear partial message if expired my $timeout= AttrVal($name, "partial", 1); my $t0= $IOhash->{fhem}{partial}{ts}; if($ts-$t0> $timeout) { $IOhash->{fhem}{partial}{msg}= ""; #Debug "$name: partial message expired."; } } # prepend to recently received message $IOhash->{fhem}{partial}{ts}= $ts; $message= $IOhash->{fhem}{partial}{msg} . $message; $IOhash->{fhem}{partial}{msg}= ""; } else { # clean the partial stuff for clarity if(defined($IOhash->{fhem}{partial})) { delete($IOhash->{fhem}{partial}) } } #Debug "$name: analyzing \"" . escapeLogLine($message) . "\"."; my @msgs; if(defined(AttrVal($name, "split", undef))) { @msgs= split(AttrVal($name, "split", undef), $message); } else { push @msgs, $message; } #my @unmatchedMsgs; # future use my $lastMsg= ""; my $msgMatched; foreach my $msg (@msgs) { #Debug "$name: trying to find a match for \"" . escapeLogLine($msg) ."\""; $msgMatched= 0; # walk over all clients foreach my $d (keys %defs) { my $hash= $defs{$d}; if($hash->{TYPE} eq "ECMDDevice" && $hash->{IODev} eq $IOhash) { my $classname= $hash->{fhem}{classname}; next unless($classname); my $classDef= $IOhash->{fhem}{classDefs}{$classname}; #Debug " Checking device $d with class $classname..."; next unless(defined($classDef->{readings})); #Debug " Trying to find a match in class $classname..."; # we run over all readings in that classdef foreach my $r (keys %{$classDef->{readings}}) { my $regex= ECMDDevice_GetCachedReadingsMatch($hash, $classDef, $r); #Debug " Trying to match reading $r with regular expression \"$regex\" (device $d, classdef $classname, reading $r)."; if($msg =~ m/^$regex$/) { # we found a match Log3 $IOhash, 5, "$name: match regex $regex for reading $r of device $d with class $classname"; $msgMatched++; push @matches, $d; my $command= ECMDDevice_GetCachedReadingsCommand($hash, $classDef, $r); my $value= ECMDDevice_EvalCommand($hash, $command, $msg); #Log3 $hash, 5, "postprocessed value is $value"; ECMDDevice_Changed($hash, $r, $value); } } } } #push @unmatchedMsgs, $msg unless($msgMatched); # future use } $lastMsg= $msgs[$#msgs] unless($msgMatched); # contains the last message if the last message is unmatched if(defined(AttrVal($name, "partial", undef)) && $lastMsg ne "") { # we come here if the last message was unmatched and we want partial messages if($#msgs>= 0) { # we had more messages; therefore the partial message belonged to the first message and needs # to be cleared $IOhash->{fhem}{partial}{msg}= ""; } $IOhash->{fhem}{partial}{msg}.= $lastMsg; # append unmatched message #Debug "$name: partial message \"" . escapeLogLine($IOhash->{fhem}{partial}{msg}) . "\" kept."; } return @matches if(@matches); # we come here if no match is found # NOTE: In a split message, undefined messages are not reported if there was at least one match. # return "UNDEFINED ECMDDevice message $message"; return ""; } ##################################### sub ECMDDevice_AssignClass($$@) { my ($hash,$classname,@a)= @_; my $name= $hash->{NAME}; my $IOhash= $hash->{IODev}; if(!defined($IOhash)) { my $err= "ECMDDevice $name error: no I/O device."; Log3 $hash, 1, $err; return $err; } if(!defined($IOhash->{fhem}{classDefs}{$classname}{filename})) { my $err= "ECMDDevice $name error: unknown class $classname (I/O device is " . $IOhash->{NAME} . ")."; Log3 $hash, 1, $err; return $err; } $hash->{fhem}{classname}= $classname; my @prms= ECMDDevice_GetDeviceParams($hash); my $numparams= 0; $numparams= $#prms+1 if(defined($prms[0])); #Log 5, "ECMDDevice $classname requires $numparams parameter(s): ". join(" ", @prms); # verify identical number of parameters if($numparams != $#a+1) { my $err= "$name error: wrong number of parameters"; Log3 $hash, 1, $err; return $err; } # set parameters for(my $i= 0; $i< $numparams; $i++) { $hash->{fhem}{params}{$prms[$i]}= $a[$i]; } return undef; # OK } ##################################### sub ECMDDevice_Attr($@) { my @a = @_; my $hash= $defs{$a[1]}; if($a[0] eq "set" && $a[2] eq "class") { my ($classname,@prms)= split " ", $a[3]; return ECMDDevice_AssignClass($hash, $classname, @prms); } else { return undef; } } ############################# sub ECMDDevice_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t]+", $def); return "Usage: define ECMDDevice [ [...]]" if(int(@a) < 2); my $name= $a[0]; AssignIoPort($hash); if(int(@a)> 2) { my $classname= $a[2]; shift @a; shift @a; shift @a; return ECMDDevice_AssignClass($hash, $classname, @a); } else { return undef; } # create cache stubs $hash->{fhem}{cache}{specials}= (); $hash->{fhem}{cache}{readings}{match}= (); $hash->{fhem}{cache}{readings}{command}= (); } ############################# 1; ############################# =pod =begin html

ECMDDevice


    Define
      define <name> ECMDDevice [<classname> [<parameter1> [<parameter2> [<parameter3> ... ]]]]

      Defines a logical ECMD device. The number of given parameters must match those given in the class definition of the device class <classname>.

      Normally, the logical ECMDDevice is attached to the latest previously defined physical ECMD device for I/O. Use the IODev attribute of the logical ECMDDevice to attach to any physical ECMD device, e.g. attr myRelais2 IODev myAVRNETIO. In such a case the correct reference to the class cannot be made at the time of definition of the device. Thus, you need to omit the <classname> and <parameter> references in the definition of the device and use the class attribute instead.

      Examples:

        define myADC ECMDDevice ADC
        define myRelais1 ECMDDevice relais 8
        define myRelais2 ECMDDevice
        attr myRelais2 IODev myAVRNETIO
        attr myRelais2 class relais 8

    Set
      set <name> <commandname> [<parameter1> [<parameter2> [<parameter3> ... ]]]

      The number of given parameters must match those given for the set command <commandname> definition in the class definition.

      If set <commandname> is invoked the perl special in curly brackets from the command definition is evaluated and the result is sent to the physical ECMD device.

      Example:
        set myRelais1 on
        set myDisplay text This\x20text\x20has\x20blanks!

    Get
      get <name> <commandname> [<parameter1> [<parameter2> [<parameter3> ... ]]]

      The number of given parameters must match those given for the get command <commandname> definition in the class definition.

      If get <commandname> is invoked the perl special in curly brackets from the command definition is evaluated and the result is sent to the physical ECMD device. The response from the physical ECMD device is returned and the state of the logical ECMD device is updated accordingly.

      Example:
        get myADC value 3

    Attributes

    Example 1

      The following example shows how to access the ADC of the AVR-NET-IO board from Pollin with ECMD-enabled Ethersex firmware.

      The class definition file /etc/fhem/ADC.classdef looks as follows:

      get value cmd {"adc get %channel\n"}
      get value params channel
      get value expect "\d+\n"
      get value postproc { s/^(\d+)\n$/$1/;; $_ }

      In the fhem configuration file or on the fhem command line we do the following:

      define AVRNETIO ECMD telnet 192.168.0.91:2701 # define the physical device
      set AVRNETIO classdef ADC /etc/fhem/ADC.classdef # define the device class ADC
      define myADC ECDMDevice ADC # define the logical device myADC with device class ADC
      get myADC value 1 # retrieve the value of analog/digital converter number 1

      The get command is evaluated as follows: get value has one named parameter channel. In the example the literal 1 is given and thus %channel is replaced by 1 to yield "adc get 1\n" after macro substitution. Perl evaluates this to a literal string which is send as a plain ethersex command to the AVR-NET-IO. The board returns something like 024\n for the current value of analog/digital converter number 1. The postprocessor keeps only the digits.

    Example 2

      The following example shows how to switch a relais driven by pin 3 (bit mask 0x08) of I/O port 2 on for one second and then off again.

      The class definition file /etc/fhem/relais.classdef looks as follows:

      params pinmask
      set on cmd {"io set ddr 2 ff\n\000ioset port 2 0%pinmask\n\000wait 1000\n\000io set port 2 00\n"}
      set on expect ".*"
      set on postproc {s/^OK\nOK\nOK\nOK\n$/success/; "$_" eq "success" ? "ok" : "error"; }

      In the fhem configuration file or on the fhem command line we do the following:

      define AVRNETIO ECMD telnet 192.168.0.91:2701 # define the physical device
      set AVRNETIO classdef relais /etc/fhem/relais.classdef # define the device class relais
      define myRelais ECMDDevice 8 # define the logical device myRelais with pin mask 8
      set myRelais on # execute the "on" command

      The set command is evaluated as follows: %pinmask is replaced by 8 to yield "io set ddr 2 ff\n\000io set port 2 08\n\000wait 1000\n\000io set port 2 00\n\000" after macro substitution. Perl evaluates this to a literal string. This string is split into lines (with trailing newline characters)
      • io set ddr 2 ff\n
      • ioset port 2 08\n
      • wait 1000\n
      • io set port 2 00\n
      These lines are sent as a plain ethersex commands to the AVR-NET-IO one by one. After each line the answer from the physical device is read back. They are concatenated with \000 chars and returned for further processing by the postproc command. For any of the four plain ethersex commands, the AVR-NET-IO returns the string OK\n. They are concatenated. The postprocessor takes the result from $_, substitutes it by the string success if it is OK\nOK\nOK\nOK\n, and then either returns the string ok or the string error.

    Example 3

      The following example shows how to implement a sandbox.

      The class definition file /etc/fhem/DummyServer.classdef looks as follows:

      reading foo match "\d+\n"
      reading foo postproc { s/^(\d+).*$/$1/;; $_ }

      In the fhem configuration file or on the fhem command line we do the following:

      define myDummyServer ECMD telnet localhost:9999 # define the physical device
      set myDummyServer classdef DummyServer /etc/fhem/DummyServer.classdef # define the device class DummyServer
      define myDummyClient ECDMDevice DummyServer # define a logical device with device class DummyServer

      On a Unix command line, run netcat -l 9999. This makes netcat listening on port 9999. Data received on that port are printed on stdout. Data input from stdin is sent to the other end of an incoming connection.

      Start FHEM.

      Then enter the number 4711 at the stdin of the running netcat server.

      FHEM sees 4711\n coming in from the netcat dummy server. The incoming string matches the regular expression of the foo reading. The postprocessor is used to strip any trailing garbage from the digits. The result 4711 is used to update the foo reading.

=end html =cut