From ab35bf7230f8fd3a764f1d03633ff73a720c8866 Mon Sep 17 00:00:00 2001 From: borisneubert Date: Fri, 18 Apr 2014 10:43:26 +0000 Subject: [PATCH] ECMD and ECMDDevice completely reworked, see http://forum.fhem.de/index.php/topic,21515.0.html git-svn-id: svn://svn.code.sf.net/p/fhem/code/trunk@5551 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/CHANGED | 2 + fhem/FHEM/66_ECMD.pm | 670 ++++++++++++++++--------------------- fhem/FHEM/67_ECMDDevice.pm | 323 +++++++++++++----- 3 files changed, 516 insertions(+), 479 deletions(-) diff --git a/fhem/CHANGED b/fhem/CHANGED index b31343a60..995bc98e6 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,6 +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. - SVN + - feature: ECMD and ECMDDevice completely reworked, see + http://forum.fhem.de/index.php/topic,21515.0.html - feature: new layout command rect and new attribute bgcolor for RSS - added: new module 55_weco.pm (betateilchen) - added: new module 70_Jabber.pm (BioS) diff --git a/fhem/FHEM/66_ECMD.pm b/fhem/FHEM/66_ECMD.pm index 640233813..523fe6841 100644 --- a/fhem/FHEM/66_ECMD.pm +++ b/fhem/FHEM/66_ECMD.pm @@ -11,21 +11,17 @@ package main; use strict; use warnings; use Time::HiRes qw(gettimeofday); +use DevIo; -#sub ECMD_Attr(@); +sub ECMD_Attr($@); sub ECMD_Clear($); #sub ECMD_Parse($$$$$); -#sub ECMD_Read($); +sub ECMD_Read($); sub ECMD_ReadAnswer($$); #sub ECMD_Ready($); -sub ECMD_Write($$); +sub ECMD_Write($$$); -sub ECMD_OpenDev($$); -sub ECMD_CloseDev($); -sub ECMD_SimpleWrite(@); -sub ECMD_SimpleRead($); -sub ECMD_Disconnected($); use vars qw {%attr %defs}; @@ -37,8 +33,8 @@ ECMD_Initialize($) # Provider $hash->{WriteFn} = "ECMD_Write"; - #$hash->{ReadFn} = "ECMD_Read"; - $hash->{Clients}= ":ECMDDevice:"; + $hash->{ReadFn} = "ECMD_Read"; + $hash->{Clients} = ":ECMDDevice:"; # Consumer $hash->{DefFn} = "ECMD_Define"; @@ -46,7 +42,7 @@ ECMD_Initialize($) $hash->{GetFn} = "ECMD_Get"; $hash->{SetFn} = "ECMD_Set"; $hash->{AttrFn} = "ECMD_Attr"; - $hash->{AttrList}= "classdefs nonl loglevel:0,1,2,3,4,5"; + $hash->{AttrList}= "classdefs logTraffic:0,1,2,3,4,5 timeout"; } ##################################### @@ -64,14 +60,14 @@ ECMD_Define($$) Log 2, $msg; return $msg; } - - ECMD_CloseDev($hash); + + DevIo_CloseDev($hash); $hash->{Protocol}= $protocol; my $devicename= $a[3]; $hash->{DeviceName} = $devicename; - my $ret = ECMD_OpenDev($hash, 0); + my $ret = DevIo_OpenDev($hash, 0, undef); return $ret; } @@ -83,181 +79,21 @@ ECMD_Undef($$) my ($hash, $arg) = @_; my $name = $hash->{NAME}; + # deleting port for clients foreach my $d (sort keys %defs) { if(defined($defs{$d}) && defined($defs{$d}{IODev}) && - $defs{$d}{IODev} == $hash) - { + $defs{$d}{IODev} == $hash) { my $lev = ($reread_active ? 4 : 2); Log3 $hash, $lev, "deleting port for $d"; delete $defs{$d}{IODev}; } } - ECMD_CloseDev($hash); + DevIo_CloseDev($hash); return undef; } -##################################### -sub -ECMD_CloseDev($) -{ - my ($hash) = @_; - my $name = $hash->{NAME}; - my $dev = $hash->{DeviceName}; - - return if(!$dev); - - if($hash->{TCPDev}) { - $hash->{TCPDev}->close(); - delete($hash->{TCPDev}); - - } elsif($hash->{USBDev}) { - $hash->{USBDev}->close() ; - delete($hash->{USBDev}); - - } - ($dev, undef) = split("@", $dev); # Remove the baudrate - delete($selectlist{"$name.$dev"}); - delete($readyfnlist{"$name.$dev"}); - delete($hash->{FD}); - - -} - -######################## -sub -ECMD_OpenDev($$) -{ - my ($hash, $reopen) = @_; - my $protocol = $hash->{Protocol}; - my $name = $hash->{NAME}; - my $devicename = $hash->{DeviceName}; - - - $hash->{PARTIAL} = ""; - Log3 $hash, 3, "ECMD opening $name (protocol $protocol, device $devicename)" - if(!$reopen); - - if($hash->{Protocol} eq "telnet") { - - - # This part is called every time the timeout (5sec) is expired _OR_ - # somebody is communicating over another TCP connection. As the connect - # for non-existent devices has a delay of 3 sec, we are sitting all the - # time in this connect. NEXT_OPEN tries to avoid this problem. - if($hash->{NEXT_OPEN} && time() < $hash->{NEXT_OPEN}) { - return; - } - - my $conn; - eval { - local $SIG{ALRM} = sub { die 'Timed Out'; }; - alarm 10; - $conn = IO::Socket::INET->new(PeerAddr => $devicename, timeout => 5); - }; - alarm 0; - $conn= undef if $@; -# return "Error: timeout." if ( $@ && $@ =~ /Timed Out/ ); -# return "Error: Eval corrupted: $@" if $@; - if($conn) { - delete($hash->{NEXT_OPEN}) - - } else { - Log3 $hash, 3, "Can't connect to $devicename: $!" if(!$reopen); - $readyfnlist{"$name.$devicename"} = $hash; - $hash->{STATE} = "disconnected"; - $hash->{NEXT_OPEN} = time()+60; - return ""; - } - - $hash->{TCPDev} = $conn; - $hash->{FD} = $conn->fileno(); - delete($readyfnlist{"$name.$devicename"}); - $selectlist{"$name.$devicename"} = $hash; - - } else { - - my $baudrate; - ($devicename, $baudrate) = split("@", $devicename); - - my $po; - if ($^O=~/Win/) { - require Win32::SerialPort; - $po = new Win32::SerialPort ($devicename); - } else { - require Device::SerialPort; - $po = new Device::SerialPort ($devicename); - } - - if(!$po) { - return undef if($reopen); - Log3 $hash, 3, "Can't open $devicename: $!"; - $readyfnlist{"$name.$devicename"} = $hash; - $hash->{STATE} = "disconnected"; - return ""; - } - - $hash->{USBDev} = $po; - if( $^O =~ /Win/ ) { - $readyfnlist{"$name.$devicename"} = $hash; - } else { - $hash->{FD} = $po->FILENO; - delete($readyfnlist{"$name.$devicename"}); - $selectlist{"$name.$devicename"} = $hash; - } - - if($baudrate) { - $po->reset_error(); - Log3 $hash, 3, "ECMD setting $name baudrate to $baudrate"; - $po->baudrate($baudrate); - $po->databits(8); - $po->parity('none'); - $po->stopbits(1); - $po->handshake('none'); - - # This part is for some Linux kernel versions whih has strange default - # settings. Device::SerialPort is nice: if the flag is not defined for your - # OS then it will be ignored. - $po->stty_icanon(0); - #$po->stty_parmrk(0); # The debian standard install does not have it - $po->stty_icrnl(0); - $po->stty_echoe(0); - $po->stty_echok(0); - $po->stty_echoctl(0); - - # Needed for some strange distros - $po->stty_echo(0); - $po->stty_icanon(0); - $po->stty_isig(0); - $po->stty_opost(0); - $po->stty_icrnl(0); - } - - $po->write_settings; - - - } - - if($reopen) { - Log3 $hash, 1, "ECMD $name ($devicename) reappeared"; - } else { - Log3 $hash, 3, "ECMD device opened"; - } - - $hash->{STATE}= ""; # Allow InitDev to set the state - my $ret = ECMD_DoInit($hash); - - if($ret) { - Log3 $hash, 1, "$ret"; - ECMD_CloseDev($hash); - Log3 $hash, 1, "Cannot init $name ($devicename), ignoring it"; - } - - DoTrigger($name, "CONNECTED") if($reopen); - return $ret; -} - ##################################### sub ECMD_DoInit($) @@ -267,96 +103,69 @@ ECMD_DoInit($) my $msg = undef; ECMD_Clear($hash); - #ECMD_SimpleWrite($hash, "version"); - #my ($err,$version)= ECMD_ReadAnswer($hash, "version"); - #return "$name: $err" if($err); - #Log 2, "ECMD version: $version"; - #$hash->{VERSION} = $version; - + $hash->{STATE} = "Initialized" if(!$hash->{STATE}); return undef; } -######################## +##################################### sub -ECMD_SimpleWrite(@) +dq($) { - my ($hash, $msg, $nonl) = @_; - return if(!$hash); - - $msg .= "\n" unless($nonl); - $hash->{USBDev}->write($msg) if($hash->{USBDev}); - syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev}); - - select(undef, undef, undef, 0.001); + my ($s)= @_; + $s= "" unless(defined($s)); + return "\"" . escapeLogLine($s) . "\""; } -######################## sub -ECMD_SimpleRead($) +ECMD_Log($$$) { - my ($hash) = @_; - - if($hash->{USBDev}) { - return $hash->{USBDev}->input(); - } - - if($hash->{TCPDev}) { - my $buf; - if(!defined(sysread($hash->{TCPDev}, $buf, 1024))) { - ECMD_Disconnected($hash); - return undef; - } - - return $buf; - } - return undef; + my ($hash, $loglevel, $logmsg)= @_; + my $name= $hash->{NAME}; + $loglevel= AttrVal($name, "logTraffic", undef) unless(defined($loglevel)); + return unless(defined($loglevel)); + Log3 $hash, $loglevel , "$name: $logmsg"; } ##################################### -# This is a direct read for commands like get sub -ECMD_ReadAnswer($$) +ECMD_SimpleRead($) { - my ($hash, $arg) = @_; + my $hash = shift; + my $answer= DevIo_SimpleRead($hash); + ECMD_Log $hash, undef, "read " . dq($answer); + return $answer; +} - #Log 5, "ECMD reading answer for get $arg..."; +sub +ECMD_SimpleWrite($$) +{ + my ($hash, $msg) = @_; + ECMD_Log $hash, undef, "write " . dq($msg); + DevIo_SimpleWrite($hash, $msg, 0); +} - return ("No FD", undef) - if(!$hash || ($^O !~ /Win/ && !defined($hash->{FD}))); - - my ($data, $rin) = ("", ''); - my $buf; - my $to = 3; # 3 seconds timeout - $to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less - #Log 5, "Timeout is $to seconds"; - for(;;) { - - return ("Error: device lost when reading answer for get $arg", undef) - if(!$hash->{FD}); - - vec($rin, $hash->{FD}, 1) = 1; - my $nfound = select($rin, undef, undef, $to); - if($nfound < 0) { - next if ($! == EAGAIN() || $! == EINTR() || $! == 0); - my $err = $!; - ECMD_Disconnected($hash); - return("Error reading answer for get $arg: $err", undef); - } - return ("Error: timeout reading answer for get $arg", undef) - if($nfound == 0); - - $buf = ECMD_SimpleRead($hash); - return ("No data", undef) if(!defined($buf)); - - if($buf) { - chomp $buf; # remove line break - Log3 $hash, 5, "ECMD (ReadAnswer): $buf"; - $data .= $buf; - } - return (undef, $data) +sub +ECMD_SimpleExpect($$$) +{ + my ($hash, $msg, $expect) = @_; + + ECMD_Log $hash, undef, "write " . dq($msg) . ", expect $expect"; + my $answer= DevIo_Expect($hash, $msg, AttrVal($hash->{NAME}, "timeout", 3.0)); + + if(defined($answer)) { + ECMD_Log $hash, undef, "read " . dq($answer); + if($answer !~ m/^$expect$/) { + ECMD_Log $hash, 1, "unexpected answer " . dq($answer) . " received (wrote " . + dq($msg) . ", expected $expect)"; + } + } else { + ECMD_Log $hash, 1, "no answer received (wrote " . + dq($msg) . ", expected $expect)"; } + + return $answer; } ##################################### @@ -374,34 +183,7 @@ ECMD_Clear($) my $hash = shift; # Clear the pipe - $hash->{RA_Timeout} = 0.1; - for(;;) { - my ($err, undef) = ECMD_ReadAnswer($hash, "clear"); - last if($err && $err =~ m/^Error/); - } - delete($hash->{RA_Timeout}); -} - -##################################### -sub -ECMD_Disconnected($) -{ - my $hash = shift; - my $dev = $hash->{DeviceName}; - my $name = $hash->{NAME}; - - return if(!defined($hash->{FD})); # Already deleted o - - Log3 $hash, 1, "$dev disconnected, waiting to reappear"; - ECMD_CloseDev($hash); - $readyfnlist{"$name.$dev"} = $hash; # Start polling - $hash->{STATE} = "disconnected"; - - # Without the following sleep the open of the device causes a SIGSEGV, - # and following opens block infinitely. Only a reboot helps. - sleep(5); - - DoTrigger($name, "DISCONNECTED"); + DevIo_TimeoutRead($hash, 0.1); } ##################################### @@ -416,26 +198,24 @@ ECMD_Get($@) my $cmd= $a[1]; my $arg = ($a[2] ? $a[2] : ""); my @args= @a; shift @args; shift @args; - my ($msg, $err); + my ($answer, $err); return "No get $cmd for dummies" if(IsDummy($name)); if($cmd eq "raw") { return "get raw needs an argument" if(@a< 3); - my $nonl= AttrVal($name, "nonl", 0); + #my $nonl= AttrVal($name, "nonl", 0); my $ecmd= join " ", @args; - Log3 $hash, 5, $ecmd; - ECMD_SimpleWrite($hash, $ecmd, $nonl); - ($err, $msg) = ECMD_ReadAnswer($hash, "raw"); - return $err if($err); + #ecmd .= "\n" unless($nonl); + $answer= ECMD_SimpleExpect($hash, $ecmd, ".*"); } else { return "get $cmd: unknown command "; } - $hash->{READINGS}{$cmd}{VAL} = $msg; + $hash->{READINGS}{$cmd}{VAL} = $answer; $hash->{READINGS}{$cmd}{TIME} = TimeNow(); - return "$name $cmd => $msg"; + return "$name $cmd => $answer"; } ##################################### @@ -469,8 +249,12 @@ ECMD_EvalClassDef($$$) # params parameters for device definition # get cmd {} defines a get command # get params parameters for get command + # get expect regex expected regex for get command + # get postproc { } postprocessor for get command # set cmd {} defines a set command + # set expect regex expected regex for set command # set params parameters for get command + # set postproc { } postprocessor for set command # all lines are optional # # eaxmple class definition 1: @@ -483,27 +267,69 @@ ECMD_EvalClassDef($$$) # set stop cmd {"io set ddr 2 ff\nio set port 2 1%btnstop\nwait 1000\nio set port 2 00"} # set down cmd {"io set ddr 2 ff\nio set port 2 1%btndown\nwait 1000\nio set port 2 00"} - my $cont= ""; + my $cont= ""; foreach my $line (@classdef) { # kill trailing newline chomp $line; # kill comments and blank lines $line=~ s/\#.*$//; $line=~ s/\s+$//; - $line= $cont . $line; - if($line=~ s/\\$//) { $cont= $line; undef $line; } + $line= $cont . $line; + if($line=~ s/\\$//) { $cont= $line; undef $line; } next unless($line); - $cont= ""; + $cont= ""; Log3 $hash, 5, "$name: evaluating >$line<"; # split line into command and definition my ($cmd, $def)= split("[ \t]+", $line, 2); - if($cmd eq "nonl") { - Log3 $hash, 5, "$name: no newline"; - $hash->{fhem}{classDefs}{$classname}{nonl}= 1; - } - elsif($cmd eq "params") { + #if($cmd eq "nonl") { + # Log3 $hash, 5, "$name: no newline"; + # $hash->{fhem}{classDefs}{$classname}{nonl}= 1; + #} + + # + # params + # + if($cmd eq "params") { Log3 $hash, 5, "$name: parameters are $def"; $hash->{fhem}{classDefs}{$classname}{params}= $def; + # + # reading + # + } elsif($cmd eq "reading") { + my ($readingname, $spec, $arg)= split("[ \t]+", $def, 3); + # + # match + # + if($spec eq "match") { + if($arg !~ m/^"(.*)"$/s) { + Log3 $hash, 1, "$name: match for reading $readingname is not enclosed in double quotes."; + next; + } + $arg = $1; + Log3 $hash, 5, "$name: reading $readingname will match $arg"; + $hash->{fhem}{classDefs}{$classname}{readings}{$readingname}{match}= $arg; + # + # postproc + # + } elsif($spec eq "postproc") { + if($arg !~ m/^{.*}$/s) { + Log3 $hash, 1, "$name: postproc command for reading $readingname is not a perl command."; + next; + } + $arg =~ s/^(\\\n|[ \t])*//; # Strip space or \\n at the beginning + $arg =~ s/[ \t]*$//; + Log3 $hash, 5, "$name: reading $readingname postprocessor defined as $arg"; + $hash->{fhem}{classDefs}{$classname}{readings}{$readingname}{postproc}= $arg; + # + # anything else + # + } else { + Log3 $hash, 1, + "$name: illegal spec $spec for reading $readingname for class $classname in file $filename."; + } + # + # set, get + # } elsif($cmd eq "set" || $cmd eq "get") { my ($cmdname, $spec, $arg)= split("[ \t]+", $def, 3); if($spec eq "params") { @@ -542,6 +368,22 @@ ECMD_EvalClassDef($$$) Log3 $hash, 5, "$name: get $cmdname postprocessor defined as $arg"; $hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{postproc}= $arg; } + } elsif($spec eq "expect") { + if($arg !~ m/^"(.*)"$/s) { + Log3 $hash, 1, "$name: expect for $cmd $cmdname is not enclosed in double quotes."; + next; + } + $arg = $1; + if($cmd eq "set") { + Log3 $hash, 5, "$name: set $cmdname expects $arg"; + $hash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{expect}= $arg; + } elsif($cmd eq "get") { + Log3 $hash, 5, "$name: get $cmdname expects $arg"; + $hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{expect}= $arg; + } + } else { + Log3 $hash, 1, + "$name: illegal spec $spec for $cmd $cmdname for class $classname in file $filename."; } } else { Log3 $hash, 1, "$name: illegal tag $cmd for class $classname in file $filename."; @@ -586,8 +428,8 @@ sub ECMD_Reopen($) { my ($hash) = @_; - ECMD_CloseDev($hash); - ECMD_OpenDev($hash, 1); + DevIo_CloseDev($hash); + DevIo_OpenDev($hash, 1, undef); return undef; } @@ -617,28 +459,46 @@ ECMD_Set($@) } ##################################### -sub -ECMD_Write($$) +# called from the global loop, when the select for hash->{FD} reports data +sub ECMD_Read($) { - my ($hash,$msg) = @_; - my $answer; - my @r; - my @ecmds= split "\n", $msg; - my $nonl= AttrVal($hash->{NAME}, "nonl", 0); - foreach my $ecmd (@ecmds) { - Log3 $hash, 5, "$hash->{NAME} sending $ecmd"; - ECMD_SimpleWrite($hash, $ecmd, $nonl); - $answer= ECMD_ReadAnswer($hash, "$ecmd"); - if(defined($answer)) { - push @r, $answer; - Log3 $hash, 5, $answer; - } else { - Log3 $hash, 5, "no answer received"; - } - } + my ($hash) = @_; + my $buf = ECMD_SimpleRead($hash); + return if($buf eq ""); - return join("\n", @r) unless($#r<0); - return undef; + ECMD_Log $hash, 5, "Spontaneously received " . dq($buf); + Dispatch($hash, $buf, undef); # dispatch result to ECMDDevices +} + +##################################### +sub +ECMD_Write($$$) +{ + my ($hash,$msg,$expect) = @_; + my $name= $hash->{NAME}; + my $answer; + my $ret= ""; + my $requestSeparator= "\000"; # AttrVal($hash, "requestSeparator", "\000"); + my $responseSeparator= ""; # AttrVal($hash, "responseSeparator", ""); + my @ecmds= split $requestSeparator, $msg; + #my @ecmds= split "\n", $msg; + #my $nonl= AttrVal($name, "nonl", 0); + ECMD_Log $hash, 5, "command split into " . ($#ecmds+1) . " parts." if($#ecmds>0); + foreach my $ecmd (@ecmds) { + ECMD_Log $hash, 5, "sending command " . dq($ecmd); + my $msg .= $ecmd; + #$msg.= "\n" unless($nonl); + if(defined($expect)) { + $answer= ECMD_SimpleExpect($hash, $msg, $expect); + $answer= "" unless(defined($answer)); + ECMD_Log $hash, 5, "received answer " . dq($answer); + $answer.= $responseSeparator if($#ecmds>0); + $ret.= $answer; + } else { + ECMD_SimpleWrite($hash, $msg); + } + } + return $ret; } ##################################### @@ -656,7 +516,8 @@ ECMD_Write($$) of such a device is the AVR microcontroller board AVR-NET-IO from Pollin with ECMD-enabled - Ethersex firmware.

+ Ethersex firmware. The original + NetServer firmware from Pollin works as well.

A physical ECMD device can host any number of logical ECMD devices. Logical devices are defined as ECMDDevices in fhem. @@ -740,96 +601,129 @@ ECMD_Write($$)

  • classdefs
    A colon-separated list of <classname>=<filename>. The list is automatically updated if a class definition is added. You can directly set the attribute.
    • +
  • logTraffic <loglevel>
    Enables logging of sent and received datagrams with the given loglevel. Control characters in the logged datagrams are escaped, i.e. a double backslash is shown for a single backslash, \n is shown for a line feed character, etc.
    • +
  • timeout <seconds>
    Time in seconds to wait for a reply from the physical ECMD device before FHEM assumes that something has gone wrong. The default is 3 seconds if this attribute is not set.
    • + +
  • verbose


    • - + + + Datagram monitoring and matching +

    + + Data to and from the physical device is processed as is. In particular, if you need to send a line feed you have to include send a \n control character. On the other hand, control characters like line feeds are not stripped from the data received. This needs to be considered when defining a class definition.

    + + For debugging purposes, especially when designing a class definition, it is advisable to turn traffic logging on. Use attr myECMD logTraffic 3 to log all data to and from the physical device at level 3. A typical response might look like 21.2\n, i.e. a floating point number followed by a newline.

    + + Data received from the physical device is processed as it comes in chunks. If for some reason a datagram from the device is split in transit, pattern matching and processing will most likely fail. +

    + + + Connection error handling +

    + + This modules handles unexpected disconnects of devices as follows (on Windows only for TCP connections):

    + + Disconnects are detected if and only if data from the device in reply to data sent to the device cannot be received with at most two attempts. FHEM waits at most 3 seconds (or the time specified in the timeout attribute, see Attributes). After the first failed attempt, the connection to the device is closed and reopened again. The state of the device + is failed. Then the data is sent again to the device. If still no reply is received, the state of the device is disconnected, otherwise opened. You will have to fix the problem and then use set myECMD reopen to reconnect to the device.

    + + Please design your class definitions in such a way that the double sending of data does not bite you in any case. +

    Class definition

    -

      + + The class definition for a logical ECMD device class is contained in a text file. + The text file is made up of single lines. Empty lines and text beginning with # + (hash) are ignored. Therefore make sure not to use hashes in commands.
      - The class definition for a logical ECMD device class is contained in a text file. - The text file is made up of single lines. Empty lines and text beginning with # - (hash) are ignored. Therefore make sure not to use hashes in commands.
      + The following commands are recognized in the device class definition:

      +
        +
      • params <parameter1> [<parameter2> [<parameter3> ... ]]

        + Declares the names of the named parameters that must be present in the + definition of the logical ECMD device. +

        +
        • - The following commands are recognized in the device class definition:

        -
          -
        • params <parameter1> [<parameter2> [<parameter3> ... ]]

          - Declares the names of the named parameters that must be present in the - definition of the logical ECMD device. -

          -
          • +
        • set <commandname> cmd { <perl special> }
          + get <commandname> cmd { <perl special> } +

          + Declares a new set or get command <commandname>. If the user invokes the set or get command <commandname>, the string that results from the execution of the <perl special> is sent to the physical device.

          + A \000 (octal representation of control char with code zero) can be used to split the command into chunks. This is required for sending multiple Ethersex commands for one command in the class definition. The result string for the command is the + concatenation of all responses received from the physical device. Use \x00 for literal zero bytes. +

          +

          • -
        • set <commandname> cmd { <perl special> } -

          - Declares a new set command <commandname>. -

          -
          • +
        • + set <commandname> expect "<regex>"
          + get <commandname> expect "<regex>" +

          + Declares what FHEM expects to receive after the execution of the get or set command <commandname>. <regex> is a Perl regular expression. The double quotes around the regular expression are mandatory and they are not part of the regular expression itself. Particularly, broken connections can only be detected if something is expected (see Connection error handling). +

          +
          • -
        • get <commandname> cmd { <perl special> } -

          - Declares a new get command <commandname>. -

          -
          • +
        • + set <commandname> postproc { <perl special> }
          + get <commandname> postproc { <perl special> } +

          + Declares a postprocessor for the command <commandname>. The data received from the physical device in reply to the get or set command <commandname> is processed by the Perl code <perl command>. The perl code operates on $_. Make sure to return the result in $_ as well. The result of the perl command is shown as the result of the get or set command. +

          +
          • -
        • - set <commandname> postproc { <perl command> }
          - get <commandname> postproc { <perl command> } -

          - Declares a postprocessor for the command <commandname>. -

          -
          • +
        • + set <commandname> params <parameter1> [<parameter2> [<parameter3> ... ]]
          + get <commandname> params <parameter1> [<parameter2> [<parameter3> ... ]] +

          + Declares the names of the named parameters that must be present in the + set or get command <commandname>. Be careful not to use a parameter name that + is already used in the device definition (see params above). +

          +
          • +
        • + reading <reading> match "<regex>" +

          + Declares a new reading named <reading>. A spontaneous data transmission from the physical device that matches the Perl regular expression <regex> is evaluated to become the value of the named reading. All ECMDDevice devices belonging to the ECMD device with readings with matching regular expressions will receive an update of the said readings. +

          +
          • + +
        • + reading <reading> postproc { <perl special> } +

          + Declares a postprocessor for the reading <reading>. The data received for the named reading is processed by the Perl code <perl command>. This works analogously to the postproc spec for set and get commands. +

          +
          • -
        • - set <commandname> params <parameter1> [<parameter2> [<parameter3> ... ]]
          - get <commandname> params <parameter1> [<parameter2> [<parameter3> ... ]] -

          - Declares the names of the named parameters that must be present in the - set or get command <commandname>. Be careful not to use a parameter name that - is already used in the device definition (see params above). -

          -
          • + -
        - - The perl specials in the definitions of the set and get commands can - contain macros. Apart from the rules outlined in the documentation of perl specials in fhem, the following - rules apply:

        -
          -
        • The character @ will be replaced with the device - name. To use @ in the text itself, use the double mode (@@).
          • - -
        • The macro %NAME will expand to the device name (same - as @).
          • - -
        • The macro %<parameter> will expand to the - current value of the named parameter. This can be either a parameter - from the device definition or a parameter from the set or get - command.
          • - -
        • The macro substitution occurs before perl evaluates the - expression. It is a plain text substitution.
          • - -
        • If in doubt what happens, run the commands with loglevel 5 and - observe the log file.
          • -


        - - - The rules outlined in the documentation of perl specials - for the <perl command> in the postprocessor definitions apply. - Note: Beware of undesired side effects from e.g. doubling of semicolons! - - The perl command acts on $_. The result of the perl command is the - final result of the get or set command. +
      + + The perl specials in the definitions above can + contain macros:

      +
        +
      • The macro %NAME will expand to the device name.
        • +
      • The macro %TYPE will expand to the device type.
        • +
      • The macro %<parameter> will expand to the + current value of the named parameter. This can be either a parameter + from the device definition or a parameter from the set or get + command.
        • +
      • The macro substitution occurs before perl evaluates the + expression. It is a plain text substitution. Be careful not to use parameters with overlapping names like + %pin and %pin1.
        • +
      • If in doubt what happens, run the commands with loglevel 5 and + inspect the log file.
        • +


      + + The rules outlined in the documentation of perl specials + for the <perl command> in the postprocessor definitions apply. + Note: Beware of undesired side effects from e.g. doubling of semicolons!
    =end html diff --git a/fhem/FHEM/67_ECMDDevice.pm b/fhem/FHEM/67_ECMDDevice.pm index 7653ae0d0..ab68c5cb9 100644 --- a/fhem/FHEM/67_ECMDDevice.pm +++ b/fhem/FHEM/67_ECMDDevice.pm @@ -31,34 +31,33 @@ use Time::HiRes qw(gettimeofday); sub ECMDDevice_Get($@); sub ECMDDevice_Set($@); +sub ECMDDevice_Attr($@); sub ECMDDevice_Define($$); -my %gets= ( -); - -my %sets= ( -); - ################################### sub ECMDDevice_Initialize($) { my ($hash) = @_; + $hash->{Match} = ".+"; + $hash->{GetFn} = "ECMDDevice_Get"; $hash->{SetFn} = "ECMDDevice_Set"; $hash->{DefFn} = "ECMDDevice_Define"; + $hash->{ParseFn} = "ECMDDevice_Parse"; - $hash->{AttrList} = "loglevel:0,1,2,3,4,5 ". + $hash->{AttrFn} = "ECMDDevice_Attr"; + $hash->{AttrList} = "IODev class ". $readingFnAttributes; } ################################### sub -ECMDDevice_AnalyzeCommand($) +ECMDDevice_AnalyzeCommand($$) { - my ($ecmd)= @_; - Log 5, "ECMDDevice: Analyze command >$ecmd<"; + my ($hash, $ecmd)= @_; + Log3 $hash, 5, "ECMDDevice: Analyze command >$ecmd<"; return AnalyzePerlCommand(undef, $ecmd); } @@ -76,6 +75,7 @@ ECMDDevice_GetDeviceParams($) return; } +############################# sub ECMDDevice_DeviceParams2Specials($) { @@ -91,26 +91,39 @@ ECMDDevice_DeviceParams2Specials($) return %specials; } +sub +ECMDDevice_ReplaceSpecials($%) +{ + my ($s, %specials)= @_; + + # perform macro substitution + foreach my $special (keys %specials) { + $s =~ s/$special/$specials{$special}/g; + } + return $s; +} + ################################### sub ECMDDevice_Changed($$$) { my ($hash, $cmd, $value)= @_; - - readingsBeginUpdate($hash); - readingsBulkUpdate($hash, $cmd, $value, 1) if(defined($value)); + if(defined($value) && $value ne "") { + readingsBeginUpdate($hash); + readingsBulkUpdate($hash, $cmd, $value); - my $state= $cmd; - $state.= " $value" if(defined($value)); - readingsBulkUpdate($hash, "state", $state, 0); + my $state= $cmd; + $state.= " $value"; + readingsBulkUpdate($hash, "state", $state); - readingsEndUpdate($hash, 1); + readingsEndUpdate($hash, 1); - my $name= $hash->{NAME}; - Log GetLogLevel($name, 4), "ECMDDevice $name $state"; + my $name= $hash->{NAME}; + Log3 $hash, 4 , "ECMDDevice $name $state"; - return $state; + return $state; + } } @@ -120,19 +133,13 @@ ECMDDevice_PostProc($$$) { my ($hash, $postproc, $value)= @_; - # the following lines are commented out because we do not want specials to be evaluated - # this is mainly due to the unwanted substitution of single semicolons by double semicolons - #my %specials= ECMDDevice_DeviceParams2Specials($hash); - #my $command= EvalSpecials($postproc, %specials); - # we pass the command verbatim instead - # my $command= $postproc; - if($postproc) { my %specials= ECMDDevice_DeviceParams2Specials($hash); - my $command= EvalSpecials($postproc, %specials); + my $command= ECMDDevice_ReplaceSpecials($postproc, %specials); $_= $value; - Log 5, "Postprocessing $value with perl command $command."; + Log3 $hash, 5, "Postprocessing \"" . escapeLogLine($value) . "\" with perl command $command."; $value= AnalyzePerlCommand(undef, $command); + Log3 $hash, 5, "Postprocessed value is \"" . escapeLogLine($value) . "\"."; } return $value; } @@ -153,10 +160,13 @@ ECMDDevice_Get($@) my $IOhash= $hash->{IODev}; my $classname= $hash->{fhem}{classname}; if(!defined($IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname})) { - return "$name error: unknown command $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}; @@ -169,15 +179,15 @@ ECMDDevice_Get($@) my $i= 0; foreach my $param (@params) { - Log 5, "Parameter %". $param . " is " . $a[$i]; + Log3 $hash, 5, "Parameter %". $param . " is " . $a[$i]; $specials{"%".$param}= $a[$i++]; } } - $ecmd= EvalSpecials($ecmd, %specials); + $ecmd= ECMDDevice_ReplaceSpecials($ecmd, %specials); - my $r = ECMDDevice_AnalyzeCommand($ecmd); + my $r = ECMDDevice_AnalyzeCommand($hash, $ecmd); - my $v= IOWrite($hash, $r); + my $v= IOWrite($hash, $r, $expect); $v= ECMDDevice_PostProc($hash, $postproc, $v); @@ -200,10 +210,11 @@ ECMDDevice_Set($@) my $classname= $hash->{fhem}{classname}; if(!defined($IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname})) { my $sets= $IOhash->{fhem}{classDefs}{$classname}{sets}; - return "Unknown argument ?, choose one of " . join(' ', keys %$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}; @@ -219,11 +230,11 @@ ECMDDevice_Set($@) $specials{"%".$param}= $a[$i++]; } } - $ecmd= EvalSpecials($ecmd, %specials); + $ecmd= ECMDDevice_ReplaceSpecials($ecmd, %specials); - my $r = ECMDDevice_AnalyzeCommand($ecmd); + my $r = ECMDDevice_AnalyzeCommand($hash, $ecmd); - my $v= IOWrite($hash, $r); + my $v= IOWrite($hash, $r, $expect); $v= ECMDDevice_PostProc($hash, $postproc, $v); @@ -232,50 +243,132 @@ ECMDDevice_Set($@) } +############################# +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, $msg) = @_; # IOhash points to the ECMD, not to the ECMDDevice + + my @matches; + my $name= $IOhash->{NAME}; + + #Debug "Trying to find a match for \"" . escapeLogLine($msg) ."\""; + # 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}; + 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..."; + my %specials= ECMDDevice_DeviceParams2Specials($hash); + # we run over all readings in that classdef + foreach my $r (keys %{$classDef->{readings}}) { + my $regex= ECMDDevice_ReplaceSpecials($classDef->{readings}{$r}{match}, %specials); + #Debug " Trying to match reading $r with regular expressing \"$regex\"."; + if($msg =~ m/$regex/) { + # we found a match + Log3 $IOhash, 5, "$name: match regex $regex for reading $r of device $d with class $classname"; + push @matches, $d; + my $postproc= $classDef->{readings}{$r}{postproc}; + my $value= ECMDDevice_PostProc($hash, $postproc, $msg); + Log3 $hash, 5, "postprocessed value is $value"; + ECMDDevice_Changed($hash, $r, $value); + } + } + } + } + + return @matches if(@matches); + return "UNDEFINED ECMDDevice message $msg"; + +} + +##################################### +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) < 3); + return "Usage: define ECMDDevice [ [...]]" if(int(@a) < 2); my $name= $a[0]; - my $classname= $a[2]; - + AssignIoPort($hash); - my $IOhash= $hash->{IODev}; - if(!defined($IOhash->{fhem}{classDefs}{$classname}{filename})) { - my $err= "$name error: unknown class $classname."; - Log 1, $err; - return $err; + if(int(@a)> 2) { + my $classname= $a[2]; + shift @a; shift @a; shift @a; + return ECMDDevice_AssignClass($hash, $classname, @a); + } else { + return undef; } - - $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); - - # keep only the parameters - shift @a; shift @a; shift @a; - - # verify identical number of parameters - if($numparams != $#a+1) { - my $err= "$name error: wrong number of parameters"; - Log 1, $err; - return $err; - } - - # set parameters - for(my $i= 0; $i< $numparams; $i++) { - $hash->{fhem}{params}{$prms[$i]}= $a[$i]; - } - return undef; } 1; @@ -290,17 +383,27 @@ ECMDDevice_Define($$) Define
      - define <name> ECMDDevice <classname> [<parameter1> [<parameter2> [<parameter3> ... ]]] + 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>. + 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

    @@ -346,8 +449,13 @@ ECMDDevice_Define($$) Attributes

    @@ -363,8 +471,10 @@ ECMDDevice_Define($$) The class definition file /etc/fhem/ADC.classdef looks as follows:

    - get value cmd {"adc get %channel"}
    + 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:

    @@ -377,9 +487,9 @@ ECMDDevice_Define($$)
    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" after macro substitution. Perl + 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 for the current value of analog/digital converter number 1. + board returns something like 024\n for the current value of analog/digital converter number 1. The postprocessor keeps only the digits.

    @@ -394,8 +504,9 @@ ECMDDevice_Define($$) The class definition file /etc/fhem/relais.classdef looks as follows:

    params pinmask
    - set on cmd {"io set ddr 2 ff\nioset port 2 0%pinmask\nwait 1000\nio set port 2 00"}
    - set on postproc {s/^OK\nOK\nOK\nOK$/success/; "$_" eq "success" ? "ok" : "error"; }
    + 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:

    @@ -408,27 +519,57 @@ ECMDDevice_Define($$)
    The set command is evaluated as follows: %pinmask is replaced by 8 to yield - "io set ddr 2 ff\nioset port 2 08\nwait 1000\nio set port 2 00" after macro substitution. Perl - evaluates this to a literal string. This string is split into lines (without trailing newline characters) + "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
      • -
    • ioset port 2 08
      • -
    • wait 1000
      • -
    • io set port 2 00
      • +
    • 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. Each line is terminated with - a newline character unless the nonl attribute of the ECMDDevice is set. After - each line the answer from the ECMDDevice is read back. They are concatenated with newlines and returned - for further processing, e.g. by the postproc command. - For any of the four plain ethersex commands, the AVR-NET-IO returns the string OK. They are - concatenated and separated by line breaks (\n). The postprocessor takes the result from $_, - substitutes it by the string success if it is OK\nOK\nOK\nOK, and then either + 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. +

      + +

    + +