FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-10 03:06:37 +00:00
Code Issues Releases Wiki Activity

93_DbLog: contrib 5.5.6

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@26849 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2022-12-13 09:06:36 +00:00
parent d5e419926f
commit a965f29fbe
1 changed files with 64 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
############################################################################################################################################ ############################################################################################################################################
# $Id: 93_DbLog.pm 26750 2022-12-12 16:38:54Z DS_Starter $ # $Id: 93_DbLog.pm 26750 2022-12-13 16:38:54Z DS_Starter $
# #
# 93_DbLog.pm # 93_DbLog.pm
# written by Dr. Boris Neubert 2007-12-30 # written by Dr. Boris Neubert 2007-12-30
@ -38,7 +38,7 @@ no if $] >= 5.017011, warnings => 'experimental::smartmatch';
# Version History intern by DS_Starter: # Version History intern by DS_Starter:
my %DbLog_vNotesIntern = ( my %DbLog_vNotesIntern = (
"5.5.6" => "12.12.2022 Serialize with Storable instead of JSON ", "5.5.6" => "12.12.2022 Serialize with Storable instead of JSON, more code rework ",
"5.5.5" => "11.12.2022 Array Log -> may be better error processing ", "5.5.5" => "11.12.2022 Array Log -> may be better error processing ",
"5.5.4" => "11.12.2022 Array Log -> print out all cache not saved, DbLog_DelayedShutdown processing changed ", "5.5.4" => "11.12.2022 Array Log -> print out all cache not saved, DbLog_DelayedShutdown processing changed ",
"5.5.3" => "10.12.2022 more internal code rework ", "5.5.3" => "10.12.2022 more internal code rework ",
@ -2125,7 +2125,7 @@ sub DbLog_execMemCacheAsync {
my $memc; my $memc;
for my $key (sort(keys %{$data{DbLog}{$name}{cache}{memcache}})) { 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}); 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->{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|
@ -2184,7 +2184,7 @@ sub DbLog_execMemCacheSync {
my $memc; my $memc;
for my $key (sort(keys %{$data{DbLog}{$name}{cache}{memcache}})) { 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}); 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->{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|
@ -2284,12 +2284,7 @@ sub DbLog_SBP_onRun {
$store->{dbparams}{dbstorepars} = $memc->{dbstorepars}; # Status Speicherung DB Parameter 0|1 $store->{dbparams}{dbstorepars} = $memc->{dbstorepars}; # Status Speicherung DB Parameter 0|1
if ($verbose == 5) { if ($verbose == 5) {
Log3 ($name, 5, "DbLog $name - DB Parameter stored in SubProcess:"); DbLog_logHashContent ($name, $store->{dbparams}, 5);
for my $dbp (sort keys %{$store->{dbparams}}) {
next if(!defined $store->{dbparams}{$dbp});
Log3 ($name, 5, "DbLog $name - $dbp -> ".$store->{dbparams}{$dbp});
}
} }
$ret = { $ret = {
@ -2585,7 +2580,7 @@ sub _DbLog_SBP_onRun_Log {
my $operation = $memc->{operation} // 'unknown'; # aktuell angeforderte Operation (log, etc.) my $operation = $memc->{operation} // 'unknown'; # aktuell angeforderte Operation (log, etc.)
my $cdata = $memc->{cdata}; # Log Daten, z.B.: 3399 => 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47| my $cdata = $memc->{cdata}; # Log Daten, z.B.: 3399 => 2022-11-29 09:33:32|SolCast|SOLARFORECAST||nextCycletime|09:33:47|
my $index = $memc->{cdataindex}; # aktueller Cache-Index my $index = $memc->{cdataindex}; # aktueller Cache-Index
my $dbh = $store->{dbh}; my $dbh = $store->{dbh};
my $dbconn = $store->{dbparams}{dbconn}; my $dbconn = $store->{dbparams}{dbconn};
my $model = $store->{dbparams}{model}; my $model = $store->{dbparams}{model};
@ -2996,7 +2991,7 @@ sub _DbLog_SBP_onRun_Log {
if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben
Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:"); Log3 ($name, 2, "DbLog $name - The following data are faulty and were not saved:");
__DbLog_SBP_logHashContent ($name, $rowhref); DbLog_logHashContent ($name, $rowhref, 2);
} }
} }
@ -3959,21 +3954,6 @@ sub __DbLog_SBP_beginTransaction {
return $err; return $err;
} }
#################################################################
# einen Hashinhalt mit Schlüssel ausgeben
# $href - Rferenz auf den Hash
#################################################################
sub __DbLog_SBP_logHashContent {
my $name = shift;
my $href = shift;
for my $key (sort {$a<=>$b} keys %{$href}) {
Log3 ($name, 2, "DbLog $name - $key -> $href->{$key}");
}
return;
}
################################################################# #################################################################
# nur Datenbank "commit" # nur Datenbank "commit"
################################################################# #################################################################
@ -4139,9 +4119,9 @@ return ($err, $sth);
################################################################# #################################################################
sub __DbLog_SBP_sendToParent { sub __DbLog_SBP_sendToParent {
my $subprocess = shift; my $subprocess = shift;
my $ret = shift; my $data = shift;
my $serial = eval { freeze ($ret) }; my $serial = eval { freeze ($data) };
$subprocess->writeToParent ($serial); $subprocess->writeToParent ($serial);
return; return;
@ -4227,14 +4207,8 @@ sub DbLog_SBP_sendDbDisconnect {
$memc->{dbdisconn} = 1; # Statusbit command disconnect $memc->{dbdisconn} = 1; # Statusbit command disconnect
$memc->{operation} = 'dbDisconnect'; $memc->{operation} = 'dbDisconnect';
my $serial = eval { freeze ($memc); $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
} return $err if($err);
or do { $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err;
};
$subprocess->writeToChild ($serial);
return; return;
} }
@ -4275,15 +4249,9 @@ sub DbLog_SBP_sendConnectionData {
$memc->{sltjm} = AttrVal ($name, 'SQLiteJournalMode', 'WAL'); $memc->{sltjm} = AttrVal ($name, 'SQLiteJournalMode', 'WAL');
$memc->{sltcs} = AttrVal ($name, 'SQLiteCacheSize', 4000); $memc->{sltcs} = AttrVal ($name, 'SQLiteCacheSize', 4000);
} }
my $serial = eval { freeze ($memc); $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
} return $err if($err);
or do { $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err;
};
$subprocess->writeToChild ($serial);
return; return;
} }
@ -4296,7 +4264,7 @@ return;
##################################################### #####################################################
sub DbLog_SBP_sendLogData { sub DbLog_SBP_sendLogData {
my $hash = shift; my $hash = shift;
my $oper = shift; # angeforderte Operation my $oper = shift; # angeforderte Operation
my $memc = shift; my $memc = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -4315,16 +4283,10 @@ sub DbLog_SBP_sendLogData {
$memc->{verbose} = AttrVal ($name, 'verbose', 3); $memc->{verbose} = AttrVal ($name, 'verbose', 3);
$memc->{operation} = $oper; $memc->{operation} = $oper;
my $serial = eval { freeze ($memc); my $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
} return $err if($err);
or do { my $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err");
return $err;
};
$subprocess->writeToChild ($serial); $hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
$hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
return; return;
} }
@ -4340,7 +4302,7 @@ return;
##################################################### #####################################################
sub DbLog_SBP_sendCommand { sub DbLog_SBP_sendCommand {
my $hash = shift; my $hash = shift;
my $oper = shift; # angeforderte Operation my $oper = shift; # angeforderte Operation
my $arg = shift // q{}; my $arg = shift // q{};
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -4356,17 +4318,31 @@ sub DbLog_SBP_sendCommand {
$memc->{verbose} = AttrVal ($name, 'verbose', 3); $memc->{verbose} = AttrVal ($name, 'verbose', 3);
$memc->{operation} = $oper; $memc->{operation} = $oper;
$memc->{arguments} = $arg; $memc->{arguments} = $arg;
my $serial = eval { freeze ($memc); my $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
} return $err if($err);
or do { my $err = $@;
Log3 ($name, 1, "DbLog $name - JSON error: $err"); $hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
return $err;
};
DbLog_setReadingstate ($hash, "operation '$oper' is running"); DbLog_setReadingstate ($hash, "operation '$oper' is running");
$hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel; return;
}
#################################################################
# Information Serialisieren und an Child Prozess senden
#################################################################
sub _DbLog_SBP_sendToChild {
my $name = shift;
my $subprocess = shift;
my $data = shift;
my $serial = eval { freeze ($data);
}
or do { my $err = $@;
Log3 ($name, 1, "DbLog $name - Serialization error: $err");
return $err;
};
$subprocess->writeToChild ($serial); $subprocess->writeToChild ($serial);
@ -6662,6 +6638,29 @@ sub DbLog_setinternalcols {
return; return;
} }
#################################################################
# einen Hashinhalt mit Schlüssel ausgeben
# $href - Referenz auf den Hash
# $verbose - Level für Logausgabe
#################################################################
sub DbLog_logHashContent {
my $name = shift;
my $href = shift;
my $verbose = shift // 3;
no warnings 'numeric';
for my $key (sort {$a<=>$b} keys %{$href}) {
next if(!defined $href->{$key});
Log3 ($name, $verbose, "DbLog $name - $key -> $href->{$key}");
}
use warnings;
return;
}
################################################################ ################################################################
# reopen DB-Connection nach Ablauf set ... reopen [n] seconds # reopen DB-Connection nach Ablauf set ... reopen [n] seconds
################################################################ ################################################################