FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-02 00:48:53 +00:00
Code Issues Releases Wiki Activity

93_DbLog: contrib 5.5.6

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@26854 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2022-12-14 09:50:32 +00:00
parent 73cc3a038a
commit f2c324ea91
1 changed files with 60 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
fhem/contrib/DS_Starter/93_DbLog.pm
View File

@ -25,7 +25,7 @@ use warnings;
eval "use DBI;1;" or my $DbLogMMDBI = "DBI"; ## no critic 'eval' eval "use DBI;1;" or my $DbLogMMDBI = "DBI"; ## no critic 'eval'
eval "use FHEM::Meta;1;" or my $modMetaAbsent = 1; ## no critic 'eval' eval "use FHEM::Meta;1;" or my $modMetaAbsent = 1; ## no critic 'eval'
eval "use FHEM::Utility::CTZ qw(:all);1;" or my $ctzAbsent = 1; ## no critic 'eval' eval "use FHEM::Utility::CTZ qw(:all);1;" or my $ctzAbsent = 1; ## no critic 'eval'
eval "use Storable qw(freeze thaw);1;" or my $storabs = "Storable"; ## no critic 'eval' eval "use Storable qw(freeze thaw dclone);1;" or my $storabs = "Storable"; ## no critic 'eval'
#use Data::Dumper; #use Data::Dumper;
use Time::HiRes qw(gettimeofday tv_interval usleep); use Time::HiRes qw(gettimeofday tv_interval usleep);
@ -1682,12 +1682,6 @@ sub DbLog_Log {
$err = DbLog_execMemCacheSync ($hash); $err = DbLog_execMemCacheSync ($hash);
DbLog_setReadingstate ($hash, $err) if($err); DbLog_setReadingstate ($hash, $err) if($err);
} }
#else {
# if($hash->{HELPER}{SHUTDOWNSEQ}) {
# Log3 ($name, 2, "DbLog $name - no data for last database write cycle");
# _DbLog_finishDelayedShutdown ($hash);
# }
#}
} }
$net = tv_interval($nst); # Notify-Routine Laufzeit ermitteln $net = tv_interval($nst); # Notify-Routine Laufzeit ermitteln
@ -2073,14 +2067,9 @@ return $memcount;
sub DbLog_execMemCacheAsync { sub DbLog_execMemCacheAsync {
my $hash = shift; my $hash = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $syncival = AttrVal($name, "syncInterval", 30);
my $clim = AttrVal($name, "cacheLimit", $dblog_cachedef);
my $async = AttrVal($name, "asyncMode", 0);
my $ce = AttrVal($name, "cacheEvents", 0);
my $DbLogType = AttrVal($name, "DbLogType", 'History');
my $dolog = 1; my $async = AttrVal($name, "asyncMode", 0);
my $error;
RemoveInternalTimer($hash, 'DbLog_execMemCacheAsync'); RemoveInternalTimer($hash, 'DbLog_execMemCacheAsync');
@ -2089,13 +2078,22 @@ sub DbLog_execMemCacheAsync {
return; return;
} }
my $nextsync = gettimeofday() + AttrVal($name, 'syncInterval', 30);
my $se = AttrVal ($name, 'syncEvents', undef) ? 1 : 0;
my $clim = AttrVal ($name, "cacheLimit", $dblog_cachedef);
readingsSingleUpdate($hash, 'NextSync', FmtDateTime ($nextsync). " or when CacheUsage ".$clim." is reached", $se);
DbLog_SBP_CheckAndInit ($hash); # Subprocess checken und ggf. initialisieren DbLog_SBP_CheckAndInit ($hash); # Subprocess checken und ggf. initialisieren
return if(!defined $hash->{".fhem"}{subprocess}); return if(!defined $hash->{".fhem"}{subprocess});
my $ce = AttrVal ($name, 'cacheEvents', 0);
my $memcount = defined $data{DbLog}{$name}{cache}{memcache} ? my $memcount = defined $data{DbLog}{$name}{cache}{memcache} ?
scalar(keys %{$data{DbLog}{$name}{cache}{memcache}}) : scalar(keys %{$data{DbLog}{$name}{cache}{memcache}}) :
0; 0;
readingsSingleUpdate ($hash, 'CacheUsage', $memcount, ($ce == 2 ? 1 : 0));
my $params = { my $params = {
hash => $hash, hash => $hash,
clim => $clim, clim => $clim,
@ -2107,39 +2105,36 @@ sub DbLog_execMemCacheAsync {
return; return;
} }
my $err;
my $verbose = AttrVal ($name, 'verbose', 3);
my $dolog = $memcount ? 1 : 0;
if($hash->{HELPER}{LONGRUN_PID}) { if($hash->{HELPER}{LONGRUN_PID}) {
$dolog = 0; $dolog = 0;
} }
readingsSingleUpdate ($hash, 'CacheUsage', $memcount, ($ce == 2 ? 1 : 0)); if($verbose =~ /[45]/xs && $dolog) {
if($memcount && $dolog) {
Log3 ($name, 4, "DbLog $name - ################################################################"); Log3 ($name, 4, "DbLog $name - ################################################################");
Log3 ($name, 4, "DbLog $name - ### New database processing cycle - SBP asynchronous ###"); Log3 ($name, 4, "DbLog $name - ### New database processing cycle - SBP asynchronous ###");
Log3 ($name, 4, "DbLog $name - ################################################################"); Log3 ($name, 4, "DbLog $name - ################################################################");
Log3 ($name, 4, "DbLog $name - MemCache contains $memcount entries to process"); Log3 ($name, 4, "DbLog $name - MemCache contains $memcount entries to process");
Log3 ($name, 4, "DbLog $name - DbLogType is: $DbLogType"); Log3 ($name, 4, "DbLog $name - DbLogType is: ".AttrVal($name, 'DbLogType', 'History'));
}
if($dolog) {
my $wrotefile = DbLog_writeFileIfCacheOverflow ($params); # Cache exportieren bei Overflow my $wrotefile = DbLog_writeFileIfCacheOverflow ($params); # Cache exportieren bei Overflow
return if($wrotefile); return if($wrotefile);
my $memc; if ($verbose == 5) {
DbLog_logHashContent ($name, $data{DbLog}{$name}{cache}{memcache}, 5, 'MemCache contains: ');
for my $key (sort {$a<=>$b} (keys %{$data{DbLog}{$name}{cache}{memcache}})) {
Log3 ($name, 5, "DbLog $name - MemCache contains: $key -> ".$data{DbLog}{$name}{cache}{memcache}{$key});
$memc->{cdata}{$key} = delete $data{DbLog}{$name}{cache}{memcache}{$key}; # Subprocess Daten, z.B.: 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
} }
$memc->{cdataindex} = $data{DbLog}{$name}{cache}{index}; # aktuellen Index an Subprozess übergeben my $memc = _DbLog_copyCache ($name);
$err = DbLog_SBP_sendLogData ($hash, 'log_asynch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
undef %{$data{DbLog}{$name}{cache}{memcache}}; # sicherheitshalber Memory freigeben: https://perlmaven.com/undef-on-perl-arrays-and-hashes , bzw. https://www.effectiveperlprogramming.com/2018/09/undef-a-scalar-to-release-its-memory/
$error = DbLog_SBP_sendLogData ($hash, 'log_asynch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
} }
else { else {
if($hash->{HELPER}{LONGRUN_PID}) { if($hash->{HELPER}{LONGRUN_PID}) {
$error = 'Another operation is in progress - resync at NextSync'; $err = 'Another operation is in progress - resync at NextSync';
DbLog_writeFileIfCacheOverflow ($params); # Cache exportieren bei Overflow DbLog_writeFileIfCacheOverflow ($params); # Cache exportieren bei Overflow
} }
else { else {
@ -2150,13 +2145,7 @@ sub DbLog_execMemCacheAsync {
} }
} }
my $nextsync = gettimeofday()+$syncival; DbLog_setReadingstate ($hash, $err);
my $nsdt = FmtDateTime ($nextsync);
my $se = AttrVal ($name, 'syncEvents', undef) ? 1 : 0;
readingsSingleUpdate($hash, 'NextSync', $nsdt. " or when CacheUsage ".$clim." is reached", $se);
DbLog_setReadingstate ($hash, $error);
InternalTimer($nextsync, 'DbLog_execMemCacheAsync', $hash, 0); InternalTimer($nextsync, 'DbLog_execMemCacheAsync', $hash, 0);
@ -2174,32 +2163,45 @@ sub DbLog_execMemCacheSync {
return if($hash->{HELPER}{LONGRUN_PID}); return if($hash->{HELPER}{LONGRUN_PID});
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $verbose = AttrVal ($name, 'verbose', 3);
if(AttrVal ($name, 'verbose', 3) =~ /[45]/xs) { if($verbose =~ /[45]/xs) {
Log3 ($name, 4, "DbLog $name - ################################################################"); Log3 ($name, 4, "DbLog $name - ################################################################");
Log3 ($name, 4, "DbLog $name - ### New database processing cycle - SBP synchronous ###"); Log3 ($name, 4, "DbLog $name - ### New database processing cycle - SBP synchronous ###");
Log3 ($name, 4, "DbLog $name - ################################################################"); Log3 ($name, 4, "DbLog $name - ################################################################");
} }
my $memc; if ($verbose == 5) {
DbLog_logHashContent ($name, $data{DbLog}{$name}{cache}{memcache}, 5, 'TempStore contains: ');
for my $key (sort {$a<=>$b} (keys %{$data{DbLog}{$name}{cache}{memcache}})) {
Log3 ($name, 5, "DbLog $name - TempStore contains: $key -> ".$data{DbLog}{$name}{cache}{memcache}{$key});
$memc->{cdata}{$key} = delete $data{DbLog}{$name}{cache}{memcache}{$key}; # Subprocess Daten, z.B.: 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
} }
$memc->{cdataindex} = $data{DbLog}{$name}{cache}{index}; # aktuellen Index an Subprozess übergeben my $memc = _DbLog_copyCache ($name);
$err = DbLog_SBP_sendLogData ($hash, 'log_synch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
undef $data{DbLog}{$name}{cache}{memcache}; # sicherheitshalber Memory freigeben: https://perlmaven.com/undef-on-perl-arrays-and-hashes , bzw. https://www.effectiveperlprogramming.com/2018/09/undef-a-scalar-to-release-its-memory/
$err = DbLog_SBP_sendLogData ($hash, 'log_synch', $memc); # Subprocess Prozessdaten senden, Log-Daten sind in $memc->{cdata} gespeichert
return $err if($err); return $err if($err);
return; return;
} }
#################################################################################################
# Memory Cache kopieren und löschen
#################################################################################################
sub _DbLog_copyCache {
my $name = shift;
my $memc;
while (my ($key, $val) = each %{$data{DbLog}{$name}{cache}{memcache}} ) {
$memc->{cdata}{$key} = $val; # Subprocess Daten, z.B.: 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
}
$memc->{cdataindex} = $data{DbLog}{$name}{cache}{index}; # aktuellen Index an Subprozess übergeben
undef %{$data{DbLog}{$name}{cache}{memcache}}; # Löschen mit Memory freigeben: https://perlmaven.com/undef-on-perl-arrays-and-hashes , bzw. https://www.effectiveperlprogramming.com/2018/09/undef-a-scalar-to-release-its-memory/
return $memc;
}
################################################################# #################################################################
# SubProcess - Hauptprozess gestartet durch _DbLog_SBP_Init # SubProcess - Hauptprozess gestartet durch _DbLog_SBP_Init
# liest Daten vom Parentprozess mit # liest Daten vom Parentprozess mit
@ -4560,7 +4562,7 @@ sub DbLog_writeFileIfCacheOverflow {
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $success = 0; my $success = 0;
my $coft = AttrVal($name, "cacheOverflowThreshold", 0); # Steuerung exportCache statt schreiben in DB my $coft = AttrVal($name, 'cacheOverflowThreshold', 0); # Steuerung exportCache statt schreiben in DB
$coft = ($coft && $coft < $clim) ? $clim : $coft; # cacheOverflowThreshold auf cacheLimit setzen wenn kleiner als cacheLimit $coft = ($coft && $coft < $clim) ? $clim : $coft; # cacheOverflowThreshold auf cacheLimit setzen wenn kleiner als cacheLimit
my $overflowstate = "normal"; my $overflowstate = "normal";
@ -6647,13 +6649,14 @@ sub DbLog_logHashContent {
my $name = shift; my $name = shift;
my $href = shift; my $href = shift;
my $verbose = shift // 3; my $verbose = shift // 3;
my $logtxt = shift // q{};
no warnings 'numeric'; no warnings 'numeric';
for my $key (sort {$a<=>$b} keys %{$href}) { for my $key (sort {$a<=>$b} keys %{$href}) {
next if(!defined $href->{$key}); next if(!defined $href->{$key});
Log3 ($name, $verbose, "DbLog $name - $key -> $href->{$key}"); Log3 ($name, $verbose, "DbLog $name - $logtxt $key -> $href->{$key}");
} }
use warnings; use warnings;