From d51f8d37f5bdc1cb3927280ba94561d9d6d1b387 Mon Sep 17 00:00:00 2001
From: rudolfkoenig <>
Date: Wed, 3 Dec 2008 16:45:26 +0000
Subject: [PATCH] 4.5 prep
git-svn-id: https://svn.fhem.de/fhem/trunk@273 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
fhem/FHEM/00_CUL.pm | 158 ++++++++++++++++++++++++++++----------------
fhem/FHEM/00_FHZ.pm | 10 +--
fhem/HISTORY | 19 +++++-
fhem/fhem.pl | 56 +++++++++++-----
4 files changed, 165 insertions(+), 78 deletions(-)
diff --git a/fhem/FHEM/00_CUL.pm b/fhem/FHEM/00_CUL.pm
index 1acff6165..279f606b4 100755
--- a/fhem/FHEM/00_CUL.pm
+++ b/fhem/FHEM/00_CUL.pm
@@ -1,22 +1,7 @@
##############################################
-# Implemented:
-# - Transmit limit trigger: Fire if more then 1% airtime
-# is used in the last hour
-# - reconnect
-# - message flow control (send one F message every 0.25 seconds)
-# - repeater/filtertimeout
-# - FS20 rcv
-# - FS20 xmit
-# - FHT rcv
-
# TODO:
# - FHT xmit
# - HMS rcv
-# - KS300 rcv
-# - EMEM rcv
-# - EMWZ rcv
-# - EMGZ rcv
-# - S300TH rcv
package main;
@@ -29,22 +14,18 @@ use Time::HiRes qw(gettimeofday);
sub CUL_Write($$$);
sub CUL_Read($);
sub CUL_ReadAnswer($$);
-sub CUL_Ready($$);
+sub CUL_Ready($);
my $initstr = "X01"; # Only translated messages, no RSSI
my %msghist; # Used when more than one CUL is attached
my $msgcount = 0;
my %gets = (
- "ccreg" => "C",
- "eeprom" => "R",
"version" => "V",
- "time" => "t",
"raw" => "",
"ccconf" => "=",
);
my %sets = (
- "eeprom" => "W",
"raw" => "",
"verbose" => "X",
"freq" => "=",
@@ -60,7 +41,7 @@ CUL_Initialize($)
$hash->{ReadFn} = "CUL_Read";
$hash->{WriteFn} = "CUL_Write";
$hash->{Clients} = ":FS20:FHT:KS300:CUL_EM:CUL_WS:";
- $hash->{ReadyFn} = "CUL_Ready" if ($^O eq 'MSWin32');
+ $hash->{ReadyFn} = "CUL_Ready";
# Normal devices
$hash->{DefFn} = "CUL_Define";
@@ -69,7 +50,7 @@ CUL_Initialize($)
$hash->{SetFn} = "CUL_Set";
$hash->{StateFn} = "CUL_SetState";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " .
- "showtime:1,0 model:CUL loglevel:0,1,2,3,4,5,6";
+ "showtime:1,0 model:CUL,CUR loglevel:0,1,2,3,4,5,6";
}
#####################################
@@ -79,13 +60,17 @@ CUL_Define($$)
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $po;
- $hash->{STATE} = "Initialized";
+
+ return "wrong syntax: define <name> CUL devicename [mobile]"
+ if(@a < 3 || @a > 4);
delete $hash->{PortObj};
delete $hash->{FD};
my $name = $a[0];
my $dev = $a[2];
+ $hash->{MOBILE} = 1 if($a[3] && $a[3] eq "mobile");
+ $hash->{STATE} = "defined";
$attr{$name}{savefirst} = 1;
$attr{$name}{repeater} = 1;
@@ -96,6 +81,8 @@ CUL_Define($$)
return undef;
}
+ $hash->{DeviceName} = $dev;
+ $hash->{PARTIAL} = "";
Log 3, "CUL opening CUL device $dev";
if ($^O=~/Win/) {
require Win32::SerialPort;
@@ -104,7 +91,13 @@ CUL_Define($$)
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
- return "Can't open $dev: $!\n" if(!$po);
+ if(!$po) {
+ my $msg = "Can't open $dev: $!";
+ Log(3, $msg) if($hash->{MOBILE});
+ return $msg if(!$hash->{MOBILE});
+ $readyfnlist{"$name.$dev"} = $hash;
+ return "";
+ }
Log 3, "CUL opened CUL device $dev";
$hash->{PortObj} = $po;
@@ -115,9 +108,12 @@ CUL_Define($$)
$readyfnlist{"$name.$dev"} = $hash;
}
- $hash->{DeviceName} = $dev;
- $hash->{PARTIAL} = "";
- return CUL_DoInit($hash);
+ my $ret = CUL_DoInit($hash);
+ if($ret) {
+ delete($selectlist{"$name.$dev"});
+ delete($readyfnlist{"$name.$dev"});
+ }
+ return $ret;
}
#####################################
@@ -165,9 +161,9 @@ CUL_Set($@)
my $msg = "Setting FREQ2..0 (0D,0E,0F) to $f2 $f1 $f0 = $arg MHz, ".
"verbose to $initstr";
Log GetLogLevel($name,4), $msg;
- CUL_SimpleWrite($hash, "W0D$f2"); # Will reprogram the CC1101
- CUL_SimpleWrite($hash, "W0E$f1");
- CUL_SimpleWrite($hash, "W0F$f0");
+ CUL_SimpleWrite($hash, "W0F$f2"); # Will reprogram the CC1101
+ CUL_SimpleWrite($hash, "W10$f1");
+ CUL_SimpleWrite($hash, "W11$f0");
CUL_SimpleWrite($hash, $initstr);
return $msg;
@@ -194,7 +190,7 @@ GOTBW:
my $msg = "Setting MDMCFG4 (10) to $ob = $bw KHz, verbose to $initstr";
Log GetLogLevel($name,4), $msg;
- CUL_SimpleWrite($hash, "W10$ob");
+ CUL_SimpleWrite($hash, "W12$ob");
CUL_SimpleWrite($hash, $initstr);
return $msg;
@@ -228,21 +224,19 @@ CUL_Get($@)
if($a[1] eq "ccconf") {
my %r = ( "0D"=>1,"0E"=>1,"0F"=>1,"10"=>1,"1B"=>1,"1D"=>1,
- "23"=>1,"24"=>1,"25"=>1,"26"=>1,"34"=>1) ;
+ "23"=>1,"24"=>1,"25"=>1,"26"=>1) ;
foreach my $a (sort keys %r) {
CUL_SimpleWrite($hash, "C$a");
my @answ = split(" ", CUL_ReadAnswer($hash, "C$a"));
$r{$a} = $answ[4];
}
$msg = sprintf("Freq:%.3fMHz Bwidth:%dKHz Ampl:%ddB " .
- "Sens:%ddB FSCAL:%02X%02X%02X%02X RSSI: %ddB",
+ "Sens:%ddB FSCAL:%02X%02X%02X%02X",
26*(($r{"0D"}*256+$r{"0E"})*256+$r{"0F"})/65536, #Freq
26000/(8 * (4+(($r{"10"}>>4)&3)) * (1 << (($r{"10"}>>6)&3))), #Bw
$r{"1B"}&7<4 ? 24+3*($r{"1B"}&7) : 36+2*(($r{"1B"}&7)-4), #Ampl
4+4*($r{"1D"}&3), #Sens
- $r{"23"}, $r{"24"}, $r{"25"}, $r{"26"}, #FSCAL
- $r{"34"}>=128 ? (($r{34}-256)/2-74) : ($r{34}/2-74) #RSSI
-
+ $r{"23"}, $r{"24"}, $r{"25"}, $r{"26"} #FSCAL
);
} else {
@@ -292,10 +286,12 @@ CUL_DoInit($)
return $msg;
}
CUL_SimpleWrite($hash, $initstr);
+ $hash->{STATE} = "Initialized";
# Reset the counter
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
+ return undef;
}
#####################################
@@ -310,7 +306,7 @@ CUL_ReadAnswer($$)
my $nfound;
for(;;) {
if($^O eq 'MSWin32') {
- $nfound=CUL_Ready($hash, undef);
+ $nfound=CUL_Ready($hash);
} else {
vec($rin, $hash->{FD}, 1) = 1;
my $to = 3; # 3 seconds timeout
@@ -438,8 +434,8 @@ sub
CUL_HandleWriteQueue($)
{
my $hash = shift;
- my $cnt = --$hash->{QUEUECNT};
- if($cnt > 0) {
+ if($hash->{QUEUECNT} > 0) {
+ $hash->{QUEUECNT}--;
my $bstring = shift(@{$hash->{QUEUE}});
CUL_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring);
@@ -465,24 +461,42 @@ CUL_Read($)
if(!defined($buf) || length($buf) == 0) {
- my $devname = $hash->{DeviceName};
- Log 1, "USB device $devname disconnected, waiting to reappear";
+ my $dev = $hash->{DeviceName};
+ Log 1, "USB device $dev disconnected, waiting to reappear";
$hash->{PortObj}->close();
- for(;;) {
+
+ if($hash->{MOBILE}) {
+
+ delete($hash->{PortObj});
+ delete($selectlist{"$name.$dev"});
+ $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);
- if ($^O eq 'MSWin32') {
- $hash->{PortObj} = new Win32::SerialPort($devname);
- }else{
- $hash->{PortObj} = new Device::SerialPort($devname);
- }
-
- if($hash->{PortObj}) {
- Log 1, "USB device $devname reappeared";
- $hash->{FD} = $hash->{PortObj}->FILENO if !($^O eq 'MSWin32');
- CUL_DoInit($hash);
- return;
+
+ return "";
+
+ } else {
+
+ for(;;) {
+ sleep(5);
+ if ($^O eq 'MSWin32') {
+ $hash->{PortObj} = new Win32::SerialPort($dev);
+ }else{
+ $hash->{PortObj} = new Device::SerialPort($dev);
+ }
+
+ if($hash->{PortObj}) {
+ Log 1, "USB device $dev reappeared";
+ $hash->{FD} = $hash->{PortObj}->FILENO if !($^O eq 'MSWin32');
+ CUL_DoInit($hash);
+ return;
+ }
}
}
+
}
my $culdata = $hash->{PARTIAL};
@@ -618,11 +632,43 @@ NEXTMSG:
#####################################
sub
-CUL_Ready($$) # Windows - only
+CUL_Ready($) # Windows - only
{
- my ($hash, $dev) = @_;
+ my ($hash) = @_;
my $po=$hash->{PortObj};
- return undef if !$po;
+
+ if(!$po) { # Looking for the device
+
+ my $dev = $hash->{DeviceName};
+ my $name = $hash->{NAME};
+
+ $hash->{PARTIAL} = "";
+ if ($^O=~/Win/) {
+ $po = new Win32::SerialPort ($dev);
+ } else {
+ $po = new Device::SerialPort ($dev);
+ }
+ return undef if(!$po);
+
+ Log 1, "USB device $dev reappeared";
+ $hash->{PortObj} = $po;
+ if( $^O !~ /Win/ ) {
+ $hash->{FD} = $po->FILENO;
+ delete($readyfnlist{"$name.$dev"});
+ $selectlist{"$name.$dev"} = $hash;
+ } else {
+ $readyfnlist{"$name.$dev"} = $hash;
+ }
+ my $ret = CUL_DoInit($hash);
+ if($ret) {
+ delete($selectlist{"$name.$dev"});
+ delete($readyfnlist{"$name.$dev"});
+ }
+ return $ret;
+
+ }
+
+ # This is relevant for windows only
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
diff --git a/fhem/FHEM/00_FHZ.pm b/fhem/FHEM/00_FHZ.pm
index c8ef2eaf6..ccd3e4ca3 100755
--- a/fhem/FHEM/00_FHZ.pm
+++ b/fhem/FHEM/00_FHZ.pm
@@ -82,9 +82,9 @@ FHZ_Initialize($)
}
#####################################
sub
-FHZ_Ready($$)
+FHZ_Ready($)
{
- my ($hash, $dev) = @_;
+ my ($hash) = @_;
my $po=$hash->{PortObj};
return undef if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
@@ -407,7 +407,7 @@ FHZ_ReadAnswer($$)
my $nfound;
for(;;) {
if($^O eq 'MSWin32') {
- $nfound=FHZ_Ready($hash,$def);
+ $nfound=FHZ_Ready($hash);
} else {
vec($rin, $hash->{FD}, 1) = 1;
$nfound = select($rin, undef, undef, 3); # 3 seconds timeout
@@ -535,8 +535,8 @@ sub
FHZ_HandleWriteQueue($)
{
my $hash = shift;
- my $cnt = --$hash->{QUEUECNT};
- if($cnt > 0) {
+ if($hash->{QUEUECNT} > 0) {
+ $hash->{QUEUECNT}--;
my $bstring = shift(@{$hash->{QUEUE}});
FHZ_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring);
diff --git a/fhem/HISTORY b/fhem/HISTORY
index 641b810b4..306b6312b 100644
--- a/fhem/HISTORY
+++ b/fhem/HISTORY
@@ -306,7 +306,7 @@
Todo: Test with IE+Adobe Plugin/Opera.
- feature: HOWTO for webpgm2 (first chapter)
-Fri Jul 25 18:14:26 MEST 2008
+- Fri Jul 25 18:14:26 MEST 2008
- Autoloading modules. In order to make module installation easier and
to optimize memory usage, modules are loaded when the first device of a
certain category is defined. Exceptions are the modules prefixed with 99,
@@ -323,6 +323,23 @@ Fri Jul 25 18:14:26 MEST 2008
devices in fhem
- feature: X10 support for pgm3
+- Sat Nov 15 10:23:56 MET 2008 (Rudi)
+ - Watchdog crash fixed: watchdog could insert itself more than once in the
+ internal timer queue. The first one deletes all occurances from the list,
+ but the loop over the list works on the cached keys -> the function/arg for
+ the second key is already removed.
+ - feature: X10 support for pgm3
+
- Boris Sat Nov 15 CET 2008
- bugfix: correct correction factors for EMEM in 15_CUL_EM.pm
+- Wed Dec 3 18:36:56 MET 2008 (Rudi)
+ - reorder commandref.html, so that all aspects of a device
+ (define/set/get/attributes) are in one block. This makes possible to
+ "outsource" device documentation
+ - added "mobile" flag to the CUL definition, intended for a CUR, which is
+ a remote with a battery, so it is not connected all the time to fhem.
+ Without the flag fhem will block when the CUR is disconnected.
+ Note: we have to sleep after disconnect for 5 seconds, else the Linux
+ kernel sends us a SIGSEGV, and the USB device is gone till the next reboot.
+ - the fhem CUL part documented
diff --git a/fhem/fhem.pl b/fhem/fhem.pl
index bd18b1c20..a2d727280 100755
--- a/fhem/fhem.pl
+++ b/fhem/fhem.pl
@@ -124,12 +124,15 @@ use vars qw(%defs); # FHEM device/button definitions
use vars qw(%attr); # Attributes
use vars qw(%selectlist); # devices which want a "select"
use vars qw(%readyfnlist); # devices which want a "readyfn"
+use vars qw($readytimeout); # Polling interval. UNIX: device search only
+$readytimeout = ($^O eq "MSWin32") ? 0.1 : 5.0;
use vars qw(%value); # Current values, see commandref.html
use vars qw(%oldvalue); # Old values, see commandref.html
use vars qw($init_done); #
use vars qw($internal_data); #
+
my $server; # Server socket
my $currlogfile; # logfile, without wildcards
my $logopened = 0; # logfile opened or using stdout
@@ -145,7 +148,7 @@ my $nextat; # Time when next timer will be triggered.
my $intAtCnt=0;
my $reread_active = 0;
my $AttrList = "room comment";
-my $cvsid = '$Id: fhem.pl,v 1.57 2008-11-15 09:28:22 rudolfkoenig Exp $';
+my $cvsid = '$Id: fhem.pl,v 1.58 2008-12-03 16:42:48 rudolfkoenig Exp $';
my $namedef =
"where <name> is either:\n" .
"- a single device name\n" .
@@ -290,7 +293,7 @@ while (1) {
}
my $timeout = HandleTimeout();
- $timeout = 0.1 if(!defined($timeout) && keys %readyfnlist);
+ $timeout = $readytimeout if(!defined($timeout) && keys %readyfnlist);
my $nfound = select($rout=$rin, undef, undef, $timeout);
CommandShutdown(undef, undef) if($sig_term);
@@ -517,7 +520,9 @@ AnalyzeCommand($$)
$cmd =~ s/\\\n/ /g; # Multi-line
# Make life easier for oneliners:
%value = ();
- foreach my $d (keys %defs) { $value{$d} = $defs{$d}{STATE} }
+ foreach my $d (keys %defs) {
+ $value{$d} = $defs{$d}{STATE}
+ }
my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime;
my $we = (($wday==0 || $wday==6) ? 1 : 0);
$month++;
@@ -588,11 +593,25 @@ AnalyzeCommand($$)
sub
devspec2array($)
{
+ my %knownattr = ( "DEF"=>1, "STATE"=>1, "TYPE"=>1 );
+
my ($name) = @_;
return "" if(!defined($name));
return $name if(defined($defs{$name}));
my @ret;
+ if($name =~ m/(.*):(.*)/ && $knownattr{$1}) {
+ my $lattr = $1;
+ my $re = $2;
+ foreach my $l (sort keys %defs) {
+ push @ret, $l
+ if(!$re || ($defs{$l}{$lattr} && $defs{$l}{$lattr} =~ m/$re/));
+ }
+ return $name if(!@ret); # No match, return the input
+ return @ret;
+ }
+
+
foreach my $l (split(",", $name)) { # List
if($l =~ m/[*\[\]^\$]/) { # Regexp
push @ret, grep($_ =~ m/$l/, sort keys %defs);
@@ -812,6 +831,7 @@ CommandSave($$)
my $r = $savefirst{$d};
delete $rooms{$r}{$d};
delete $rooms{$r} if(! %{$rooms{$r}});
+ next if(!$defs{$d});
my $def = $defs{$d}{DEF};
$def =~ s/;/;;/g;
print SFH "define $d $defs{$d}{TYPE} $def\n";
@@ -824,6 +844,7 @@ CommandSave($$)
foreach my $r (sort keys %rooms) {
print SFH "\nsetdefaultattr" . ($r ne "~" ? " room $r" : "") . "\n";
foreach my $d (sort keys %{$rooms{$r}} ) {
+ next if(!$defs{$d});
next if($defs{$d}{TEMPORARY});
next if($defs{$d}{VOLATILE});
if($defs{$d}{DEF}) {
@@ -868,7 +889,8 @@ DoSet(@)
my @a = @_;
my $dev = $a[0];
- return "No set implemented for $dev" if(!$modules{$defs{$dev}{TYPE}}{SetFn});
+ return "No set implemented for $dev"
+ if(!$defs{$dev} || !$modules{$defs{$dev}{TYPE}}{SetFn});
my $ret = CallFn($dev, "SetFn", $defs{$dev}, @a);
return $ret if($ret);
@@ -888,11 +910,6 @@ CommandSet($$)
my @rets;
foreach my $sdev (devspec2array($a[0])) {
- if(!defined($defs{$sdev})) {
- push @rets, "Please define $sdev first";
- next;
- }
-
$a[0] = $sdev;
my $ret = DoSet(@a);
push @rets, $ret if($ret);
@@ -1166,17 +1183,22 @@ CommandList($$)
} else {
- foreach my $sdev (devspec2array($param)) {
+ my @list = devspec2array($param);
+ if(@list == 1) {
+ my $sdev = $list[0];
if(!defined($defs{$sdev})) {
$str .= "No device named $param found";
- next;
+ } else {
+ $str .= "Internals:\n";
+ $str .= PrintHash($defs{$sdev}, 2);
+ $str .= "Attributes:\n";
+ $str .= PrintHash($attr{$sdev}, 2);
+ }
+ } else {
+ foreach my $sdev (@list) {
+ $str .= "$sdev\n";
}
- $str .= "Internals:\n";
- $str .= PrintHash($defs{$sdev}, 2);
- $str .= "Attributes:\n";
- $str .= PrintHash($attr{$sdev}, 2);
}
-
}
return $str;
@@ -1333,6 +1355,8 @@ sub
getAllAttr($)
{
my $d = shift;
+ return "" if(!$defs{$d});
+
my $list = $AttrList;
$list .= " " . $modules{$defs{$d}{TYPE}}{AttrList}
if($modules{$defs{$d}{TYPE}}{AttrList});