diff --git a/fhem/CHANGED b/fhem/CHANGED index 5f2719bb5..5639861b5 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -1,5 +1,6 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - change: 98_WeekdayTimer: CONDITION now is checked at each switching time - bugfix: 10_KNX: fix for dpt3, dpt10 and dpt19 (working days) - bugfix: 88_HMCCU: Fixed some bugs - bugfix: 73_AutoShuttersControl: Fix uninitialized value within %charHash diff --git a/fhem/FHEM/98_WeekdayTimer.pm b/fhem/FHEM/98_WeekdayTimer.pm index cd32bc312..fabe6eae6 100644 --- a/fhem/FHEM/98_WeekdayTimer.pm +++ b/fhem/FHEM/98_WeekdayTimer.pm @@ -32,8 +32,7 @@ use warnings; use Time::Local qw( timelocal_nocheck ); use Scalar::Util qw(looks_like_number); -use Data::Dumper; -$Data::Dumper::Sortkeys = 1; +use Carp qw(carp); use FHEM::Core::Timer::Register qw(:ALL); use JSON qw(decode_json); use GPUtils qw(GP_Import); @@ -368,7 +367,7 @@ sub _Profile { $hash->{profil}{$idx}{TIME} = $time; $hash->{profil}{$idx}{PARA} = $parameter; $hash->{profil}{$idx}{EPOCH} = getSwitchtimeEpoch ($now, $stunde, $minute, $sekunde, 0); - $hash->{profil}{$idx}{TAGE} = $tage; + $hash->{profil}{$idx}{DAYS} = $tage; $hash->{profil}{$idx}{WE_Override} = $overrulewday; } # ---- Texte Readings aufbauen ----------------------------------------- @@ -438,16 +437,12 @@ sub _SwitchingTime { } my @tage = @{_daylistAsArray($hash, $daylist)}; - #my $tage=@tage; Log3( $hash, 1, "[$name] invalid daylist in $name <$daylist> use one of 012345678 or $hash->{helper}{daysRegExpMessage}" ) if !(@tage); my %hdays=(); @hdays{@tageGlobal} = undef; @hdays{@tage} = undef; - #@tage = sort keys %hdays; - #Log3 $hash, 3, "Tage: " . Dumper \@tage; - #return (\@tage,$time,$para,$overrulewday); return ([sort keys %hdays], $time, $para, $overrulewday); } @@ -794,17 +789,17 @@ sub _SetTimer { return Log3( $hash, 3, "[$name] no switches to send, due to possible errors." ) if !@switches; readingsSingleUpdate ($hash, 'state', 'inactive', 1) if !defined $hash->{SETTIMERATMIDNIGHT}; - for(my $i=0; $i<=$#switches; $i++) { + for my $i (0..$#switches) { my $idx = $switches[$i]; my $time = $hash->{profil}{$idx}{TIME}; my $timToSwitch = $hash->{profil}{$idx}{EPOCH}; - my $tage = $hash->{profil}{$idx}{TAGE}; + my $tage = $hash->{profil}{$idx}{DAYS}; my $para = $hash->{profil}{$idx}{PARA}; my $overrulewday = $hash->{profil}{$idx}{WE_Override}; - my $isActiveTimer = isAnActiveTimer ($hash, $tage, $para, $overrulewday); + my $isActiveTimer = checkDaysCondition($hash, $tage, $overrulewday); #isAnActiveTimer ($hash, $tage, $para, $overrulewday); readingsSingleUpdate ($hash, 'state', 'active', 1) if !defined $hash->{SETTIMERATMIDNIGHT} && $isActiveTimer; @@ -813,7 +808,7 @@ sub _SetTimer { Log3( $hash, 4, "[$name] setTimer - timer seems to be active today: ".join( q{},@{$tage})."|$time|$para" ); resetRegIntTimer($idx, $timToSwitch + AttrVal($name,'WDT_sendDelay',0), \&WDT_Update, $hash, 0); } else { - Log3( $hash, 4, "[$name] setTimer - timer seems to be NOT active today: ".join(q{},@{$tage})."|$time|$para ". $hash->{CONDITION} ); + Log3( $hash, 4, "[$name] setTimer - timer seems to be NOT active today: ".join(q{},@{$tage})."|$time|$para" ); deleteSingleRegIntTimer("$idx", $hash); } } @@ -892,10 +887,8 @@ sub _checkTimerReset { my $hash = shift // return; my $idx = shift // return; - return if $hash->{profil}{$idx}{EPOCH} <= time; - return if - !isAnActiveTimer ($hash, $hash->{profil}{$idx}{TAGE}, $hash->{profil}{$idx}{PARA}, $hash->{profil}{$idx}{WE_Override}) - && !isAnActiveTimer ($hash, $hash->{helper}{WEDAYS}{0} ? [7]:[8], $hash->{profil}{$idx}{PARA}, $hash->{profil}{$idx}{WE_Override}); + return if $hash->{profil}{$idx}{EPOCH} <= int(time) + 1; #for int/+1 see https://forum.fhem.de/index.php/topic,124101.0.html + return if !checkWDTCondition($hash, $hash->{profil}{$idx}{PARA}); resetRegIntTimer($idx, $hash->{profil}{$idx}{EPOCH}, \&WDT_Update, $hash, 0); return; } @@ -937,7 +930,7 @@ sub _searchAktNext { #Log3 $hash, 3, $shortDays{$language}[$nextTag]." ".FmtDateTime($nextTime)." ".$nextPara." ".$nextIdx; my $ignore = 0; my $wend = 0; - my $tage = $hash->{profil}{$nextIdx}{TAGE}[0]; + my $tage = $hash->{profil}{$nextIdx}{DAYS}[0]; if ($wday==$relWday) { $wend = $hash->{helper}{WEDAYS}{0}; $ignore = (($tage == 7 && !$wend ) || ($tage == 8 && $wend )); @@ -971,7 +964,7 @@ sub WDT_Update { my $now = time; # Schaltparameter ermitteln - my $tage = $hash->{profil}{$idx}{TAGE}; + my $tage = $hash->{profil}{$idx}{DAYS}; my $time = $hash->{profil}{$idx}{TIME}; my $newParam = $hash->{profil}{$idx}{PARA}; my $timToSwitch = $hash->{profil}{$idx}{EPOCH}; @@ -990,13 +983,13 @@ sub WDT_Update { my ($activeTimer, $activeTimerState); if (defined $fnHash->{forceSwitch}) { #timer is delayed - $activeTimer = isAnActiveTimer ($hash, $dieGanzeWoche, $newParam, $overrulewday); - $activeTimerState = isAnActiveTimer ($hash, $tage, $newParam, $overrulewday); + $activeTimer = checkDaysCondition($hash, $dieGanzeWoche, $overrulewday); #isAnActiveTimer ($hash, $dieGanzeWoche, $newParam, $overrulewday); + $activeTimerState = checkWDTCondition($hash, $newParam); #isAnActiveTimer ($hash, $tage, $newParam, $overrulewday); Log3( $hash, 4, "[$name] Update - past timer activated" ); deleteSingleRegIntTimer($idx, $hash);#, 1); setRegIntTimer($idx, $timToSwitch, \&WDT_Update, $hash, 0) if $timToSwitch > $now && ($activeTimerState || $activeTimer ); } else { - $activeTimer = isAnActiveTimer ($hash, $tage, $newParam, $overrulewday); + $activeTimer = checkWDTCondition($hash, $newParam); #isAnActiveTimer ($hash, $tage, $newParam, $overrulewday); $activeTimerState = $activeTimer; Log3( $hash, 4, "[$name] Update - timer seems to be active today: ".join(q{},@{$tage})."|$time|$newParam" ) if ( $activeTimer && (@{$tage}) ); Log3( $hash, 2, "[$name] Daylist is missing!") if !(@{$tage}); @@ -1011,8 +1004,7 @@ sub WDT_Update { my $disabled = AttrVal($hash->{NAME}, 'disable', 0); # ggf. Device schalten - Switch_Device($hash, $newParam, $tage) if $activeTimer; - + Switch_Device($hash, $newParam) if $activeTimer; readingsBeginUpdate($hash); readingsBulkUpdate ($hash, 'nextUpdate', FmtDateTime($nextTime)); readingsBulkUpdate ($hash, 'nextValue', $nextParameter); @@ -1078,17 +1070,17 @@ sub checkDelayedExecution { my $name = $hash->{NAME}; my %specials = ( - '%WEEKDAYTIMER' => $hash->{NAME}, + '%WEEKDAYTIMER' => $name, '%NAME' => $hash->{DEVICE}, '%EVENT' => $event, '%TIME' => $hash->{profil}{$idx}{TIME}, - '$WEEKDAYTIMER' => $hash->{NAME}, + '$WEEKDAYTIMER' => $name, '$NAME' => $hash->{DEVICE}, '$EVENT' => $event, '$TIME' => $hash->{profil}{$idx}{TIME}, ); - my $verzoegerteAusfuehrungCond = AttrVal($hash->{NAME}, 'delayedExecutionCond', 0); + my $verzoegerteAusfuehrungCond = AttrVal($name, 'delayedExecutionCond', 0); my $nextRetry = time + 55 + int(rand(10)); my $epoch = $hash->{profil}{$idx}{EPOCH}; @@ -1103,17 +1095,20 @@ sub checkDelayedExecution { $nextRetry = $epoch + $nextDelay + AttrVal($name,'WDT_sendDelay',0); Log3( $hash, 4, "[$name] time=".$hash->{profil}{$idx}{TIME}."/$epoch delay=$delay, nextDelay=$nextDelay, nextRetry=$nextRetry" ); - for my $key (keys %specials) { - my $val = $specials{$key}; - $key =~ s{\$}{\\\$}gxms; - $verzoegerteAusfuehrungCond =~ s{$key}{$val}gxms - } - Log3( $hash, 4, "[$name] delayedExecutionCond:$verzoegerteAusfuehrungCond" ); + my $verzoegerteAusfuehrung = 0; + if ($verzoegerteAusfuehrungCond) { + for my $key (keys %specials) { + my $val = $specials{$key}; + $key =~ s{\$}{\\\$}gxms; + $verzoegerteAusfuehrungCond =~ s{$key}{$val}gxms + } + Log3( $hash, 4, "[$name] delayedExecutionCond: $verzoegerteAusfuehrungCond" ); - my $verzoegerteAusfuehrung = AnalyzePerlCommand( $hash, $verzoegerteAusfuehrungCond ); + $verzoegerteAusfuehrung = AnalyzePerlCommand( $hash, $verzoegerteAusfuehrungCond ); - my $logtext = $verzoegerteAusfuehrung // 'no condition attribute set'; - Log3( $hash, 4, "[$name] result of delayedExecutionCond: $logtext" ); + my $logtext = $verzoegerteAusfuehrung // 'no condition attribute set'; + Log3( $hash, 4, "[$name] result of delayedExecutionCond: $logtext" ); + } if ($verzoegerteAusfuehrung) { if ( !defined $hash->{DELAYED} ) { @@ -1201,82 +1196,99 @@ sub checkDelayedExecution { ################################################################################ sub Switch_Device { - my ($hash, $newParam, $tage) = @_; + my $hash = shift // return; + my $newParam = shift // carp q[No new parameter provided!] && return; - my ($command, $condition, $tageAsHash) = q{}; my $name = $hash->{NAME}; + return if AttrVal($name, 'disable', 0); - my $now = time; - #modifier des Zieldevices auswaehlen + my $command = AttrVal($name, 'commandTemplate', undef); my $setModifier = checkIfDeviceIsHeatingType($hash); - $setModifier .= ' ' if length $setModifier; - $attr{$name}{commandTemplate} = - 'set $NAME ' . $setModifier . '$EVENT' if !defined $attr{$name}{commandTemplate}; + if (!defined $command) { + #modifier des Zieldevices auswaehlen + $setModifier .= ' ' if length $setModifier; + + $attr{$name}{commandTemplate} = + 'set $NAME ' . $setModifier . '$EVENT'; + $command = AttrVal($name, 'commandTemplate', 'commandTemplate not found'); + } - $command = AttrVal($name, 'commandTemplate', 'commandTemplate not found'); $command = 'set $NAME $EVENT' if defined $hash->{WDT_EVENTMAP} && defined $hash->{WDT_EVENTMAP}{$newParam}; $command = $hash->{COMMAND} if defined $hash->{COMMAND} && $hash->{COMMAND} ne ''; - - - my $activeTimer = 1; my $isHeating = $setModifier ? 1 : 0; my $aktParam = ReadingsVal($hash->{DEVICE}, $setModifier, ''); $aktParam = sprintf("%.1f", $aktParam) if $isHeating && $aktParam =~ m{\A[0-9]{1,3}\z}ixms; - my $disabled = AttrVal($hash->{NAME}, 'disable', 0); - my $disabled_txt = $disabled ? '' : ' not'; - Log3( $hash, 4, "[$name] aktParam:$aktParam newParam:$newParam - is$disabled_txt disabled" ); + Log3( $hash, 4, "[$name] aktParam:$aktParam newParam:$newParam - is not disabled" ); #Kommando ausführen - if ($command && !$disabled && $activeTimer - && $aktParam ne $newParam - ) { - if ( defined $hash->{WDT_EVENTMAP} && defined $hash->{WDT_EVENTMAP}{$newParam} ) { - $newParam = $hash->{WDT_EVENTMAP}{$newParam}; - } else { - $newParam =~ s{\\:}{|}gxms; - $newParam =~ s{:}{ }gxms; - $newParam =~ s{\|}{:}gxms; - } - - my %specials = ( "%NAME" => $hash->{DEVICE}, "%EVENT" => $newParam ); - $command = EvalSpecials($command, %specials); - - Log3( $hash, 4, "[$name] command: '$command' executed with ".join(",", map { "$_=>$specials{$_}" } keys %specials) ); - my $ret = AnalyzeCommandChain(undef, $command); - Log3( $hash, 3, $ret ) if $ret; + return if !$command || $aktParam eq $newParam; + if ( defined $hash->{WDT_EVENTMAP} && defined $hash->{WDT_EVENTMAP}{$newParam} ) { + $newParam = $hash->{WDT_EVENTMAP}{$newParam}; + } else { + $newParam =~ s{\\:}{|}gxms; + $newParam =~ s{:}{ }gxms; + $newParam =~ s{\|}{:}gxms; } + + my %specials = ( "%NAME" => $hash->{DEVICE}, "%EVENT" => $newParam ); + $command = EvalSpecials($command, %specials); + my $ret = AnalyzeCommandChain(undef, $command); + Log3( $hash, 4, "[$name] command: '$command' executed with ".join(",", map { "$_=>$specials{$_}" } keys %specials) ); + return Log3( $hash, 2, $ret ) if $ret; return; } +################################################################################ +sub checkWDTCondition { + my $hash = shift // return 0; + my $para = shift // carp q[No new parameter provided!] && return; + return 1 if !defined $hash->{CONDITION} || !$hash->{CONDITION}; + + my $name = $hash->{NAME}; + my $condition = $hash->{CONDITION}; + + Log3( $hash, 4, "[$name] checking condition: $condition"); + + my %specials = ( "%NAME" => $hash->{DEVICE}, "%EVENT" => $para ); + my $xPression = qq( { $condition } ); + $xPression = EvalSpecials($xPression, %specials); + Log3( $hash, 5, "[$name] evaluated condition: $xPression" ); + + my $ret = AnalyzeCommandChain(undef, $xPression); + Log3( $hash, 5, "[$name] condition evaluation returned: $ret" ); + return $ret; +} + +################################################################################ +sub checkDaysCondition { + my $hash = shift // return 0; + my $tage = shift // return 0; + my $overrulewday = shift; + + my $name = $hash->{NAME}; + Log3( $hash, 4, "[$name] check days:" . join q{,}, @{$tage} ); + my $condition = getDaysAsCondition($tage, $overrulewday); + my $tageAsHash = getDaysAsHash($hash, $tage); + my $xPression = qq( $tageAsHash ; $condition ); + Log3( $hash, 5, "[$name] check days: $xPression" ); + + my $ret = AnalyzePerlCommand(undef, $xPression); + Log3( $hash, 5, "[$name] result of check days: $ret" ); + return $ret; +} + ################################################################################ sub getDaysAsHash { my $hash = shift; my $tage = shift //return {}; -my %days = map {$_ => 1} @{$tage}; + my %days = map {$_ => 1} @{$tage}; delete @days{7,8}; - return 'my $days={};map{$days->{$_}=1}('. join (q{,}, sort keys %days ) .')'; -} - -################################################################################ -sub checkWDTCondition { - my $hash = shift; - my $tage = shift // return 0; - my $overrulewday = shift; - - my $name = $hash->{NAME}; - Log3( $hash, 4, "[$name] condition:$hash->{CONDITION} - Tage:" . join q{,}, @{$tage} ); - - my $condition = q{( }; - $condition .= (defined $hash->{CONDITION} && $hash->{CONDITION} ne '') ? $hash->{CONDITION} : 1 ; - $condition .= ' && ' . getDaysAsCondition($tage, $overrulewday); - $condition .= ')'; - - return $condition; + return 'my $days = {} ; map{ $days->{$_} = 1 }('. join (q{,}, sort keys %days ) .')'; } ################################################################################ @@ -1289,12 +1301,10 @@ sub getDaysAsCondition { my $we = $days{7}; delete $days{7}; # $we my $notWe = $days{8}; delete $days{8}; #!$we - my $tageExp = '(defined $days->{$wday}'; + my $tageExp = 'defined $days->{$wday}'; $tageExp .= ' && !$we' if $overrulewday; $tageExp .= ' || $we' if defined $we; $tageExp .= ' || !$we' if defined $notWe; - $tageExp .= ')'; - return $tageExp; } @@ -1510,23 +1520,22 @@ __END__ set <device> weekprofile <weekprofile-device:topic:profile>

Examples: @@ -1699,7 +1708,6 @@ __END__ "prereqs" : { "runtime" : { "requires" : { - "Data::Dumper" : "0", "Time::Local" : "0", "strict" : "0", "warnings" : "0"