From 6b94464c4ea99f8e48ce7f0c19fb223a2c2c5c34 Mon Sep 17 00:00:00 2001
From: Beta-User <>
Date: Sat, 20 Nov 2021 06:03:01 +0000
Subject: [PATCH] 98_WeekdayTimer: prevent double actions, CONDITION now is
changed at each switching time, (#124101)
git-svn-id: https://svn.fhem.de/fhem/trunk@25243 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
fhem/CHANGED | 1 +
fhem/FHEM/98_WeekdayTimer.pm | 198 ++++++++++++++++++-----------------
2 files changed, 104 insertions(+), 95 deletions(-)
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>
set $NAME $EVENT
or some variation wrt. to the device beeing recognized as heating type (see WDT_eventMap for even more options!).
-
-
- The following parameter are replaced:
Examples: @@ -1699,7 +1708,6 @@ __END__ "prereqs" : { "runtime" : { "requires" : { - "Data::Dumper" : "0", "Time::Local" : "0", "strict" : "0", "warnings" : "0"