mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-02-01 13:29:26 +00:00
98_freezemon.pm: fix for some Perl warnings
git-svn-id: https://svn.fhem.de/fhem/trunk@18272 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
parent
19eef8ae6d
commit
6e170269d2
@ -89,6 +89,7 @@ package main;
|
|||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
#use Data::Dumper;
|
#use Data::Dumper;
|
||||||
use POSIX;
|
use POSIX;
|
||||||
use Time::HiRes qw(gettimeofday);
|
use Time::HiRes qw(gettimeofday);
|
||||||
@ -161,11 +162,10 @@ sub freezemon_Define($$) {
|
|||||||
freezemon_start($hash);
|
freezemon_start($hash);
|
||||||
}
|
}
|
||||||
elsif ( IsDisabled($name) ) {
|
elsif ( IsDisabled($name) ) {
|
||||||
$hash->{STATE} = "inactive";
|
readingsSingleUpdate( $hash, "state", "inactive", 1 );
|
||||||
$hash->{helper}{DISABLED} = 1;
|
$hash->{helper}{DISABLED} = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
###################################
|
###################################
|
||||||
@ -324,7 +324,7 @@ sub freezemon_ProcessTimer($) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# prioQueues are not unique, so we are using the old way...
|
# prioQueues are not unique, so we are using the old way...
|
||||||
if ( exists ($hash->{helper}{apptime}) && $hash->{helper}{apptime} ne "" ) {
|
if ( exists( $hash->{helper}{apptime} ) && $hash->{helper}{apptime} ne "" ) {
|
||||||
my @olddev = split( " ", $hash->{helper}{apptime} );
|
my @olddev = split( " ", $hash->{helper}{apptime} );
|
||||||
my @newdev = split( " ", freezemon_apptime($hash) );
|
my @newdev = split( " ", freezemon_apptime($hash) );
|
||||||
|
|
||||||
@ -546,7 +546,7 @@ sub freezemon_Set($@) {
|
|||||||
my $usage = "Unknown argument $cmd, choose one of active:noArg inactive:noArg clear:noArg";
|
my $usage = "Unknown argument $cmd, choose one of active:noArg inactive:noArg clear:noArg";
|
||||||
|
|
||||||
return "\"set $name\" needs at least one argument" unless ( defined($cmd) );
|
return "\"set $name\" needs at least one argument" unless ( defined($cmd) );
|
||||||
Log3 $name,5, "$name Coming with command $cmd";
|
Log3 $name, 5, "$name Coming with command $cmd";
|
||||||
if ( $cmd eq "inactive" ) {
|
if ( $cmd eq "inactive" ) {
|
||||||
RemoveInternalTimer($hash);
|
RemoveInternalTimer($hash);
|
||||||
readingsSingleUpdate( $hash, "state", "inactive", 1 );
|
readingsSingleUpdate( $hash, "state", "inactive", 1 );
|
||||||
@ -577,7 +577,7 @@ sub freezemon_Set($@) {
|
|||||||
readingsEndUpdate( $hash, 1 );
|
readingsEndUpdate( $hash, 1 );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
Log3 $name,5, "$name leaving with $usage";
|
Log3 $name, 5, "$name leaving with $usage";
|
||||||
return $usage;
|
return $usage;
|
||||||
}
|
}
|
||||||
return undef;
|
return undef;
|
||||||
@ -592,7 +592,8 @@ sub freezemon_Get($@) {
|
|||||||
my $usage = 'Unknown argument $a[1], choose one of freeze:noArg log:';
|
my $usage = 'Unknown argument $a[1], choose one of freeze:noArg log:';
|
||||||
|
|
||||||
return "\"get $name\" needs at least one argument" unless ( defined( $a[1] ) );
|
return "\"get $name\" needs at least one argument" unless ( defined( $a[1] ) );
|
||||||
Log3 $name,5, "$name GET Coming with command $a[1]";
|
Log3 $name, 5, "$name GET Coming with command $a[1]";
|
||||||
|
|
||||||
#get the logfiles
|
#get the logfiles
|
||||||
my @fl = freezemon_getLogFiles($name);
|
my @fl = freezemon_getLogFiles($name);
|
||||||
|
|
||||||
@ -655,7 +656,7 @@ sub freezemon_Get($@) {
|
|||||||
|
|
||||||
# return usage hint
|
# return usage hint
|
||||||
else {
|
else {
|
||||||
Log3 $name,5, "GET $name leaving with $usage";
|
Log3 $name, 5, "GET $name leaving with $usage";
|
||||||
return $usage;
|
return $usage;
|
||||||
}
|
}
|
||||||
return undef;
|
return undef;
|
||||||
@ -716,7 +717,7 @@ sub freezemon_Attr($) {
|
|||||||
$fmFnLog = AttrVal( $name, "fm_CatchFnCalls", 0 );
|
$fmFnLog = AttrVal( $name, "fm_CatchFnCalls", 0 );
|
||||||
|
|
||||||
}
|
}
|
||||||
elsif ( defined ($hash->{helper}{mycallFn} ) ) {
|
elsif ( defined( $hash->{helper}{mycallFn} ) ) {
|
||||||
Log3( "", 0, "[Freezemon] $name: Unwrapping CallFn" );
|
Log3( "", 0, "[Freezemon] $name: Unwrapping CallFn" );
|
||||||
{
|
{
|
||||||
no warnings;
|
no warnings;
|
||||||
@ -736,7 +737,7 @@ sub freezemon_Attr($) {
|
|||||||
$fmName = $name;
|
$fmName = $name;
|
||||||
$fmCmdLog = AttrVal( $name, "fm_CatchCmds", 0 );
|
$fmCmdLog = AttrVal( $name, "fm_CatchCmds", 0 );
|
||||||
}
|
}
|
||||||
elsif ( defined ( $hash->{helper}{AnalyzeCommand} ) ) {
|
elsif ( defined( $hash->{helper}{AnalyzeCommand} ) ) {
|
||||||
Log3( "", 0, "[Freezemon] $name: Unwrapping AnalyzeCommand" );
|
Log3( "", 0, "[Freezemon] $name: Unwrapping AnalyzeCommand" );
|
||||||
{
|
{
|
||||||
no warnings;
|
no warnings;
|
||||||
@ -848,7 +849,9 @@ sub freezemon_apptime($) {
|
|||||||
$fnname = $cv->GV->NAME;
|
$fnname = $cv->GV->NAME;
|
||||||
$ret .= $fnname;
|
$ret .= $fnname;
|
||||||
|
|
||||||
$shortarg = ( defined( $entry->{arg} ) ? $entry->{arg} : "" );
|
#$shortarg = ( defined( $entry->{arg} ) ? $entry->{arg} : "" );
|
||||||
|
if ( defined( $entry->{arg} ) ) {
|
||||||
|
$shortarg = $entry->{arg};
|
||||||
|
|
||||||
#Log3 $name, 5, "Freezemon: found a prioQueue arg ".ref($shortarg);
|
#Log3 $name, 5, "Freezemon: found a prioQueue arg ".ref($shortarg);
|
||||||
if ( ref($shortarg) eq "HASH" ) {
|
if ( ref($shortarg) eq "HASH" ) {
|
||||||
@ -864,6 +867,8 @@ sub freezemon_apptime($) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
( $shortarg, undef ) = split( /:|;/, $shortarg, 2 );
|
( $shortarg, undef ) = split( /:|;/, $shortarg, 2 );
|
||||||
|
}
|
||||||
|
|
||||||
$shortarg = "" unless defined($shortarg);
|
$shortarg = "" unless defined($shortarg);
|
||||||
$ret .= ":" . $shortarg . " ";
|
$ret .= ":" . $shortarg . " ";
|
||||||
|
|
||||||
@ -973,7 +978,7 @@ sub freezemon_callFn($@) {
|
|||||||
|
|
||||||
# take current time, then immediately call the original function
|
# take current time, then immediately call the original function
|
||||||
my $t0 = [gettimeofday];
|
my $t0 = [gettimeofday];
|
||||||
my ($result,$p) = $lfn->(@args);
|
my ( $result, $p ) = $lfn->(@args);
|
||||||
my $ms = tv_interval($t0);
|
my $ms = tv_interval($t0);
|
||||||
my $d = $args[0];
|
my $d = $args[0];
|
||||||
my $n = $args[1];
|
my $n = $args[1];
|
||||||
@ -984,7 +989,7 @@ sub freezemon_callFn($@) {
|
|||||||
#$fm_fn .= "$n:$d ";
|
#$fm_fn .= "$n:$d ";
|
||||||
Log3 $fmName, $fmFnLog, "[Freezemon] $fmName: Long function call detected $n:$d - $ms seconds";
|
Log3 $fmName, $fmFnLog, "[Freezemon] $fmName: Long function call detected $n:$d - $ms seconds";
|
||||||
}
|
}
|
||||||
return ($result,$p) if ($p) ;
|
return ( $result, $p ) if ($p);
|
||||||
return $result;
|
return $result;
|
||||||
}
|
}
|
||||||
###################################
|
###################################
|
||||||
@ -993,7 +998,7 @@ sub freezemon_AnalyzeCommand($$$;$) {
|
|||||||
|
|
||||||
# take current time, then immediately call the original function
|
# take current time, then immediately call the original function
|
||||||
my $t0 = [gettimeofday];
|
my $t0 = [gettimeofday];
|
||||||
my ($result,$p) = $lfn->( $cl, $cmd, $cfc );
|
my $result = $lfn->( $cl, $cmd, $cfc );
|
||||||
my $ms = tv_interval($t0);
|
my $ms = tv_interval($t0);
|
||||||
my $d = "";
|
my $d = "";
|
||||||
my $n = $cmd;
|
my $n = $cmd;
|
||||||
@ -1010,7 +1015,8 @@ sub freezemon_AnalyzeCommand($$$;$) {
|
|||||||
#$fm_fn .= "$n:$d ";
|
#$fm_fn .= "$n:$d ";
|
||||||
Log3 $fmName, $fmCmdLog, "[Freezemon] $fmName: Long running Command detected $n:$d - $ms seconds";
|
Log3 $fmName, $fmCmdLog, "[Freezemon] $fmName: Long running Command detected $n:$d - $ms seconds";
|
||||||
}
|
}
|
||||||
return ($result,$p) if ($p) ;
|
|
||||||
|
#return ($result,$p) if ($p) ;
|
||||||
return $result;
|
return $result;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1236,7 +1242,15 @@ sub freezemon_dump_log($$$) {
|
|||||||
sub freezemon_logLink($$) {
|
sub freezemon_logLink($$) {
|
||||||
my ( $name, $link ) = @_;
|
my ( $name, $link ) = @_;
|
||||||
return "" if !$link;
|
return "" if !$link;
|
||||||
my $ret = "<a href='$FW_ME?cmd=" . urlEncode("get $name log $link") . "&%%CSRF%%'> [Log]</a>";
|
my $me;
|
||||||
|
if ( defined($FW_ME) ) {
|
||||||
|
$me = $FW_ME;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$me = "fhem";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $ret = "<a href='$me?cmd=" . urlEncode("get $name log $link") . "&%%CSRF%%'> [Log]</a>";
|
||||||
return $ret;
|
return $ret;
|
||||||
}
|
}
|
||||||
###################################
|
###################################
|
||||||
|
Loading…
Reference in New Issue
Block a user