mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-10 09:16:53 +00:00
98_DOIF.pm: new features: FOR-Command
git-svn-id: https://svn.fhem.de/fhem/trunk@22398 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
Damian
parent
7401a44255
commit
2cdeb39170
@ -349,7 +349,39 @@ sub DOIF_RegisterCell
|
|||||||
return ""
|
return ""
|
||||||
}
|
}
|
||||||
|
|
||||||
sub DOIF_DEF_TPL
|
sub DOIF_DEF_TPL {
|
||||||
|
my ($hash,$table,$tail) = @_;
|
||||||
|
my $beginning;
|
||||||
|
my $currentBlock;
|
||||||
|
my $output="";
|
||||||
|
my $err;
|
||||||
|
|
||||||
|
while ($tail ne "") {
|
||||||
|
if ($tail =~ /(?:^|\n)\s*DEF\s/g) {
|
||||||
|
my $prefix=substr($tail,0,pos($tail));
|
||||||
|
my $begin=substr($tail,0,pos($tail)-4);
|
||||||
|
$tail=substr($tail,pos($tail)-4);
|
||||||
|
if ($tail =~ /^DEF\s*(TPL_[^ ^\t^\(]*)[^\(]*\(/) {
|
||||||
|
($beginning,$currentBlock,$err,$tail)=GetBlockDoIf($tail,'[\(\)]');
|
||||||
|
if ($err) {
|
||||||
|
return ("DEF TPL: $err",$currentBlock);
|
||||||
|
} elsif ($currentBlock ne "") {
|
||||||
|
$hash->{$table}{tpl}{$1}=$currentBlock;
|
||||||
|
$output.=$begin;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$tail=substr($tail,4);
|
||||||
|
$output.=$prefix;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$output.=$tail;
|
||||||
|
$tail="";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return ("",$output);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub DOIF_DEF_TPL_OLD
|
||||||
{
|
{
|
||||||
my ($hash,$table,$tail) =@_;
|
my ($hash,$table,$tail) =@_;
|
||||||
my ($beginning,$currentBlock,$err);
|
my ($beginning,$currentBlock,$err);
|
||||||
@ -462,13 +494,12 @@ sub import_tpl
|
|||||||
|
|
||||||
sub DOIF_FOR
|
sub DOIF_FOR
|
||||||
{
|
{
|
||||||
my ($hash,$table,$wcmd)=@_;
|
my ($hash,$table,$wcmd,$count)=@_;
|
||||||
my $err="";
|
my $err="";
|
||||||
my $tail=$wcmd;
|
my $tail=$wcmd;
|
||||||
my $beginning;
|
my $beginning;
|
||||||
my $currentBlock;
|
my $currentBlock;
|
||||||
my $output="";
|
my $output="";
|
||||||
|
|
||||||
while ($tail ne "") {
|
while ($tail ne "") {
|
||||||
if ($tail =~ /FOR/g) {
|
if ($tail =~ /FOR/g) {
|
||||||
my $prefix=substr($tail,0,pos($tail));
|
my $prefix=substr($tail,0,pos($tail));
|
||||||
@ -480,11 +511,42 @@ sub DOIF_FOR
|
|||||||
return ("FOR: $err $currentBlock","");
|
return ("FOR: $err $currentBlock","");
|
||||||
} elsif ($currentBlock ne "") {
|
} elsif ($currentBlock ne "") {
|
||||||
my ($array,$command) = SplitDoIf(',',$currentBlock);
|
my ($array,$command) = SplitDoIf(',',$currentBlock);
|
||||||
|
my $cmd=$command;
|
||||||
|
if ($cmd =~ /^\s*\(/) {
|
||||||
|
my ($begin,$curr,$error,$end)=GetBlockDoIf($command,'[\(\)]');
|
||||||
|
if ($error) {
|
||||||
|
return ("FOR: $error $curr","");
|
||||||
|
} else {
|
||||||
|
$command=$curr;
|
||||||
|
}
|
||||||
|
}
|
||||||
my $commandoutput="";
|
my $commandoutput="";
|
||||||
|
if (!defined $count) {
|
||||||
|
$count=0;
|
||||||
|
}
|
||||||
|
$count++;
|
||||||
|
my $i=0;
|
||||||
for (eval($array)) {
|
for (eval($array)) {
|
||||||
my $temp=$command;
|
my $temp=$command;
|
||||||
|
my $item=$_;
|
||||||
|
if (ref($item) eq "ARRAY"){
|
||||||
|
my $j=1;
|
||||||
|
for (@{$item}) {
|
||||||
|
$temp =~ s/\$_\$$j/$_/g;
|
||||||
|
$temp =~ s/\$$count\$$j/$_/g;
|
||||||
|
$j++;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$temp =~ s/\$$count/$_/g;
|
||||||
$temp =~ s/\$_/$_/g;
|
$temp =~ s/\$_/$_/g;
|
||||||
|
}
|
||||||
|
$temp =~ s/\$COUNT$count/$i/g;
|
||||||
|
if ($temp =~ /FOR\s*\(/) {
|
||||||
|
($err,$temp)=DOIF_FOR($hash,"defs",$temp,$count);
|
||||||
|
return($temp,$err) if ($err);
|
||||||
|
}
|
||||||
$commandoutput.=$temp."\n";
|
$commandoutput.=$temp."\n";
|
||||||
|
$i++;
|
||||||
}
|
}
|
||||||
$output.=($begin.$commandoutput);
|
$output.=($begin.$commandoutput);
|
||||||
}
|
}
|
||||||
@ -496,6 +558,7 @@ sub DOIF_FOR
|
|||||||
$output.=$tail;
|
$output.=$tail;
|
||||||
$tail="";
|
$tail="";
|
||||||
}
|
}
|
||||||
|
$count=undef;
|
||||||
}
|
}
|
||||||
return ("",$output);
|
return ("",$output);
|
||||||
}
|
}
|
||||||
@ -508,7 +571,8 @@ sub DOIF_TPL {
|
|||||||
my $err;
|
my $err;
|
||||||
|
|
||||||
while ($tail ne "") {
|
while ($tail ne "") {
|
||||||
if ($tail =~ /TPL_/g) {
|
if ($tail =~ /(\w*)\s*TPL_/g) {
|
||||||
|
next if $1 eq "DEF";
|
||||||
my $prefix=substr($tail,0,pos($tail));
|
my $prefix=substr($tail,0,pos($tail));
|
||||||
my $begin=substr($tail,0,pos($tail)-4);
|
my $begin=substr($tail,0,pos($tail)-4);
|
||||||
$tail=substr($tail,pos($tail)-4);
|
$tail=substr($tail,pos($tail)-4);
|
||||||
@ -3104,6 +3168,39 @@ DOIF_SleepTrigger ($)
|
|||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub DOIF_Perlblock
|
||||||
|
{
|
||||||
|
my ($hash,$table,$tail,$subs) =@_;
|
||||||
|
my ($beginning,$perlblock,$err,$i);
|
||||||
|
$i=0;
|
||||||
|
while($tail =~ /(?:^|\n)\s*(\w*)\s*\{/g) {
|
||||||
|
my $blockname=$1;
|
||||||
|
($beginning,$perlblock,$err,$tail)=GetBlockDoIf($tail,'[\{\}]');
|
||||||
|
if ($err) {
|
||||||
|
return ("Perlblck: $err",$perlblock);
|
||||||
|
} elsif (defined $subs) {
|
||||||
|
if ($blockname eq "subs") {
|
||||||
|
$perlblock ="no warnings 'redefine';package DOIF;".$perlblock;
|
||||||
|
eval ($perlblock);
|
||||||
|
if ($@) {
|
||||||
|
return ("error in defs block",$@);
|
||||||
|
}
|
||||||
|
return("","");
|
||||||
|
}
|
||||||
|
} elsif ($blockname ne "subs") {
|
||||||
|
($perlblock,$err)=ReplaceAllReadingsDoIf($hash,$perlblock,$i,0);
|
||||||
|
return ($perlblock,$err) if ($err);
|
||||||
|
$hash->{condition}{$i}=$perlblock;
|
||||||
|
$hash->{perlblock}{$i}=$blockname ? $blockname:sprintf("block_%02d",($i+1));
|
||||||
|
if ($blockname eq "init") {
|
||||||
|
$hash->{perlblock}{init}=$i;
|
||||||
|
}
|
||||||
|
$i++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return ("","");
|
||||||
|
}
|
||||||
|
|
||||||
sub
|
sub
|
||||||
CmdDoIfPerl($$)
|
CmdDoIfPerl($$)
|
||||||
{
|
{
|
||||||
@ -3114,6 +3211,7 @@ CmdDoIfPerl($$)
|
|||||||
my $err="";
|
my $err="";
|
||||||
my $i=0;
|
my $i=0;
|
||||||
$hs=$hash;
|
$hs=$hash;
|
||||||
|
my $msg;
|
||||||
|
|
||||||
|
|
||||||
#def modify
|
#def modify
|
||||||
@ -3139,6 +3237,13 @@ CmdDoIfPerl($$)
|
|||||||
|
|
||||||
return("","") if ($tail =~ /^ *$/);
|
return("","") if ($tail =~ /^ *$/);
|
||||||
|
|
||||||
|
$tail =~ s/\$VAR/\$hash->{var}/g;
|
||||||
|
$tail =~ s/\$_(\w+)/\$hash->\{var\}\{$1\}/g;
|
||||||
|
$tail =~ s/\$SELF/$hash->{NAME}/g;
|
||||||
|
|
||||||
|
($err,$msg)=DOIF_Perlblock($hash,"defs",$tail,1);
|
||||||
|
return ($msg,$err) if ($err);
|
||||||
|
|
||||||
($err,$tail)=DOIF_DEF_TPL($hash,"defs",$tail);
|
($err,$tail)=DOIF_DEF_TPL($hash,"defs",$tail);
|
||||||
return ($tail,$err) if ($err);
|
return ($tail,$err) if ($err);
|
||||||
|
|
||||||
@ -3148,34 +3253,34 @@ CmdDoIfPerl($$)
|
|||||||
($err,$tail)=DOIF_TPL($hash,"defs",$tail);
|
($err,$tail)=DOIF_TPL($hash,"defs",$tail);
|
||||||
return ($tail,$err) if ($err);
|
return ($tail,$err) if ($err);
|
||||||
|
|
||||||
$tail =~ s/\$VAR/\$hash->{var}/g;
|
($err,$msg)=DOIF_Perlblock($hash,"defs",$tail);
|
||||||
$tail =~ s/\$_(\w+)/\$hash->\{var\}\{$1\}/g;
|
return ($tail,$msg) if ($err);
|
||||||
|
|
||||||
while ($tail ne "") {
|
# while ($tail ne "") {
|
||||||
($beginning,$perlblock,$err,$tail)=GetBlockDoIf($tail,'[\{\}]');
|
# ($beginning,$perlblock,$err,$tail)=GetBlockDoIf($tail,'[\{\}]');
|
||||||
return ($perlblock,$err) if ($err);
|
# return ($perlblock,$err) if ($err);
|
||||||
next if (!$perlblock);
|
# next if (!$perlblock);
|
||||||
if ($beginning =~ /(\w*)[\s]*$/) {
|
# if ($beginning =~ /(\w*)[\s]*$/) {
|
||||||
my $blockname=$1;
|
# my $blockname=$1;
|
||||||
if ($blockname eq "subs") {
|
# if ($blockname eq "subs") {
|
||||||
$perlblock =~ s/\$SELF/$hash->{NAME}/g;
|
# $perlblock =~ s/\$SELF/$hash->{NAME}/g;
|
||||||
$perlblock ="no warnings 'redefine';package DOIF;".$perlblock;
|
# $perlblock ="no warnings 'redefine';package DOIF;".$perlblock;
|
||||||
eval ($perlblock);
|
# eval ($perlblock);
|
||||||
if ($@) {
|
# if ($@) {
|
||||||
return ("error in defs block",$@);
|
# return ("error in defs block",$@);
|
||||||
}
|
# }
|
||||||
next;
|
# next;
|
||||||
}
|
# }
|
||||||
($perlblock,$err)=ReplaceAllReadingsDoIf($hash,$perlblock,$i,0);
|
# ($perlblock,$err)=ReplaceAllReadingsDoIf($hash,$perlblock,$i,0);
|
||||||
return ($perlblock,$err) if ($err);
|
# return ($perlblock,$err) if ($err);
|
||||||
$hash->{condition}{$i}=$perlblock;
|
# $hash->{condition}{$i}=$perlblock;
|
||||||
$hash->{perlblock}{$i}=$blockname ? $blockname:sprintf("block_%02d",($i+1));
|
# $hash->{perlblock}{$i}=$blockname ? $blockname:sprintf("block_%02d",($i+1));
|
||||||
if ($blockname eq "init") {
|
# if ($blockname eq "init") {
|
||||||
$hash->{perlblock}{init}=$i;
|
# $hash->{perlblock}{init}=$i;
|
||||||
}
|
# }
|
||||||
}
|
# }
|
||||||
$i++;
|
# $i++;
|
||||||
}
|
# }
|
||||||
if (defined $hash->{perlblock}{init}) {
|
if (defined $hash->{perlblock}{init}) {
|
||||||
if ($init_done) {
|
if ($init_done) {
|
||||||
if (($ret,$err)=DOIF_CheckCond($hash,$hash->{perlblock}{init})) {
|
if (($ret,$err)=DOIF_CheckCond($hash,$hash->{perlblock}{init})) {
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user