mhop/fhem
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

4.5 prep

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@273 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
2008-12-03 16:45:26 +00:00
parent bad1b3291f
commit cd05cf050b
4 changed files with 165 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

158
fhem/FHEM/00_CUL.pm
View File

@@ -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: # TODO:
# - FHT xmit # - FHT xmit
# - HMS rcv # - HMS rcv
# - KS300 rcv
# - EMEM rcv
# - EMWZ rcv
# - EMGZ rcv
# - S300TH rcv
package main; package main;
@@ -29,22 +14,18 @@ use Time::HiRes qw(gettimeofday);
sub CUL_Write($$$); sub CUL_Write($$$);
sub CUL_Read($); sub CUL_Read($);
sub CUL_ReadAnswer($$); sub CUL_ReadAnswer($$);
sub CUL_Ready($$); sub CUL_Ready($);
my $initstr = "X01"; # Only translated messages, no RSSI my $initstr = "X01"; # Only translated messages, no RSSI
my %msghist; # Used when more than one CUL is attached my %msghist; # Used when more than one CUL is attached
my $msgcount = 0; my $msgcount = 0;
my %gets = ( my %gets = (
"ccreg" => "C",
"eeprom" => "R",
"version" => "V", "version" => "V",
"time" => "t",
"raw" => "", "raw" => "",
"ccconf" => "=", "ccconf" => "=",
); );
my %sets = ( my %sets = (
"eeprom" => "W",
"raw" => "", "raw" => "",
"verbose" => "X", "verbose" => "X",
"freq" => "=", "freq" => "=",
@@ -60,7 +41,7 @@ CUL_Initialize($)
$hash->{ReadFn} = "CUL_Read"; $hash->{ReadFn} = "CUL_Read";
$hash->{WriteFn} = "CUL_Write"; $hash->{WriteFn} = "CUL_Write";
$hash->{Clients} = ":FS20:FHT:KS300:CUL_EM:CUL_WS:"; $hash->{Clients} = ":FS20:FHT:KS300:CUL_EM:CUL_WS:";
$hash->{ReadyFn} = "CUL_Ready" if ($^O eq 'MSWin32'); $hash->{ReadyFn} = "CUL_Ready";
# Normal devices # Normal devices
$hash->{DefFn} = "CUL_Define"; $hash->{DefFn} = "CUL_Define";
@@ -69,7 +50,7 @@ CUL_Initialize($)
$hash->{SetFn} = "CUL_Set"; $hash->{SetFn} = "CUL_Set";
$hash->{StateFn} = "CUL_SetState"; $hash->{StateFn} = "CUL_SetState";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 filtertimeout repeater:1,0 " . $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 ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def); my @a = split("[ \t][ \t]*", $def);
my $po; my $po;
$hash->{STATE} = "Initialized";
return "wrong syntax: define <name> CUL devicename [mobile]"
if(@a < 3 || @a > 4);
delete $hash->{PortObj}; delete $hash->{PortObj};
delete $hash->{FD}; delete $hash->{FD};
my $name = $a[0]; my $name = $a[0];
my $dev = $a[2]; my $dev = $a[2];
$hash->{MOBILE} = 1 if($a[3] && $a[3] eq "mobile");
$hash->{STATE} = "defined";
$attr{$name}{savefirst} = 1; $attr{$name}{savefirst} = 1;
$attr{$name}{repeater} = 1; $attr{$name}{repeater} = 1;
@@ -96,6 +81,8 @@ CUL_Define($$)
return undef; return undef;
} }
$hash->{DeviceName} = $dev;
$hash->{PARTIAL} = "";
Log 3, "CUL opening CUL device $dev"; Log 3, "CUL opening CUL device $dev";
if ($^O=~/Win/) { if ($^O=~/Win/) {
require Win32::SerialPort; require Win32::SerialPort;
@@ -104,7 +91,13 @@ CUL_Define($$)
require Device::SerialPort; require Device::SerialPort;
$po = new Device::SerialPort ($dev); $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"; Log 3, "CUL opened CUL device $dev";
$hash->{PortObj} = $po; $hash->{PortObj} = $po;
@@ -115,9 +108,12 @@ CUL_Define($$)
$readyfnlist{"$name.$dev"} = $hash; $readyfnlist{"$name.$dev"} = $hash;
} }
$hash->{DeviceName} = $dev; my $ret = CUL_DoInit($hash);
$hash->{PARTIAL} = ""; if($ret) {
return CUL_DoInit($hash); 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, ". my $msg = "Setting FREQ2..0 (0D,0E,0F) to $f2 $f1 $f0 = $arg MHz, ".
"verbose to $initstr"; "verbose to $initstr";
Log GetLogLevel($name,4), $msg; Log GetLogLevel($name,4), $msg;
CUL_SimpleWrite($hash, "W0D$f2"); # Will reprogram the CC1101 CUL_SimpleWrite($hash, "W0F$f2"); # Will reprogram the CC1101
CUL_SimpleWrite($hash, "W0E$f1"); CUL_SimpleWrite($hash, "W10$f1");
CUL_SimpleWrite($hash, "W0F$f0"); CUL_SimpleWrite($hash, "W11$f0");
CUL_SimpleWrite($hash, $initstr); CUL_SimpleWrite($hash, $initstr);
return $msg; return $msg;
@@ -194,7 +190,7 @@ GOTBW:
my $msg = "Setting MDMCFG4 (10) to $ob = $bw KHz, verbose to $initstr"; my $msg = "Setting MDMCFG4 (10) to $ob = $bw KHz, verbose to $initstr";
Log GetLogLevel($name,4), $msg; Log GetLogLevel($name,4), $msg;
CUL_SimpleWrite($hash, "W10$ob"); CUL_SimpleWrite($hash, "W12$ob");
CUL_SimpleWrite($hash, $initstr); CUL_SimpleWrite($hash, $initstr);
return $msg; return $msg;
@@ -228,21 +224,19 @@ CUL_Get($@)
if($a[1] eq "ccconf") { if($a[1] eq "ccconf") {
my %r = ( "0D"=>1,"0E"=>1,"0F"=>1,"10"=>1,"1B"=>1,"1D"=>1, 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) { foreach my $a (sort keys %r) {
CUL_SimpleWrite($hash, "C$a"); CUL_SimpleWrite($hash, "C$a");
my @answ = split(" ", CUL_ReadAnswer($hash, "C$a")); my @answ = split(" ", CUL_ReadAnswer($hash, "C$a"));
$r{$a} = $answ[4]; $r{$a} = $answ[4];
} }
$msg = sprintf("Freq:%.3fMHz Bwidth:%dKHz Ampl:%ddB " . $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 26*(($r{"0D"}*256+$r{"0E"})*256+$r{"0F"})/65536, #Freq
26000/(8 * (4+(($r{"10"}>>4)&3)) * (1 << (($r{"10"}>>6)&3))), #Bw 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 $r{"1B"}&7<4 ? 24+3*($r{"1B"}&7) : 36+2*(($r{"1B"}&7)-4), #Ampl
4+4*($r{"1D"}&3), #Sens 4+4*($r{"1D"}&3), #Sens
$r{"23"}, $r{"24"}, $r{"25"}, $r{"26"}, #FSCAL $r{"23"}, $r{"24"}, $r{"25"}, $r{"26"} #FSCAL
$r{"34"}>=128 ? (($r{34}-256)/2-74) : ($r{34}/2-74) #RSSI
); );
} else { } else {
@@ -292,10 +286,12 @@ CUL_DoInit($)
return $msg; return $msg;
} }
CUL_SimpleWrite($hash, $initstr); CUL_SimpleWrite($hash, $initstr);
$hash->{STATE} = "Initialized";
# Reset the counter # Reset the counter
delete($hash->{XMIT_TIME}); delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H}); delete($hash->{NR_CMD_LAST_H});
return undef;
} }
##################################### #####################################
@@ -310,7 +306,7 @@ CUL_ReadAnswer($$)
my $nfound; my $nfound;
for(;;) { for(;;) {
if($^O eq 'MSWin32') { if($^O eq 'MSWin32') {
$nfound=CUL_Ready($hash, undef); $nfound=CUL_Ready($hash);
} else { } else {
vec($rin, $hash->{FD}, 1) = 1; vec($rin, $hash->{FD}, 1) = 1;
my $to = 3; # 3 seconds timeout my $to = 3; # 3 seconds timeout
@@ -438,8 +434,8 @@ sub
CUL_HandleWriteQueue($) CUL_HandleWriteQueue($)
{ {
my $hash = shift; my $hash = shift;
my $cnt = --$hash->{QUEUECNT}; if($hash->{QUEUECNT} > 0) {
if($cnt > 0) { $hash->{QUEUECNT}--;
my $bstring = shift(@{$hash->{QUEUE}}); my $bstring = shift(@{$hash->{QUEUE}});
CUL_XmitLimitCheck($hash,$bstring); CUL_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring); $hash->{PortObj}->write($bstring);
@@ -465,24 +461,42 @@ CUL_Read($)
if(!defined($buf) || length($buf) == 0) { if(!defined($buf) || length($buf) == 0) {
my $devname = $hash->{DeviceName}; my $dev = $hash->{DeviceName};
Log 1, "USB device $devname disconnected, waiting to reappear"; Log 1, "USB device $dev disconnected, waiting to reappear";
$hash->{PortObj}->close(); $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); sleep(5);
if ($^O eq 'MSWin32') {
$hash->{PortObj} = new Win32::SerialPort($devname); return "";
}else{
$hash->{PortObj} = new Device::SerialPort($devname); } else {
}
for(;;) {
if($hash->{PortObj}) { sleep(5);
Log 1, "USB device $devname reappeared"; if ($^O eq 'MSWin32') {
$hash->{FD} = $hash->{PortObj}->FILENO if !($^O eq 'MSWin32'); $hash->{PortObj} = new Win32::SerialPort($dev);
CUL_DoInit($hash); }else{
return; $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}; my $culdata = $hash->{PARTIAL};
@@ -618,11 +632,43 @@ NEXTMSG:
##################################### #####################################
sub sub
CUL_Ready($$) # Windows - only CUL_Ready($) # Windows - only
{ {
my ($hash, $dev) = @_; my ($hash) = @_;
my $po=$hash->{PortObj}; 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; my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0); return ($InBytes>0);
} }

10
fhem/FHEM/00_FHZ.pm
View File

@@ -82,9 +82,9 @@ FHZ_Initialize($)
} }
##################################### #####################################
sub sub
FHZ_Ready($$) FHZ_Ready($)
{ {
my ($hash, $dev) = @_; my ($hash) = @_;
my $po=$hash->{PortObj}; my $po=$hash->{PortObj};
return undef if !$po; return undef if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status; my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
@@ -407,7 +407,7 @@ FHZ_ReadAnswer($$)
my $nfound; my $nfound;
for(;;) { for(;;) {
if($^O eq 'MSWin32') { if($^O eq 'MSWin32') {
$nfound=FHZ_Ready($hash,$def); $nfound=FHZ_Ready($hash);
} else { } else {
vec($rin, $hash->{FD}, 1) = 1; vec($rin, $hash->{FD}, 1) = 1;
$nfound = select($rin, undef, undef, 3); # 3 seconds timeout $nfound = select($rin, undef, undef, 3); # 3 seconds timeout
@@ -535,8 +535,8 @@ sub
FHZ_HandleWriteQueue($) FHZ_HandleWriteQueue($)
{ {
my $hash = shift; my $hash = shift;
my $cnt = --$hash->{QUEUECNT}; if($hash->{QUEUECNT} > 0) {
if($cnt > 0) { $hash->{QUEUECNT}--;
my $bstring = shift(@{$hash->{QUEUE}}); my $bstring = shift(@{$hash->{QUEUE}});
FHZ_XmitLimitCheck($hash,$bstring); FHZ_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring); $hash->{PortObj}->write($bstring);

19
fhem/HISTORY
View File

@@ -306,7 +306,7 @@
Todo: Test with IE+Adobe Plugin/Opera. Todo: Test with IE+Adobe Plugin/Opera.
- feature: HOWTO for webpgm2 (first chapter) - 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 - Autoloading modules. In order to make module installation easier and
to optimize memory usage, modules are loaded when the first device of a to optimize memory usage, modules are loaded when the first device of a
certain category is defined. Exceptions are the modules prefixed with 99, 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 devices in fhem
- feature: X10 support for pgm3 - 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 - Boris Sat Nov 15 CET 2008
- bugfix: correct correction factors for EMEM in 15_CUL_EM.pm - 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

56
fhem/fhem.pl
View File

@@ -124,12 +124,15 @@ use vars qw(%defs); # FHEM device/button definitions
use vars qw(%attr); # Attributes use vars qw(%attr); # Attributes
use vars qw(%selectlist); # devices which want a "select" use vars qw(%selectlist); # devices which want a "select"
use vars qw(%readyfnlist); # devices which want a "readyfn" 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(%value); # Current values, see commandref.html
use vars qw(%oldvalue); # Old values, see commandref.html use vars qw(%oldvalue); # Old values, see commandref.html
use vars qw($init_done); # use vars qw($init_done); #
use vars qw($internal_data); # use vars qw($internal_data); #
my $server; # Server socket my $server; # Server socket
my $currlogfile; # logfile, without wildcards my $currlogfile; # logfile, without wildcards
my $logopened = 0; # logfile opened or using stdout 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 $intAtCnt=0;
my $reread_active = 0; my $reread_active = 0;
my $AttrList = "room comment"; 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 = my $namedef =
"where <name> is either:\n" . "where <name> is either:\n" .
"- a single device name\n" . "- a single device name\n" .
@@ -290,7 +293,7 @@ while (1) {
} }
my $timeout = HandleTimeout(); 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); my $nfound = select($rout=$rin, undef, undef, $timeout);
CommandShutdown(undef, undef) if($sig_term); CommandShutdown(undef, undef) if($sig_term);
@@ -517,7 +520,9 @@ AnalyzeCommand($$)
$cmd =~ s/\\\n/ /g; # Multi-line $cmd =~ s/\\\n/ /g; # Multi-line
# Make life easier for oneliners: # Make life easier for oneliners:
%value = (); %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 ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime;
my $we = (($wday==0 || $wday==6) ? 1 : 0); my $we = (($wday==0 || $wday==6) ? 1 : 0);
$month++; $month++;
@@ -588,11 +593,25 @@ AnalyzeCommand($$)
sub sub
devspec2array($) devspec2array($)
{ {
my %knownattr = ( "DEF"=>1, "STATE"=>1, "TYPE"=>1 );
my ($name) = @_; my ($name) = @_;
return "" if(!defined($name)); return "" if(!defined($name));
return $name if(defined($defs{$name})); return $name if(defined($defs{$name}));
my @ret; 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 foreach my $l (split(",", $name)) { # List
if($l =~ m/[*\[\]^\$]/) { # Regexp if($l =~ m/[*\[\]^\$]/) { # Regexp
push @ret, grep($_ =~ m/$l/, sort keys %defs); push @ret, grep($_ =~ m/$l/, sort keys %defs);
@@ -812,6 +831,7 @@ CommandSave($$)
my $r = $savefirst{$d}; my $r = $savefirst{$d};
delete $rooms{$r}{$d}; delete $rooms{$r}{$d};
delete $rooms{$r} if(! %{$rooms{$r}}); delete $rooms{$r} if(! %{$rooms{$r}});
next if(!$defs{$d});
my $def = $defs{$d}{DEF}; my $def = $defs{$d}{DEF};
$def =~ s/;/;;/g; $def =~ s/;/;;/g;
print SFH "define $d $defs{$d}{TYPE} $def\n"; print SFH "define $d $defs{$d}{TYPE} $def\n";
@@ -824,6 +844,7 @@ CommandSave($$)
foreach my $r (sort keys %rooms) { foreach my $r (sort keys %rooms) {
print SFH "\nsetdefaultattr" . ($r ne "~" ? " room $r" : "") . "\n"; print SFH "\nsetdefaultattr" . ($r ne "~" ? " room $r" : "") . "\n";
foreach my $d (sort keys %{$rooms{$r}} ) { foreach my $d (sort keys %{$rooms{$r}} ) {
next if(!$defs{$d});
next if($defs{$d}{TEMPORARY}); next if($defs{$d}{TEMPORARY});
next if($defs{$d}{VOLATILE}); next if($defs{$d}{VOLATILE});
if($defs{$d}{DEF}) { if($defs{$d}{DEF}) {
@@ -868,7 +889,8 @@ DoSet(@)
my @a = @_; my @a = @_;
my $dev = $a[0]; 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); my $ret = CallFn($dev, "SetFn", $defs{$dev}, @a);
return $ret if($ret); return $ret if($ret);
@@ -888,11 +910,6 @@ CommandSet($$)
my @rets; my @rets;
foreach my $sdev (devspec2array($a[0])) { foreach my $sdev (devspec2array($a[0])) {
if(!defined($defs{$sdev})) {
push @rets, "Please define $sdev first";
next;
}
$a[0] = $sdev; $a[0] = $sdev;
my $ret = DoSet(@a); my $ret = DoSet(@a);
push @rets, $ret if($ret); push @rets, $ret if($ret);
@@ -1166,17 +1183,22 @@ CommandList($$)
} else { } else {
foreach my $sdev (devspec2array($param)) { my @list = devspec2array($param);
if(@list == 1) {
my $sdev = $list[0];
if(!defined($defs{$sdev})) { if(!defined($defs{$sdev})) {
$str .= "No device named $param found"; $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; return $str;
@@ -1333,6 +1355,8 @@ sub
getAllAttr($) getAllAttr($)
{ {
my $d = shift; my $d = shift;
return "" if(!$defs{$d});
my $list = $AttrList; my $list = $AttrList;
$list .= " " . $modules{$defs{$d}{TYPE}}{AttrList} $list .= " " . $modules{$defs{$d}{TYPE}}{AttrList}
if($modules{$defs{$d}{TYPE}}{AttrList}); if($modules{$defs{$d}{TYPE}}{AttrList});