diff --git a/FHEM/98_freezemon.pm b/FHEM/98_freezemon.pm index 107e7f3b0..20b276858 100644 --- a/FHEM/98_freezemon.pm +++ b/FHEM/98_freezemon.pm @@ -22,6 +22,11 @@ # ############################################################################## # Changelog: +# 0.0.31 (23.05.2020): Fixed some minor bugs, including comandref +# Added catchHttp attribute +# Re-enabled extraSeconds attribute +# Added meta-json +# Added "log" class to logoutput # 0.0.30 (06.01.2020): Fixed minor issue (topic,83909.msg1009807.html#msg1009807) # 0.0.29 (20.12.2019): Removed remaining "Dumper" code # Few minor fixes @@ -113,15 +118,19 @@ use Time::HiRes qw(tv_interval); use B qw(svref_2object); use Blocking; use vars qw($FW_CSRF); +use FHEM::Meta; -my $version = "0.0.30"; +my $version = "0.0.31"; my @logqueue = (); my @fmCmd = (); my @fmFn = (); +my @fmHttp = (); + my $fmName; my $fmCmdLog; my $fmFnLog; +my $fmHttpLog; ################################### sub freezemon_Initialize($) { @@ -130,9 +139,22 @@ sub freezemon_Initialize($) { # Module specific attributes my @freezemon_attr = - ( -"fm_forceApptime:0,1 fm_freezeThreshold disable:0,1 fm_log fm_ignoreDev fm_ignoreMode:off,single,all fm_extDetail:0,1 fm_logExtraSeconds fm_logFile fm_logKeep fm_whitelistSub fm_CatchFnCalls:0,1,2,3,4,5 fm_CatchCmds:0,1,2,3,4,5 fm_statistics:0,1 fm_statistics_low" - ); + ( "fm_forceApptime:0,1 " + . "fm_freezeThreshold " + . "disable:0,1 " + . "fm_log " + . "fm_ignoreDev " + . "fm_ignoreMode:off,single,all " + . "fm_extDetail:0,1 " + . "fm_logExtraSeconds " + . "fm_logFile " + . "fm_logKeep " + . "fm_whitelistSub " + . "fm_CatchFnCalls:0,1,2,3,4,5 " + . "fm_CatchCmds:0,1,2,3,4,5 " + . "fm_statistics:0,1 " + . "fm_statistics_low " + . "fm_CatchHttp:0,1,2,3,4,5" ); $hash->{GetFn} = "freezemon_Get"; $hash->{SetFn} = "freezemon_Set"; @@ -150,6 +172,8 @@ sub freezemon_Initialize($) { "fmFreezeTime" => "fm_freezeThreshold" }; + # Add Meta + #return FHEM::Meta::InitMod( __FILE__, $hash ); } ################################### @@ -158,6 +182,9 @@ sub freezemon_Define($$) { my ( $hash, $def ) = @_; my @a = split( "[ \t][ \t]*", $def ); + #Add Meta + #return $@ unless ( FHEM::Meta::SetInternals($hash) ); + RemoveInternalTimer($hash); my $usage = "syntax: define freezemon"; @@ -251,8 +278,9 @@ sub freezemon_ProcessTimer($) { #RemoveInternalTimer($hash); - my $now = gettimeofday(); - my $freeze = $now - $hash->{helper}{TIMER}; + my $now = gettimeofday(); + my $freeze = $now - $hash->{helper}{TIMER}; + my $extraSec = AttrNum( $name, "fm_logExtraSeconds", 0 ); #Check Freezes if ( $freeze > AttrVal( $name, "fm_freezeThreshold", 1 ) ) { @@ -293,6 +321,22 @@ sub freezemon_ProcessTimer($) { my %blacklist = map { $_ => 1 } split( ",", AttrVal( $name, "fm_whitelistSub", "" ) ); + # Callbacks + foreach my $entry (@fmHttp) { + if ( exists( $id{ @$entry[1] } ) ) { + $idevFlag = @$entry[1]; + } + else { + $nidevFlag = @$entry[1]; + } + if ( exists( $blacklist{ @$entry[0] } ) ) { + Log3 $name, 5, "[Freezemon] $name whitelisted: " . @$entry[0]; + next; + } + $dev .= "cb-" . @$entry[0] . "(" . @$entry[1] . ") "; + push @rlist, @$entry[1]; + } + # Commands foreach my $entry (@fmCmd) { if ( exists( $id{ @$entry[1] } ) ) { @@ -413,16 +457,24 @@ sub freezemon_ProcessTimer($) { } } - # Create Log( - $hash->{helper}{msg} = - strftime( - "[Freezemon] $name: possible freeze starting at %H:%M:%S, delay is $freeze possibly caused by: $dev", - localtime( $hash->{helper}{TIMER} ) ); - + # Create Log + if ($fhemForked) { + $hash->{helper}{msg} = +"[Freezemon] $name: Freeze in child process of blocking mode, please inform the module maintainer: https://forum.fhem.de/index.php/topic,83909"; + } + else { + $hash->{helper}{msg} = strftime( +"[Freezemon] $name: possible freeze starting at %H:%M:%S, delay is $freeze possibly caused by: $dev", + localtime( $hash->{helper}{TIMER} ) + ); + } my @t = localtime($seconds); my $log = ResolveDateWildcards( AttrVal( $name, "fm_logFile", undef ), @t ); # BlockingCall for Logfile creation /create a queue + if ( $extraSec > 0 ) { + freezemon_purge_log_before( $hash, $hash->{helper}{TIMER} - $extraSec ); + } if ( AttrVal( $name, "fm_logFile", "" ) ne "" ) { my @cqueue = @logqueue; @@ -509,11 +561,15 @@ sub freezemon_ProcessTimer($) { Log3 $name, 5, "[Freezemon] $name: ----------- Ending Freeze handling at $tim after $ms --------"; } - #freezemon_purge_log_before( $hash, $hash->{helper}{TIMER} - AttrVal( $name, "fm_logExtraSeconds", 0 ) ) - # if ( AttrVal( $name, "fm_logFile", "" ) ne "" ); - undef(@logqueue); + if ( $extraSec == 0 ) { + undef(@logqueue); + } + else { + #freezemon_purge_log_before( $hash, $hash->{helper}{TIMER} - $extraSec ); + } undef(@fmCmd); undef(@fmFn); + undef(@fmHttp); # ---- Some stuff not required every second $hash->{helper}{intCount} //= 0; @@ -521,6 +577,9 @@ sub freezemon_ProcessTimer($) { if ( $hash->{helper}{intCount} >= 60 ) { $hash->{helper}{intCount} = 0; + # Purge Log so it doesn't get too big + freezemon_purge_log_before( $hash, $hash->{helper}{TIMER} - $extraSec ) if $extraSec > 0; + #Update dayLast readings if we have a new day my $last = ReadingsVal( $name, ".lastDay", "" ); my $dnow = strftime( "%Y-%m-%d", localtime ); @@ -539,6 +598,14 @@ sub freezemon_ProcessTimer($) { readingsEndUpdate( $hash, 1 ); } + #check if perfmon is active + if ( $modules{"perfmon"} && $modules{"perfmon"}{"LOADED"} ) { + readingsSingleUpdate( $hash, "perfmon", "Perfmon active, please disable", 0 ); + } + else { + readingsSingleUpdate( $hash, "perfmon", "not active", 0 ); + } + # check if apptime is active if ( AttrVal( $name, "fm_forceApptime", 0 ) == 1 and !defined( $cmds{"apptime"} ) ) @@ -767,11 +834,11 @@ sub freezemon_Get($@) { return "Couldn't open $path"; } else { - my $ret = "
jump to the end

"; + my $ret = "

jump to the end

";
             while ( my $row = <$fh> ) {
                 $ret .= $row . "
";
             }
-            $ret .= "
jump to the top

";
+            $ret .= "
jump to the top

"; return $ret; } @@ -851,6 +918,27 @@ sub freezemon_Attr($) { Log3( "", 0, "[Freezemon] $name: Unwrapping CallFn - nothing to do" ); } } + elsif ( $aName eq "fm_CatchHttp" ) { + + if ( $aVal ne 0 ) { + freezemon_install_http_wrapper($hash); + $fmHttpLog = $aVal; + $fmName = $name; + + } + elsif ( defined( $hash->{helper}{HttpUtils_NonblockingGet} ) ) { + Log3( "", 0, "[Freezemon] $name: Unwrapping HttpUtils_NonblockingGet" ); + { + no warnings; + *main::HttpUtils_NonblockingGet = $hash->{helper}{HttpUtils_NonblockingGet}; + $hash->{helper}{HttpUtils_NonblockingGet} = undef; + } + } + else { + Log3( "", 0, "[Freezemon] $name: Unwrapping CallFn - nothing to do" ); + } + } + elsif ( $aName eq "fm_CatchCmds" ) { if ( $aVal ne 0 ) { @@ -924,6 +1012,14 @@ sub freezemon_Attr($) { $hash->{helper}{AnalyzeCommand} = undef; } } + elsif ( $aName eq "fm_CatchHttp" ) { + Log3( "", 0, "[Freezemon] $name: Unwrapping HttpUtils_NonblockingGet" ); + { + no warnings; + *main::HttpUtils_NonblockingGet = $hash->{helper}{HttpUtils_NonblockingGet}; + $hash->{helper}{HttpUtils_NonblockingGet} = undef; + } + } elsif ( $aName eq "fm_statistics" ) { $hash->{helper}{statistics} = 0; } @@ -1041,9 +1137,8 @@ sub freezemon_getDevice($$) { elsif ( $fn eq "HttpUtils_Err" ) { #Log3 $name, 5, "[Freezemon] HttpUtils_Err found" . Dumper($shortarg); - if ( defined( $shortarg->{hash}{hash}{NAME} ) ) { + if ( ref( $shortarg->{hash}{hash} ) eq "HASH" and defined( $shortarg->{hash}{hash}{NAME} ) ) { $shortarg = $shortarg->{hash}{hash}{NAME}; - } } elsif ( $fn = "FileLog_dailySwitch" ) { @@ -1069,21 +1164,22 @@ sub freezemon_getDevice($$) { } else { $shortarg = "N/A"; #added 06.01.2020 (0.0.30) Forum topic,83909.msg1009807.html#msg1009807 - #Log3 $name, 5, "[Freezemon] $name found a REF $fn " . Dumper( ${$arg} ); } } elsif ( ref($shortarg) eq "" ) { - Log3 $name, 5, - "[Freezemon] $name found something that's not a REF $fn " . ref($shortarg) . " "; #. Dumper($shortarg); + + #Log3 $name, 5, + # "[Freezemon] $name found something that's not a REF $fn " . ref($shortarg) . " " . Dumper($shortarg); ( undef, $shortarg ) = split( /:|;/, $shortarg, 2 ); } else { - Log3 $name, 5, "[Freezemon] $name found something that's a REF but not a HASH $fn " . ref($shortarg); # . " " - - # . Dumper($shortarg); + Log3 $name, 5, + "[Freezemon] $name found something that's a REF but not a HASH $fn " + . ref($shortarg); + #. Dumper($shortarg); $shortarg = "N/A"; } @@ -1113,6 +1209,14 @@ sub freezemon_unwrap_all($) { *main::AnalyzeCommand = $hash->{helper}{AnalyzeCommand} if defined( $hash->{helper}{AnalyzeCommand} ); $hash->{helper}{AnalyzeCommand} = undef; } + Log3( "", 0, "[Freezemon] $name: Unwrapping HttpUtils_NonblockingGet" ); + { + no warnings; + *main::HttpUtils_NonblockingGet = $hash->{helper}{HttpUtils_NonblockingGet} + if defined( $hash->{helper}{HttpUtils_NonblockingGet} ); + $hash->{helper}{HttpUtils_NonblockingGet} = undef; + } + my $status = Log3( "", 100, "" ); Log3( "", 0, "[Freezemon] $name: Unwrapping Log3" ); { @@ -1130,10 +1234,11 @@ sub freezemon_callFn($@) { my $t0 = [gettimeofday]; my ( $result, $p ) = $lfn->(@args); my $ms = tv_interval($t0); - my $d = $args[0]; - my $n = $args[1]; if ( $ms >= 0.5 ) { + my $d = $args[0]; + my $n = $args[1]; + push @fmFn, [ $n, $d ]; #$fm_fn .= "$n:$d "; @@ -1146,20 +1251,21 @@ sub freezemon_callFn($@) { sub freezemon_AnalyzeCommand($$$;$) { my ( $lfn, $cl, $cmd, $cfc ) = @_; - # take current time, then immediately call the original function + # take current time, then immediately call the original function my $t0 = [gettimeofday]; my $result = $lfn->( $cl, $cmd, $cfc ); my $ms = tv_interval($t0); - my $d = ""; - my $n = $cmd; - if ( exists( $cl->{SNAME} ) ) { - $d = $cl->{SNAME}; - } - else { - $d = "N/A"; - } if ( $ms >= 0.5 ) { + my $d = ""; + my $n = $cmd; + if ( exists( $cl->{SNAME} ) ) { + $d = $cl->{SNAME}; + } + else { + $d = "N/A"; + } + push @fmCmd, [ $n, $d ]; #$fm_fn .= "$n:$d "; @@ -1190,6 +1296,49 @@ sub freezemon_Log3($$$$) { return $result; } +################################### +sub freezemon_http($$) { + my ( $lfn, $param ) = @_; + + if ( ref($param) eq "HASH" ) { + if ( !exists( $param->{fm_originalCallback} ) ) { + $param->{fm_originalCallback} = $param->{callback}; + $param->{callback} = \&freezemon_http_Callback; + Log3 $fmName, 5, + "[Freezemon] $fmName: switching callback from $param->{fm_originalCallback} to $param->{callback}"; + } + $lfn->($param); + } + else { + Log3 $fmName, 3, "[Freezemon] $fmName: Noticed something wrong: " . Dumper($lfn) . "---" . Dumper($param); + } + return undef; +} +################################### +sub freezemon_http_Callback($) { + my ( $param, $err, $data ) = @_; + + # take current time, then immediately call the original function + my $t0 = [gettimeofday]; + my $callback = $param->{fm_originalCallback}; + $param->{callback} = $param->{fm_originalCallback}; + Log3 $fmName, 5, "[Freezemon] $fmName: Calling original sub $callback"; + $param->{callback}( $param, $err, $data ); + my $ms = tv_interval($t0); + + if ( $ms >= 0.5 ) { + my $cv = svref_2object( $param->{callback} ); + my $name = "N/A"; + if ( ref($param) eq "HASH" ) { + $name = $param->{hash}{NAME} if ( ref( $param->{hash} ) eq "HASH" and defined( $param->{hash}{NAME} ) ); + } + my $gv = $cv->GV; + my $cb = $gv->NAME; + push @fmHttp, [ $cb, $name ]; + } + return undef; +} + ################################### sub freezemon_wrap_callFn($) { my ($fn) = @_; @@ -1199,7 +1348,15 @@ sub freezemon_wrap_callFn($) { return freezemon_callFn( $fn, @a ); } } - +################################### +sub freezemon_wrap_http($) { + my ($fn) = @_; + return sub($) { + my ($param) = @_; + return "already wrapped" if ( defined( $param->{url} ) && $param->{url} eq "file://freezemon_wrap.txt" ); + return freezemon_http( $fn, $param ); + } +} ################################### sub freezemon_wrap_AnalyzeCommand($) { my ($fn) = @_; @@ -1239,7 +1396,37 @@ sub freezemon_install_AnalyzeCommand_wrapper($;$) { Log3 $name, 3, "[Freezemon] $name: AnalyzeCommand already wrapped"; } } +################################### +sub freezemon_http_wrapper_Callback($) { + my ( $param, $err, $data ) = @_; + my $hash = $param->{hash}; + my $name = $hash->{NAME}; + if ( $err =~ /freezemon_wrap.txt/ ) { + $hash->{helper}{HttpUtils_NonblockingGet} = \&HttpUtils_NonblockingGet; + Log3( "", 3, "[Freezemon] $name: Wrapping HttpUtils_NonblockingGet" ); + { + no warnings; + *main::HttpUtils_NonblockingGet = freezemon_wrap_http( \&HttpUtils_NonblockingGet ); + } + } + else { + Log3 $name, 3, "[Freezemon] $name: HttpUtils_NonblockingGet already wrapped"; + } +} +################################### +sub freezemon_install_http_wrapper($;$) { + my ( $hash, $nolog ) = @_; + my $name = $hash->{NAME}; + $name = "FreezeMon" unless defined($name); + my $param = { + url => "file://freezemon_wrap.txt", + hash => $hash, + callback => \&freezemon_http_wrapper_Callback + }; + + HttpUtils_NonblockingGet($param); +} ################################### sub freezemon_install_callFn_wrapper($;$) { my ( $hash, $nolog ) = @_; @@ -1284,7 +1471,7 @@ sub freezemon_purge_log_before($$) { my @t = localtime($before); my $tim = sprintf( "%04d.%02d.%02d %02d:%02d:%02d.%03d", $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0], 0 ); - #Log3 $hash, 5, "[Freezemon] $name: purging log entries before $tim."; + Log3 $hash, 5, "[Freezemon] $name: purging log entries before $tim."; my $cnt = 0; while ( scalar @logqueue > 0 && $logqueue[0]->[0] < $before ) { shift @logqueue; @@ -1512,9 +1699,11 @@ sub freezemon_getLogPath($) { Attributes