mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-03-09 20:57:11 +00:00
93_DbLog: contrib 5.5.6
git-svn-id: https://svn.fhem.de/fhem/trunk@26849 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
parent
d5e419926f
commit
a965f29fbe
@ -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
|
||||
# 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:
|
||||
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.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 ",
|
||||
@ -2125,7 +2125,7 @@ sub DbLog_execMemCacheAsync {
|
||||
|
||||
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});
|
||||
|
||||
$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;
|
||||
|
||||
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});
|
||||
|
||||
$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
|
||||
|
||||
if ($verbose == 5) {
|
||||
Log3 ($name, 5, "DbLog $name - DB Parameter stored in SubProcess:");
|
||||
|
||||
for my $dbp (sort keys %{$store->{dbparams}}) {
|
||||
next if(!defined $store->{dbparams}{$dbp});
|
||||
Log3 ($name, 5, "DbLog $name - $dbp -> ".$store->{dbparams}{$dbp});
|
||||
}
|
||||
DbLog_logHashContent ($name, $store->{dbparams}, 5);
|
||||
}
|
||||
|
||||
$ret = {
|
||||
@ -2585,7 +2580,7 @@ sub _DbLog_SBP_onRun_Log {
|
||||
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 $index = $memc->{cdataindex}; # aktueller Cache-Index
|
||||
|
||||
|
||||
my $dbh = $store->{dbh};
|
||||
my $dbconn = $store->{dbparams}{dbconn};
|
||||
my $model = $store->{dbparams}{model};
|
||||
@ -2996,7 +2991,7 @@ sub _DbLog_SBP_onRun_Log {
|
||||
if(defined $rowhref) { # nicht gespeicherte Datensätze ausgeben
|
||||
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;
|
||||
}
|
||||
|
||||
#################################################################
|
||||
# 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"
|
||||
#################################################################
|
||||
@ -4139,9 +4119,9 @@ return ($err, $sth);
|
||||
#################################################################
|
||||
sub __DbLog_SBP_sendToParent {
|
||||
my $subprocess = shift;
|
||||
my $ret = shift;
|
||||
my $data = shift;
|
||||
|
||||
my $serial = eval { freeze ($ret) };
|
||||
my $serial = eval { freeze ($data) };
|
||||
$subprocess->writeToParent ($serial);
|
||||
|
||||
return;
|
||||
@ -4227,14 +4207,8 @@ sub DbLog_SBP_sendDbDisconnect {
|
||||
$memc->{dbdisconn} = 1; # Statusbit command disconnect
|
||||
$memc->{operation} = 'dbDisconnect';
|
||||
|
||||
my $serial = eval { freeze ($memc);
|
||||
}
|
||||
or do { $err = $@;
|
||||
Log3 ($name, 1, "DbLog $name - JSON error: $err");
|
||||
return $err;
|
||||
};
|
||||
|
||||
$subprocess->writeToChild ($serial);
|
||||
$err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
|
||||
return $err if($err);
|
||||
|
||||
return;
|
||||
}
|
||||
@ -4275,15 +4249,9 @@ sub DbLog_SBP_sendConnectionData {
|
||||
$memc->{sltjm} = AttrVal ($name, 'SQLiteJournalMode', 'WAL');
|
||||
$memc->{sltcs} = AttrVal ($name, 'SQLiteCacheSize', 4000);
|
||||
}
|
||||
|
||||
my $serial = eval { freeze ($memc);
|
||||
}
|
||||
or do { $err = $@;
|
||||
Log3 ($name, 1, "DbLog $name - JSON error: $err");
|
||||
return $err;
|
||||
};
|
||||
|
||||
$subprocess->writeToChild ($serial);
|
||||
|
||||
$err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
|
||||
return $err if($err);
|
||||
|
||||
return;
|
||||
}
|
||||
@ -4296,7 +4264,7 @@ return;
|
||||
#####################################################
|
||||
sub DbLog_SBP_sendLogData {
|
||||
my $hash = shift;
|
||||
my $oper = shift; # angeforderte Operation
|
||||
my $oper = shift; # angeforderte Operation
|
||||
my $memc = shift;
|
||||
|
||||
my $name = $hash->{NAME};
|
||||
@ -4315,16 +4283,10 @@ sub DbLog_SBP_sendLogData {
|
||||
$memc->{verbose} = AttrVal ($name, 'verbose', 3);
|
||||
$memc->{operation} = $oper;
|
||||
|
||||
my $serial = eval { freeze ($memc);
|
||||
}
|
||||
or do { my $err = $@;
|
||||
Log3 ($name, 1, "DbLog $name - JSON error: $err");
|
||||
return $err;
|
||||
};
|
||||
my $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
|
||||
return $err if($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;
|
||||
}
|
||||
@ -4340,7 +4302,7 @@ return;
|
||||
#####################################################
|
||||
sub DbLog_SBP_sendCommand {
|
||||
my $hash = shift;
|
||||
my $oper = shift; # angeforderte Operation
|
||||
my $oper = shift; # angeforderte Operation
|
||||
my $arg = shift // q{};
|
||||
|
||||
my $name = $hash->{NAME};
|
||||
@ -4356,17 +4318,31 @@ sub DbLog_SBP_sendCommand {
|
||||
$memc->{verbose} = AttrVal ($name, 'verbose', 3);
|
||||
$memc->{operation} = $oper;
|
||||
$memc->{arguments} = $arg;
|
||||
|
||||
my $serial = eval { freeze ($memc);
|
||||
}
|
||||
or do { my $err = $@;
|
||||
Log3 ($name, 1, "DbLog $name - JSON error: $err");
|
||||
return $err;
|
||||
};
|
||||
|
||||
my $err = _DbLog_SBP_sendToChild ($name, $subprocess, $memc);
|
||||
return $err if($err);
|
||||
|
||||
$hash->{HELPER}{LONGRUN_PID} = time(); # Statusbit laufende Verarbeitung mit Startzeitstempel;
|
||||
|
||||
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);
|
||||
|
||||
@ -6662,6 +6638,29 @@ sub DbLog_setinternalcols {
|
||||
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
|
||||
################################################################
|
||||
|
Loading…
x
Reference in New Issue
Block a user