Commit 9bbcb697 authored by Admin's avatar Admin
Browse files

CommandAttr refactoring started;

parent 335a787d
......@@ -36,6 +36,7 @@ use v5.28.1;
use lib '.';
use lib 'lib';
use Data::Dumper;
use File::Copy qw(copy);
use IO::Socket;
use IO::Socket::INET;
......@@ -2778,31 +2779,42 @@ sub sleep_WakeUpFn {
# {{{ CommandAttr
sub CommandAttr {
my ($cl, $param) = @_;
my ($ret, $append, $remove, @a);
my $cl = shift; # Client Hash - indicates channel the command came through (for authorization)
my $param = shift; # command attributes in string form - including optional flags
Log 3, Dumper(['CommandAttr-IN:', $cl, $param]);
my $mode;
my $ret;
# check if append or remove mode was given
if ($param =~ s{\A-(a|r) \s+}{}xms) {
$mode = $1;
}
$append = ($param =~ s/^-a //);
$remove = ($param =~ s/^-r //);
@a = split(" ", $param, 3) if ($param);
my @a = split(" ", $param, 3) if ($param);
return "Usage: attr [-a|-r] <name> <attrname> [<attrvalue>]\n$namedef"
if (@a && @a < 2);
my $a1 = $a[1];
return "$a[0]: bad attribute name '$a1' (allowed chars: A-Za-z/\\d_\\.-)"
if ($featurelevel > 5.9 && !goodReadingName($a1) && $a1 ne "?");
my @rets;
for my $sdev (devspec2array($a[0], $a1 && $a1 eq "?" ? undef : $cl)) {
my $hash = $defs{$sdev};
my $hash = $defs{$sdev};
my $attrName = $a1;
my $attrVal = (defined($a[2]) ? $a[2] : 1);
my $attrVal = (defined($a[2]) ? $a[2] : 1);
if (!defined($hash)) {
push @rets, "Please define $sdev first" if ($init_done); #define -ignoreErr
next;
}
my $list = getAllAttr($sdev);
if ($attrName eq "?") {
push @rets, "$sdev: unknown attribute $attrName, choose one of $list";
next;
......@@ -2827,11 +2839,11 @@ sub CommandAttr {
}
}
if ($append && $attr{$sdev} && $attr{$sdev}{$attrName}) {
if ($mode eq 'a' && $attr{$sdev} && $attr{$sdev}{$attrName}) {
$attrVal = $attr{$sdev}{$attrName} .
($attrVal =~ m/^,/ ? $attrVal : " $attrVal");
}
if ($remove && $attr{$sdev} && $attr{$sdev}{$attrName}) {
elsif ($mode eq 'r' && $attr{$sdev} && $attr{$sdev}{$attrName}) {
my $v = $attr{$sdev}{$attrName};
$v =~ s/\b$attrVal\b//;
$attrVal = $v;
......@@ -2842,31 +2854,35 @@ sub CommandAttr {
}
if ($attrName eq "userReadings") {
my @userReadings;
# myReading1[:trigger1] [modifier1] { codecodecode1 }, ...
my $arg= $attrVal;
my $arg = $attrVal;
# matches myReading1[:trigger2] { codecode1 }
my $regexi= '\s*([\w.-]+)(:\S*)?\s+((\w+)\s+)?(\{.*?\})\s*';
my $regexo= '^(' . $regexi . ')(,\s*(.*))*$';
my $rNo=0;
my $regexi = '\s*([\w.-]+)(:\S*)?\s+((\w+)\s+)?(\{.*?\})\s*';
my $regexo = '^(' . $regexi . ')(,\s*(.*))*$';
my $rNo = 0;
while ($arg =~ /$regexo/s) {
my $reading= $2;
my $trigger= $3 ? $3 : undef;
my $modifier= $5 ? $5 : "none";
my $perlCode= $6;
#Log 1, sprintf("userReading %s has perlCode %s with modifier %s%s",
my $reading = $2;
my $trigger = $3 ? $3 : undef;
my $modifier = $5 ? $5 : "none";
my $perlCode = $6;
# This is probably some debug remnant
# Log 1, sprintf("userReading %s has perlCode %s with modifier %s%s",
# $userReading,$perlCode,$modifier,$trigger?" and trigger $trigger":'');
if (grep { /$modifier/ }
qw(none difference differential offset monotonic integral)) {
$trigger =~ s/^:// if ($trigger);
my %userReading = ( reading => $reading,
trigger => $trigger,
modifier => $modifier,
perlCode => $perlCode );
push @userReadings, \%userReading;
push @userReadings, {
reading => $reading,
trigger => $trigger,
modifier => $modifier,
perlCode => $perlCode
}
}
else {
push @rets, "$sdev: unknown modifier $modifier for ".
......@@ -2874,7 +2890,7 @@ sub CommandAttr {
}
$arg= defined($8) ? $8 : '';
}
$hash->{'.userReadings'}= \@userReadings;
$hash->{'.userReadings'} = \@userReadings;
}
my $oVal = ($attr{$sdev} ? $attr{$sdev}{$attrName} : '');
......@@ -2899,18 +2915,22 @@ sub CommandAttr {
}
else {
delete $hash->{$cache} if ( $cache );
my @a = split($ra{$attrName}{s}, $lval) ;
for my $v (@a) {
my $v = $v; # resolve the reference to avoid changing @a itself
$v =~ s/$ra{$attrName}{r}// if ($ra{$attrName}{r});
my $err ="Argument $v for attr $sdev $attrName is not a valid regexp";
return "$err: use .* instead of *" if ($v =~ /^\*/); # no err in eval!?
eval { "Hallo" =~ m/^$v$/ };
return "$err: $@" if ($@);
my @attrs = split $ra{$attrName}{s}, $lval;
delete $hash->{$cache} if ($cache);
for my $v (@attrs) {
my $vcopy = $v; # resolve the reference to avoid changing @a itself
$vcopy =~ s/$ra{$attrName}{r}// if ($ra{$attrName}{r});
# WTF???
# my $err ="Argument $vcopy for attr $sdev $attrName is not a valid regexp";
# return "$err: use .* instead of *" if ($vcopy =~ /^\*/); # no err in eval!?
# eval { "Hallo" =~ m/^$vcopy$/ };
# return "$err: $@" if ($@);
}
$hash->{$cache} = \@a if ( $cache );
$hash->{$cache} = \@attrs if ($cache);
}
}
......@@ -2956,6 +2976,9 @@ sub CommandAttr {
}
Log 3, join(" ", @rets) if (!$cl && @rets);
Log 3, Dumper(['CommandAttr-OUT:', \@rets]);
return join("\n", @rets);
}
......@@ -4694,6 +4717,7 @@ sub evalStateFormat {
# }}}
# {{{ readingsEndUpdate
#
# Call readingsEndUpdate when you are done updating readings.
# This optionally calls DoTrigger to propagate the changes.
......@@ -5836,7 +5860,7 @@ sub parseParams {
my(@a, %h); # worse variable names are probably not possible
my @params = ( ref $cmd eq 'ARRAY' ) ? @{$cmd};
my @params = ( ref $cmd eq 'ARRAY' ) ? @{$cmd}
: split $separator, $cmd;
PPARAMS_MAIN:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment