mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-13 05:06:35 +00:00
feature: new modules 66_ECMD.pm and 67_ECMDDevice.pm for ethersex-enabled devices and alike.
git-svn-id: https://svn.fhem.de/fhem/trunk@806 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
borisneubert
parent
e198f7c63e
commit
979c98d4ca
@ -13,6 +13,8 @@
|
||||
- feature: attr may be a regexp (for CUL_IR)
|
||||
- feature: Homepage moved from koeniglich.de/fhem to fhem.de
|
||||
- feature: eventMap attribute
|
||||
- feature: new modules 66_ECMD.pm and 67_ECMDDevice.pm for ethersex-enabled
|
||||
devices and alike.
|
||||
|
||||
- 2010-08-15 (5.0)
|
||||
- **NOTE*: The default installation path is changed to satisfy lintian
|
||||
|
||||
480
fhem/FHEM/66_ECMD.pm
Normal file
480
fhem/FHEM/66_ECMD.pm
Normal file
@ -0,0 +1,480 @@
|
||||
#
|
||||
#
|
||||
# 66_ECMD.pm
|
||||
# written by Dr. Boris Neubert 2011-01-15
|
||||
# e-mail: omega at online dot de
|
||||
#
|
||||
##############################################
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::HiRes qw(gettimeofday);
|
||||
|
||||
|
||||
#sub ECMD_Attr(@);
|
||||
sub ECMD_Clear($);
|
||||
#sub ECMD_Parse($$$$$);
|
||||
#sub ECMD_Read($);
|
||||
sub ECMD_ReadAnswer($$);
|
||||
#sub ECMD_Ready($);
|
||||
sub ECMD_Write($$);
|
||||
|
||||
sub ECMD_OpenDev($$);
|
||||
sub ECMD_CloseDev($);
|
||||
sub ECMD_SimpleWrite(@);
|
||||
sub ECMD_SimpleRead($);
|
||||
sub ECMD_Disconnected($);
|
||||
|
||||
use vars qw {%attr %defs};
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
# Provider
|
||||
$hash->{WriteFn} = "ECMD_Write";
|
||||
#$hash->{ReadFn} = "ECMD_Read";
|
||||
$hash->{Clients}= ":ECMDDevice:";
|
||||
|
||||
# Consumer
|
||||
$hash->{DefFn} = "ECMD_Define";
|
||||
$hash->{UndefFn} = "ECMD_Undef";
|
||||
$hash->{GetFn} = "ECMD_Get";
|
||||
$hash->{SetFn} = "ECMD_Set";
|
||||
$hash->{AttrList}= "loglevel:0,1,2,3,4,5";
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my @a = split("[ \t]+", $def);
|
||||
|
||||
my $name = $a[0];
|
||||
my $protocol = $a[2];
|
||||
my $ipaddress= $a[3];
|
||||
|
||||
if(@a < 4 || @a > 4 || $protocol ne "telnet") {
|
||||
my $msg = "wrong syntax: define <name> ECMD telnet <ipaddress[:port]> ";
|
||||
Log 2, $msg;
|
||||
return $msg;
|
||||
}
|
||||
|
||||
ECMD_CloseDev($hash);
|
||||
|
||||
if($ipaddress eq "none") {
|
||||
Log 1, "$name ip address is none, commands will be echoed only";
|
||||
$attr{$name}{dummy} = 1;
|
||||
return undef;
|
||||
}
|
||||
|
||||
$hash->{Protocol}= $protocol;
|
||||
$hash->{IPAddress}= $ipaddress;
|
||||
|
||||
my $ret = ECMD_OpenDev($hash, 0);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Undef($$)
|
||||
{
|
||||
my ($hash, $arg) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
foreach my $d (sort keys %defs) {
|
||||
if(defined($defs{$d}) &&
|
||||
defined($defs{$d}{IODev}) &&
|
||||
$defs{$d}{IODev} == $hash)
|
||||
{
|
||||
my $lev = ($reread_active ? 4 : 2);
|
||||
Log GetLogLevel($name,$lev), "deleting port for $d";
|
||||
delete $defs{$d}{IODev};
|
||||
}
|
||||
}
|
||||
|
||||
ECMD_CloseDev($hash);
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_CloseDev($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my $ipaddress = $hash->{IPAddress};
|
||||
|
||||
return if(!$ipaddress);
|
||||
|
||||
if($hash->{TCPDev}) {
|
||||
$hash->{TCPDev}->close();
|
||||
delete($hash->{TCPDev});
|
||||
}
|
||||
|
||||
delete($selectlist{"$name.$ipaddress"});
|
||||
delete($readyfnlist{"$name.$ipaddress"});
|
||||
delete($hash->{FD});
|
||||
}
|
||||
|
||||
########################
|
||||
sub
|
||||
ECMD_OpenDev($$)
|
||||
{
|
||||
my ($hash, $reopen) = @_;
|
||||
my $protocol = $hash->{Protocol};
|
||||
my $ipaddress = $hash->{IPAddress};
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
|
||||
$hash->{PARTIAL} = "";
|
||||
Log 3, "ECMD opening $name (protocol $protocol, ipaddress $ipaddress)"
|
||||
if(!$reopen);
|
||||
|
||||
# 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 = IO::Socket::INET->new(PeerAddr => $ipaddress);
|
||||
if($conn) {
|
||||
delete($hash->{NEXT_OPEN})
|
||||
} else {
|
||||
Log(3, "Can't connect to $ipaddress: $!") if(!$reopen);
|
||||
$readyfnlist{"$name.$ipaddress"} = $hash;
|
||||
$hash->{STATE} = "disconnected";
|
||||
$hash->{NEXT_OPEN} = time()+60;
|
||||
return "";
|
||||
}
|
||||
|
||||
$hash->{TCPDev} = $conn;
|
||||
$hash->{FD} = $conn->fileno();
|
||||
delete($readyfnlist{"$name.$ipaddress"});
|
||||
$selectlist{"$name.$ipaddress"} = $hash;
|
||||
|
||||
|
||||
if($reopen) {
|
||||
Log 1, "ECMD $ipaddress reappeared ($name)";
|
||||
} else {
|
||||
Log 3, "ECMD device opened";
|
||||
}
|
||||
|
||||
$hash->{STATE}= ""; # Allow InitDev to set the state
|
||||
my $ret = ECMD_DoInit($hash);
|
||||
|
||||
if($ret) {
|
||||
Log 1, "$ret";
|
||||
ECMD_CloseDev($hash);
|
||||
Log 1, "Cannot init $ipaddress, ignoring it";
|
||||
}
|
||||
|
||||
DoTrigger($name, "CONNECTED") if($reopen);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_DoInit($)
|
||||
{
|
||||
my $hash = shift;
|
||||
my $name = $hash->{NAME};
|
||||
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;
|
||||
|
||||
#ECMD_SimpleWrite($hash, $hash->{initString});
|
||||
|
||||
$hash->{STATE} = "Initialized" if(!$hash->{STATE});
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
########################
|
||||
sub
|
||||
ECMD_SimpleWrite(@)
|
||||
{
|
||||
my ($hash, $msg, $nonl) = @_;
|
||||
return if(!$hash);
|
||||
|
||||
$msg .= "\n" unless($nonl);
|
||||
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
|
||||
|
||||
select(undef, undef, undef, 0.001);
|
||||
}
|
||||
|
||||
########################
|
||||
sub
|
||||
ECMD_SimpleRead($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
if($hash->{TCPDev}) {
|
||||
my $buf;
|
||||
if(!defined(sysread($hash->{TCPDev}, $buf, 256))) {
|
||||
ECMD_Disconnected($hash);
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $buf;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
# This is a direct read for commands like get
|
||||
sub
|
||||
ECMD_ReadAnswer($$)
|
||||
{
|
||||
my ($hash, $arg) = @_;
|
||||
|
||||
#Log 5, "ECMD reading answer for get $arg...";
|
||||
|
||||
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 ("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 ("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
|
||||
Log 5, "ECMD (ReadAnswer): $buf";
|
||||
$data .= $buf;
|
||||
}
|
||||
return (undef, $data)
|
||||
}
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_SetState($$$$)
|
||||
{
|
||||
my ($hash, $tim, $vt, $val) = @_;
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
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/^Timeout/);
|
||||
}
|
||||
delete($hash->{RA_Timeout});
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Disconnected($)
|
||||
{
|
||||
my $hash = shift;
|
||||
my $ipaddress = $hash->{IPAddress};
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
return if(!defined($hash->{FD})); # Already deleted o
|
||||
|
||||
Log 1, "$ipaddress disconnected, waiting to reappear";
|
||||
ECMD_CloseDev($hash);
|
||||
$readyfnlist{"$name.$ipaddress"} = $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");
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Get($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
|
||||
return "get needs at least one parameter" if(@a < 2);
|
||||
|
||||
my $name = $a[0];
|
||||
my $cmd= $a[1];
|
||||
my $arg = ($a[2] ? $a[2] : "");
|
||||
my @args= @a; shift @args; shift @args;
|
||||
my ($msg, $err);
|
||||
|
||||
return "No get $cmd for dummies" if(IsDummy($name));
|
||||
|
||||
if($cmd eq "raw") {
|
||||
return "get raw needs an argument" if(@a< 3);
|
||||
my $ecmd= join " ", @args;
|
||||
Log 5, $ecmd;
|
||||
ECMD_SimpleWrite($hash, $ecmd);
|
||||
($err, $msg) = ECMD_ReadAnswer($hash, "raw");
|
||||
return $err if($err);
|
||||
} else {
|
||||
return "get $cmd: unknown command ";
|
||||
}
|
||||
|
||||
$hash->{READINGS}{$cmd}{VAL} = $msg;
|
||||
$hash->{READINGS}{$cmd}{TIME} = TimeNow();
|
||||
|
||||
return "$name $cmd => $msg";
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Set($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
my $name = $a[0];
|
||||
|
||||
# usage check
|
||||
my $usage= "Usage: set $name classdef <classname> <filename> ";
|
||||
return $usage if(@a != 4);
|
||||
return $usage if($a[1] ne "classdef");
|
||||
|
||||
# from the definition
|
||||
my $classname= $a[2];
|
||||
my $filename= $a[3];
|
||||
|
||||
# refuse overwriting existing definitions
|
||||
if(defined($hash->{fhem}{classDefs}{$classname})) {
|
||||
my $err= "$name: class $classname is already defined.";
|
||||
Log 1, $err;
|
||||
return $err;
|
||||
}
|
||||
|
||||
# try and open the class definition file
|
||||
if(!open(CLASSDEF, $filename)) {
|
||||
my $err= "$name: cannot open file $filename for class $classname.";
|
||||
Log 1, $err;
|
||||
return $err;
|
||||
}
|
||||
my @classdef= <CLASSDEF>;
|
||||
close(CLASSDEF);
|
||||
|
||||
# add the class definition
|
||||
Log 5, "$name: adding new class $classname from file $filename";
|
||||
$hash->{fhem}{classDefs}{$classname}{filename}= $filename;
|
||||
|
||||
# format of the class definition:
|
||||
# params <params> parameters for device definition
|
||||
# get <cmdname> cmd {<perlexpression>} defines a get command
|
||||
# get <cmdname> params <params> parameters for get command
|
||||
# set <cmdname> cmd {<perlexpression>} defines a set command
|
||||
# set <cmdname> params <params> parameters for get command
|
||||
# all lines are optional
|
||||
#
|
||||
# eaxmple class definition 1:
|
||||
# get adc cmd {"adc get %channel"}
|
||||
# get adc params channel
|
||||
#
|
||||
# eaxmple class definition 1:
|
||||
# params btnup btnstop btndown
|
||||
# set up cmd {"io set ddr 2 ff\nio set port 2 1%btnup\nwait 1000\nio set port 2 00"}
|
||||
# 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"}
|
||||
|
||||
foreach my $line (@classdef) {
|
||||
# kill trailing newline
|
||||
chomp $line;
|
||||
# kill comments and blank lines
|
||||
$line=~ s/\#.*$//;
|
||||
$line=~ s/\s+$//;
|
||||
next unless($line);
|
||||
Log 5, "$name: evaluating >$line<";
|
||||
# split line into command and definition
|
||||
my ($cmd, $def)= split("[ \t]+", $line, 2);
|
||||
if($cmd eq "params") {
|
||||
Log 5, "$name: parameters are $def";
|
||||
$hash->{fhem}{classDefs}{$classname}{params}= $def;
|
||||
} elsif($cmd eq "set" || $cmd eq "get") {
|
||||
my ($cmdname, $spec, $arg)= split("[ \t]+", $def, 3);
|
||||
if($spec eq "params") {
|
||||
if($cmd eq "set") {
|
||||
Log 5, "$name: set $cmdname has parameters $arg";
|
||||
$hash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{params}= $arg;
|
||||
} elsif($cmd eq "get") {
|
||||
Log 5, "$name: get $cmdname has parameters $arg";
|
||||
$hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params}= $arg;
|
||||
}
|
||||
} elsif($spec eq "cmd") {
|
||||
if($arg !~ m/^{.*}$/s) {
|
||||
Log 1, "$name: command for $cmd $cmdname is not a perl command.";
|
||||
next;
|
||||
}
|
||||
$arg =~ s/^(\\\n|[ \t])*//; # Strip space or \\n at the begginning
|
||||
$arg =~ s/[ \t]*$//;
|
||||
if($cmd eq "set") {
|
||||
Log 5, "$name: set $cmdname defined as $arg";
|
||||
$hash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{cmd}= $arg;
|
||||
} elsif($cmd eq "get") {
|
||||
Log 5, "$name: get $cmdname defined as $arg";
|
||||
$hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{cmd}= $arg;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
Log 1, "$name: illegal tag $cmd for class $classname in file $filename.";
|
||||
}
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
ECMD_Write($$)
|
||||
{
|
||||
my ($hash,$msg) = @_;
|
||||
my $answer;
|
||||
my @r;
|
||||
my @ecmds= split "\n", $msg;
|
||||
foreach my $ecmd (@ecmds) {
|
||||
Log 5, "$hash->{NAME} sending $ecmd";
|
||||
ECMD_SimpleWrite($hash, $ecmd);
|
||||
$answer= ECMD_ReadAnswer($hash, "'ecmd");
|
||||
push @r, $answer;
|
||||
Log 5, $answer;
|
||||
}
|
||||
return join(";", @r);
|
||||
}
|
||||
|
||||
#####################################
|
||||
|
||||
1;
|
||||
203
fhem/FHEM/67_ECMDDevice.pm
Normal file
203
fhem/FHEM/67_ECMDDevice.pm
Normal file
@ -0,0 +1,203 @@
|
||||
#
|
||||
#
|
||||
# 66_ECMDDevice.pm
|
||||
# written by Dr. Boris Neubert 2011-01-15
|
||||
# e-mail: omega at online dot de
|
||||
#
|
||||
##############################################
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Time::HiRes qw(gettimeofday);
|
||||
|
||||
sub ECMDDevice_Get($@);
|
||||
sub ECMDDevice_Set($@);
|
||||
sub ECMDDevice_Define($$);
|
||||
|
||||
my %gets= (
|
||||
);
|
||||
|
||||
my %sets= (
|
||||
);
|
||||
|
||||
###################################
|
||||
sub
|
||||
ECMDDevice_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
$hash->{GetFn} = "ECMDDevice_Get";
|
||||
$hash->{SetFn} = "ECMDDevice_Set";
|
||||
$hash->{DefFn} = "ECMDDevice_Define";
|
||||
|
||||
$hash->{AttrList} = "loglevel 0,1,2,3,4,5";
|
||||
}
|
||||
|
||||
sub
|
||||
ECMDDevice_AnalyzeCommand($)
|
||||
{
|
||||
my ($ecmd)= @_;
|
||||
Log 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_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})) {
|
||||
return "$name error: unknown command $cmdname";
|
||||
}
|
||||
|
||||
my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{cmd};
|
||||
my $params= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params};
|
||||
|
||||
my %specials= ECMDDevice_DeviceParams2Specials($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) {
|
||||
Log 5, "Parameter %". $param . " is " . $a[$i];
|
||||
$specials{"%".$param}= $a[$i++];
|
||||
}
|
||||
}
|
||||
$ecmd= EvalSpecials($ecmd, %specials);
|
||||
|
||||
my $r = ECMDDevice_AnalyzeCommand($ecmd);
|
||||
|
||||
my $v= IOWrite($hash, $r);
|
||||
|
||||
return "$name $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})) {
|
||||
return "$name error: unknown command $cmdname";
|
||||
}
|
||||
|
||||
my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{cmd};
|
||||
my $params= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params};
|
||||
|
||||
my %specials= ECMDDevice_DeviceParams2Specials($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= EvalSpecials($ecmd, %specials);
|
||||
|
||||
my $r = ECMDDevice_AnalyzeCommand($ecmd);
|
||||
|
||||
return IOWrite($hash, $r);
|
||||
}
|
||||
|
||||
|
||||
#############################
|
||||
|
||||
sub
|
||||
ECMDDevice_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my @a = split("[ \t]+", $def);
|
||||
|
||||
return "Usage: define <name> ECMDDevice <classname> [...]" if(int(@a) < 3);
|
||||
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;
|
||||
}
|
||||
|
||||
$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;
|
||||
@ -62,21 +62,13 @@ notify_Exec($$)
|
||||
$s = "" if(!defined($s));
|
||||
if($n =~ m/^$re$/ || "$n:$s" =~ m/^$re$/) {
|
||||
my (undef, $exec) = split("[ \t]+", $ntfy->{DEF}, 2);
|
||||
$exec = SemicolonEscape($exec);
|
||||
|
||||
$exec =~ s/%%/____/g;
|
||||
my $extsyntax= 0;
|
||||
$extsyntax+= ($exec =~ s/%TYPE/$t/g);
|
||||
$extsyntax+= ($exec =~ s/%NAME/$n/g);
|
||||
$extsyntax+= ($exec =~ s/%EVENT/$s/g);
|
||||
if(!$extsyntax) {
|
||||
$exec =~ s/%/$s/g;
|
||||
}
|
||||
$exec =~ s/____/%/g;
|
||||
|
||||
$exec =~ s/@@/____/g;
|
||||
$exec =~ s/@/$n/g;
|
||||
$exec =~ s/____/@/g;
|
||||
my %specials= (
|
||||
"%NAME" => $n,
|
||||
"%TYPE" => $t,
|
||||
"%EVENT" => $s
|
||||
);
|
||||
$exec= EvalSpecials($exec, %specials);
|
||||
|
||||
my $r = AnalyzeCommandChain(undef, $exec);
|
||||
Log 3, $r if($r);
|
||||
|
||||
@ -80,6 +80,8 @@
|
||||
<a href="#CUL_HOERMANN">CUL_HOERMANN</a>
|
||||
<a href="#CUL_RFR">CUL_RFR</a>
|
||||
<a href="#CUL_WS">CUL_WS</a>
|
||||
<a href="#ECMD">ECMD</a>
|
||||
<a href="#ECMDDevice">ECMDDevice</a>
|
||||
<a href="#DS18S20">DS18S20</a>
|
||||
<a href="#EM">EM</a>
|
||||
<a href="#EMEM">EMEM</a>
|
||||
@ -3589,6 +3591,262 @@ Attributes:<br>
|
||||
|
||||
</ul>
|
||||
|
||||
|
||||
<a name="ECMD"></a>
|
||||
<h3>ECMD</h3>
|
||||
<ul>
|
||||
<br>
|
||||
Any physical device with request/response-like communication capabilities
|
||||
over a TCP connection can be defined as ECMD device. A practical example
|
||||
of such a device is the AVR microcontroller board AVR-NET-IO from
|
||||
<a href="http://www.pollin.de">Pollin</a> with
|
||||
<a href="http://www.ethersex.de/index.php/ECMD">ECMD</a>-enabled
|
||||
<a href="http://www.ethersex.de">Ethersex</a> firmware.<p>
|
||||
|
||||
A physical ECMD device can host any number of logical ECMD devices. Logical
|
||||
devices are defined as <a href="#ECMDDevice">ECMDDevice</a>s in fhem.
|
||||
ADC 0 to 3 and I/O port 0 to 3 of the above mentioned board
|
||||
are examples of such logical devices. ADC 0 to 3 all belong to the same
|
||||
device class ADC (analog/digital converter). I/O port 0 to 3 belong to the device
|
||||
class I/O port. By means of extension boards you can make your physical
|
||||
device drive as many logical devices as you can imagine, e.g. IR receivers,
|
||||
LC displays, RF receivers/transmitters, 1-wire devices, etc.<p>
|
||||
|
||||
Defining one fhem module for any device class would create an unmanageable
|
||||
number of modules. Thus, an abstraction layer is used. You create a device class
|
||||
on the fly and assign it to a logical ECMD device. The
|
||||
<a href="#ECMDClassdef">class definition</a>
|
||||
names the parameters of the logical device, e.g. a placeholder for the number
|
||||
of the ADC or port, as well as the get and set capabilities. Worked examples
|
||||
are to be found in the documentation of the <a href="#ECMDDevice">ECMDDevice</a> device.
|
||||
<br><br>
|
||||
|
||||
<a name="ECMDdefine"></a>
|
||||
<b>Define</b>
|
||||
<ul>
|
||||
<code>define <name> ECMD telnet <IPAddress:Port></code>
|
||||
<br><br>
|
||||
|
||||
Defines a physical ECMD device. The keyword <code>telnet</code> is fixed.<br><br>
|
||||
|
||||
Example:
|
||||
<ul>
|
||||
<code>define AVRNETIO ECMD telnet 192.168.0.91:2701</code><br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
|
||||
<a name="ECMDset"></a>
|
||||
<b>Set</b>
|
||||
<ul>
|
||||
<code>set <name> classdef <classname> <filename></code>
|
||||
<br><br>
|
||||
Creates a new device class <code><classname></code> for logical devices.
|
||||
The class definition is in the file <code><filename></code>. You must
|
||||
create the device class before you create a logical device that adheres to
|
||||
that definition.
|
||||
<br><br>
|
||||
Example:
|
||||
<ul>
|
||||
<code>define AVRNETIO classdef /etc/fhem/ADC.classdef</code><br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
|
||||
|
||||
<a name="ECMDget"></a>
|
||||
<b>Get</b>
|
||||
<ul>
|
||||
<code>get <name> raw <command></code>
|
||||
<br><br>
|
||||
Sends the command <code><command></code> to the physical ECMD device
|
||||
<code><name></code> and reads the response.
|
||||
</ul>
|
||||
<br><br>
|
||||
|
||||
<a name="ECMDClassdef"></a>
|
||||
<b>Class definition</b>
|
||||
<br><br>
|
||||
<ul>
|
||||
|
||||
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.<br>
|
||||
|
||||
The following commands are recognized in the device class definition:<br><br>
|
||||
<ul>
|
||||
<li><code>params <parameter1> [<parameter2> [<parameter3> ... ]]</code><br><br>
|
||||
Declares the names of the named parameters that must be present in the
|
||||
<a href="#ECMDDevicedefine">definition of the logical ECMD device</a>.
|
||||
<br><br>
|
||||
</li>
|
||||
|
||||
<li><code>set <commandname> cmd { <a href="#perl"><perl special></a> }</code>
|
||||
<br><br>
|
||||
Declares a new set command <code><commandname></code>.
|
||||
<br><br>
|
||||
</li>
|
||||
|
||||
<li><code>get <commandname> cmd { <a href="#perl"><perl special></a> }</code>
|
||||
<br><br>
|
||||
Declares a new get command <code><commandname></code>.
|
||||
<br><br>
|
||||
</li>
|
||||
|
||||
<li>
|
||||
<code>set <name> params <parameter1> [<parameter2> [<parameter3> ... ]]</code>
|
||||
<code>get <name> params <parameter1> [<parameter2> [<parameter3> ... ]]</code>
|
||||
<br><br>
|
||||
Declares the names of the named parameters that must be present in the
|
||||
set or get command <code><name></code></a>. Be careful not to use a parameter name that
|
||||
is already used in the device definition (see <code>params</code> above).
|
||||
<br><br>
|
||||
</li>
|
||||
|
||||
</ul>
|
||||
|
||||
The perl specials in the definitions of the set and get commands can contain macros. Apart from the rules
|
||||
outlined in the <a href="#perl">documentation of perl specials</a> in fhem, the following rules apply:<br><br>
|
||||
<ul>
|
||||
<li>The character @ will be replaced with the device
|
||||
name. To use @ in the text itself, use the double mode (@@).</li>
|
||||
|
||||
<li>The macro <code>%NAME</code> will expand to the device name (same as <code>@</code>).</li>
|
||||
|
||||
<li>The macro <code>%<parameter></code> 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.</li>
|
||||
|
||||
<li>The macro substitution occurs before perl evaluates the expression. It is a plain text substitution.</li>
|
||||
|
||||
<li>If in doubt what happens, run the commands with loglevel 5 and observe the log file.</li>
|
||||
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
<a name="ECMDDevice"></a>
|
||||
<h3>ECMDDevice</h3>
|
||||
<ul>
|
||||
<br>
|
||||
<a name="ECMDDevicedefine"></a>
|
||||
<b>Define</b>
|
||||
<ul>
|
||||
<code>define <name> ECMDDevice <classname> [<parameter1> [<parameter2> [<parameter3> ... ]]]</code>
|
||||
<br><br>
|
||||
|
||||
Defines a logical ECMD device. The number of given parameters must match those given in
|
||||
the <a href="#ECMDClassdef">class definition</a> of the device class <code><classname></code>.
|
||||
<br><br>
|
||||
|
||||
Examples:
|
||||
<ul>
|
||||
<code>define myADC ECMDDevice ADC</code><br>
|
||||
<code>define myRelais1 ECMDDevice relais 8</code><br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
|
||||
<a name="ECMDDeviceset"></a>
|
||||
<b>Set</b>
|
||||
<ul>
|
||||
<code>set <name> <commandname> [<parameter1> [<parameter2> [<parameter3> ... ]]]</code>
|
||||
<br><br>
|
||||
The number of given parameters must match those given for the set command <code><commandname></code> definition in
|
||||
the <a href="#ECMDClassdef">class definition</a>.<br><br>
|
||||
If <code>set <commandname></code> is invoked the perl special in curly brackets from the command definition
|
||||
is evaluated and the result is sent to the physical ECMD device.
|
||||
<br><br>
|
||||
Example:
|
||||
<ul>
|
||||
<code>get myADC value 3</code><br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
|
||||
|
||||
<a name="ECMDDeviceget"></a>
|
||||
<b>Get</b>
|
||||
<ul>
|
||||
<code>get <name> <commandname> [<parameter1> [<parameter2> [<parameter3> ... ]]]</code>
|
||||
<br><br>
|
||||
The number of given parameters must match those given for the get command <code><commandname></code> definition in
|
||||
the <a href="#ECMDClassdef">class definition</a>.<br><br>
|
||||
If <code>get <commandname></code> 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.
|
||||
<br><br>
|
||||
Example:
|
||||
<ul>
|
||||
<code>set myRelais1 on</code><br>
|
||||
</ul>
|
||||
<br>
|
||||
</ul>
|
||||
|
||||
|
||||
<b>Example 1</b>
|
||||
<br><br>
|
||||
<ul>
|
||||
The following example shows how to access the ADC of the AVR-NET-IO board from
|
||||
<a href="http://www.pollin.de">Pollin</a> with
|
||||
<a href="http://www.ethersex.de/index.php/ECMD">ECMD</a>-enabled
|
||||
<a href="http://www.ethersex.de">Ethersex</a> firmware.<br><br>
|
||||
|
||||
The class definition file <code>/etc/fhem/ADC.classdef</code> looks as follows:<br><br>
|
||||
<code>
|
||||
get value cmd {"adc get %channel"} <br>
|
||||
get value params channel<br>
|
||||
</code>
|
||||
<br>
|
||||
In the fhem configuration file or on the fhem command line we do the following:<br><br>
|
||||
<code>
|
||||
define AVRNETIO telnet 192.168.0.91:2701 # define the physical device<br>
|
||||
set AVRNETIO classdef ADC /etc/fhem/ADC.classdef # define the device class ADC<br>
|
||||
define myADC ADC # define the logical device myADC with device cass ADC<br>
|
||||
get myADC value 1 # retrieve the value of analog/digital converter number 1<br>
|
||||
</code>
|
||||
<br>
|
||||
The get command is evaluated as follows: <code>get value</code> has one named parameter
|
||||
<code>channel</code>. In the example the literal <code>1</code> is given and thus <code>%channel</code>
|
||||
is replaced by <code>1</code> to yield <code>"adc get 1"</code> 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 <code>024</code> for the current value of analog/digital converter number 1.
|
||||
<br><br>
|
||||
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
<b>Example 2</b>
|
||||
<br><br>
|
||||
<ul>
|
||||
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.<br><br>
|
||||
|
||||
The class definition file <code>/etc/fhem/relais.classdef</code> looks as follows:<br><br>
|
||||
<code>
|
||||
params pinmask<br>
|
||||
set on cmd {"io set ddr 2 ff\nioset port 2 0%pinmask\nwait 1000\nio set port 2 00"}<br>
|
||||
</code>
|
||||
<br>
|
||||
In the fhem configuration file or on the fhem command line we do the following:<br><br>
|
||||
<code>
|
||||
define AVRNETIO telnet 192.168.0.91:2701 # define the physical device<br>
|
||||
set AVRNETIO classdef relais /etc/fhem/relais.classdef # define the device class relais<br>
|
||||
define myRelais 8 # define the logical device myRelais with pin mask 8<br>
|
||||
set myRelais on # execute the "on" command<br>
|
||||
</code>
|
||||
<br>
|
||||
The set command is evaluated as follows: <code>%pinmask</code>
|
||||
is replaced by <code>8</code> to yield
|
||||
<code>"io set ddr 2 ff\nioset port 2 08\nwait 1000\nio set port 2 00"</code> after macro substitution. Perl
|
||||
evaluates this to a literal string which is send as a plain ethersex command to the AVR-NET-IO line by line.
|
||||
<br><br>
|
||||
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
|
||||
|
||||
|
||||
<a name="M232"></a>
|
||||
<h3>M232</h3>
|
||||
<ul>
|
||||
|
||||
78
fhem/fhem.pl
78
fhem/fhem.pl
@ -164,7 +164,7 @@ my $nextat; # Time when next timer will be triggered.
|
||||
my $intAtCnt=0;
|
||||
my %duplicate; # Pool of received msg for multi-fhz/cul setups
|
||||
my $duplidx=0; # helper for the above pool
|
||||
my $cvsid = '$Id: fhem.pl,v 1.121 2011-01-02 14:45:53 rudolfkoenig Exp $';
|
||||
my $cvsid = '$Id: fhem.pl,v 1.122 2011-01-22 21:53:18 neubert Exp $';
|
||||
my $namedef =
|
||||
"where <name> is either:\n" .
|
||||
"- a single device name\n" .
|
||||
@ -318,6 +318,8 @@ Log 0, "Server started (version $attr{global}{version}, pid $$)";
|
||||
################################################
|
||||
# Main Loop
|
||||
sub MAIN {MAIN:}; #Dummy
|
||||
|
||||
my $errcount= 0;
|
||||
while (1) {
|
||||
my ($rout, $rin) = ('', '');
|
||||
|
||||
@ -329,6 +331,9 @@ while (1) {
|
||||
vec($rin, fileno($client{$c}{fd}), 1) = 1;
|
||||
}
|
||||
|
||||
# for documentation see
|
||||
# man 2 select
|
||||
# http://perldoc.perl.org/functions/select.html
|
||||
my $timeout = HandleTimeout();
|
||||
$timeout = $readytimeout if(keys(%readyfnlist) &&
|
||||
(!defined($timeout) || $timeout > $readytimeout));
|
||||
@ -340,21 +345,27 @@ while (1) {
|
||||
my $err = int($!);
|
||||
next if ($err == 0);
|
||||
|
||||
Log 1, "ERROR: Select error $nfound ($err), error count= $errcount";
|
||||
$errcount++;
|
||||
|
||||
# Handling "Bad file descriptor". This is a programming error.
|
||||
if($! == $err) { # BADF, don't want to "use errno.ph"
|
||||
if($err == 9) { # BADF, don't want to "use errno.ph"
|
||||
my $nbad = 0;
|
||||
foreach my $p (keys %selectlist) {
|
||||
my ($tin, $tout) = ('', '');
|
||||
vec($tin, $selectlist{$p}{FD}, 1) = 1;
|
||||
if(select($tout=$tin, undef, undef, 0) < 0) {
|
||||
Log 0, "ERROR: Found & deleted bad fileno for $p";
|
||||
Log 1, "Found and deleted bad fileno for $p";
|
||||
delete($selectlist{$p});
|
||||
$nbad++;
|
||||
}
|
||||
}
|
||||
next if($nbad > 0);
|
||||
next if($errcount <= 3);
|
||||
}
|
||||
die("Select error $nfound / $!\n");
|
||||
die("Select error $nfound ($err)\n");
|
||||
} else {
|
||||
$errcount= 0;
|
||||
}
|
||||
|
||||
###############################
|
||||
@ -618,19 +629,10 @@ AnalyzeCommandChain($$)
|
||||
|
||||
#####################################
|
||||
sub
|
||||
AnalyzeCommand($$)
|
||||
AnalyzePerlCommand($$)
|
||||
{
|
||||
my ($cl, $cmd) = @_;
|
||||
|
||||
$cmd =~ s/^(\\\n|[ \t])*//; # Strip space or \\n at the begginning
|
||||
$cmd =~ s/[ \t]*$//;
|
||||
|
||||
|
||||
Log 5, "Cmd: >$cmd<";
|
||||
return if(!$cmd);
|
||||
|
||||
if($cmd =~ m/^{.*}$/s) { # Perl code
|
||||
|
||||
$cmd =~ s/\\ *\n/ /g; # Multi-line
|
||||
# Make life easier for oneliners:
|
||||
%value = ();
|
||||
@ -650,7 +652,22 @@ AnalyzeCommand($$)
|
||||
$ret = $@ if($@);
|
||||
syswrite($client{$cl}{fd}, "$ret\n") if($ret && $cl);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
AnalyzeCommand($$)
|
||||
{
|
||||
my ($cl, $cmd) = @_;
|
||||
|
||||
$cmd =~ s/^(\\\n|[ \t])*//; # Strip space or \\n at the begginning
|
||||
$cmd =~ s/[ \t]*$//;
|
||||
|
||||
|
||||
Log 5, "Cmd: >$cmd<";
|
||||
return if(!$cmd);
|
||||
|
||||
if($cmd =~ m/^{.*}$/s) { # Perl code
|
||||
return AnalyzePerlCommand($cl, $cmd);
|
||||
}
|
||||
|
||||
if($cmd =~ m/^"(.*)"$/s) { # Shell code, always in bg
|
||||
@ -1925,6 +1942,39 @@ SemicolonEscape($)
|
||||
return $cmd;
|
||||
}
|
||||
|
||||
sub
|
||||
EvalSpecials($%)
|
||||
{
|
||||
# The character % will be replaced with the received event,
|
||||
# e.g. with on or off or measured-temp: 21.7 (Celsius)
|
||||
# The character @ will be replaced with the device name.
|
||||
# To use % or @ in the text itself, use the double mode (%% or @@).
|
||||
# Instead of % and @, the parameters %EVENT (same as %),
|
||||
# %NAME (same as @) and %TYPE (contains the device type, e.g. FHT)
|
||||
# can be used. A single % looses its special meaning if any of these
|
||||
# parameters appears in the definition.
|
||||
|
||||
my ($exec, %specials)= @_;
|
||||
$exec = SemicolonEscape($exec);
|
||||
|
||||
$exec =~ s/%%/____/g;
|
||||
# perform macro substitution
|
||||
my $extsyntax= 0;
|
||||
foreach my $special (keys %specials) {
|
||||
$extsyntax+= ($exec =~ s/$special/$specials{$special}/g);
|
||||
}
|
||||
if(!$extsyntax) {
|
||||
$exec =~ s/%/$specials{"%EVENT"}/g;
|
||||
}
|
||||
$exec =~ s/____/%/g;
|
||||
|
||||
$exec =~ s/@@/____/g;
|
||||
$exec =~ s/@/$specials{"%NAME"}/g;
|
||||
$exec =~ s/____/@/g;
|
||||
|
||||
return $exec;
|
||||
}
|
||||
|
||||
#####################################
|
||||
# Parse a timespec: Either HH:MM:SS or HH:MM or { perfunc() }
|
||||
sub
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user