diff --git a/CHANGED b/CHANGED index 90e35b750..b87d518d0 100644 --- a/CHANGED +++ b/CHANGED @@ -1,5 +1,6 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - feature: 98_fhemdebug, to aid "Error: >< no TYPE" debugging. - feature: 70_Jabber Added possibility to change componentname via attr JabberDomain - feature: 93_DbRep: function readingRename added, delEntries is able to diff --git a/FHEM/98_fhemdebug.pm b/FHEM/98_fhemdebug.pm new file mode 100644 index 000000000..b1da9b1a0 --- /dev/null +++ b/FHEM/98_fhemdebug.pm @@ -0,0 +1,124 @@ +############################################## +# $Id$ +package main; + +use strict; +use warnings; + +my $fhemdebug_enabled; +my $main_callfn; + +sub +fhemdebug_Initialize($){ + $cmds{"fhemdebug"}{Fn} = "fhemdebug_Fn"; + $cmds{"fhemdebug"}{Hlp} = "{start|stop|status}"; +} + +sub +fhemdebug_Fn($$) +{ + my ($cl,$param) = @_; + + if($param eq "enable") { + return "fhemdebug is already enabled" if($fhemdebug_enabled); + local $SIG{__WARN__} = sub { }; + $main_callfn = \&CallFn; + *CallFn = \&fhemdebug_CallFn; + $fhemdebug_enabled = 1; + return undef; + + } elsif($param eq "disable") { + return "fhemdebug is already disabled" if(!$fhemdebug_enabled); + local $SIG{__WARN__} = sub { }; + *CallFn = $main_callfn; + $fhemdebug_enabled = 0; + return undef; + + } elsif($param eq "status") { + return "fhemdebug is ".($fhemdebug_enabled ? "enabled":"disabled"); + + } else { + return "Usage: fhemdebug {enable|disable|status}"; + } +} + +sub +fhemdebug_CheckDefs($@) +{ + my ($txt, $dev, $n) = @_; + foreach my $d (keys %defs) { + if(!defined($d)) { + Log 1, "ERROR: undef \$defs entry found ($txt $dev $n)"; + delete($defs{undef}); + next; + } + if($d eq "") { + Log 1, "ERROR: '' \$defs entry found ($txt $dev $n)"; + delete($defs{''}); + next; + } + if(ref $defs{$d} ne "HASH") { + Log 1, "ERROR: \$defs{$d} is not a HASH ($txt $dev $n)"; + delete($defs{$d}); + next; + } + if(!$defs{$d}{TYPE}) { + Log 1, "ERROR: >$d< has no TYPE, but following keys: >". + join(",", sort keys %{$defs{$d}})."<". + "($txt $dev $n)"; + delete($defs{$d}); + next; + } + } +} + +sub +fhemdebug_CallFn(@) +{ + #Log 1, "fhemdebug_CallFn $_[0] $_[1]; + + if(wantarray) { + fhemdebug_CheckDefs("before", @_); + no strict "refs"; + my @ret = &{$main_callfn}(@_); + use strict "refs"; + fhemdebug_CheckDefs("after", @_); + return @ret; + + } else { + fhemdebug_CheckDefs("before", @_); + no strict "refs"; + my $ret = &{$main_callfn}(@_); + fhemdebug_CheckDefs("after", @_); + use strict "refs"; + return $ret; + + } +} + +1; + +=pod +=item command +=item summary try to localize FHEM error messages +=item summary_DE Hilfe bei der Lokalisierung von Fehlermeldungen +=begin html + + +
fhemdebug {enable|disable|status}