Add logging modules and improve logger

[dweather.git] / Debug.pm

diff --git a/Debug.pm b/Debug.pm
new file mode 100644 (file)
index 0000000..5bf2b5c
--- /dev/null
+++ b/Debug.pm
@@ -0,0 +1,155 @@
+#
+# The system variables - those indicated will need to be changed to suit your
+# circumstances (and callsign)
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+
+package Debug;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck carp);
+$VERSION = 1.23;
+
+use strict;
+use vars qw(%dbglevel $fp);
+
+use SMGLog ();
+use Carp qw(cluck);
+
+%dbglevel = ();
+$fp = undef;
+
+# Avoid generating "subroutine redefined" warnings with the following
+# hack (from CGI::Carp):
+if (!defined $DB::VERSION) {
+       local $^W=0;
+       eval qq( sub confess { 
+           \$SIG{__DIE__} = 'DEFAULT'; 
+        Debug::dbg(\$@, Carp::shortmess(\@_));
+           exit(-1); 
+       }
+       sub croak { 
+               \$SIG{__DIE__} = 'DEFAULT'; 
+        Debug::dbg(\$@, Carp::longmess(\@_));
+               exit(-1); 
+       }
+       sub carp    { Debug::dbg(Carp::shortmess(\@_)); }
+       sub cluck   { Debug::dbg(Carp::longmess(\@_)); } 
+       );
+
+    CORE::die(Carp::shortmess($@)) if $@;
+} else {
+    eval qq( sub confess { Carp::confess(\@_); }
+       sub cluck { Carp::cluck(\@_); } 
+       sub carp { Carp::cluck(\@_); } 
+   );
+} 
+
+dbginit();
+
+sub dbg
+{
+       my $t = time; 
+       my $ts = sprintf("%02d:%02d:%02d", (gmtime($t))[2,1,0]);
+       for (@_) {
+               my $r = $_;
+               chomp $r;
+               my @l = split /\n/, $r;
+               for (@l) {
+                       s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
+#                      print "$_\n" if defined \*STDOUT;
+                       $fp->writeunix($t, "$ts $_"); 
+               }
+       }
+}
+
+sub dbginit
+{
+       # add sig{__DIE__} handling
+       if (!defined $DB::VERSION) {
+               $SIG{__WARN__} = sub { dbg($@, Carp::shortmess(@_)); };
+               $SIG{__DIE__} = sub { dbg($@, Carp::longmess(@_)); };
+       }
+
+       $fp = SMGLog->new('debug', 'log', 'd');
+}
+
+sub dbgclose
+{
+       $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
+       $fp->close() if $fp;
+       undef $fp;
+}
+
+sub dbgdump
+{
+       my $m = shift;
+
+       foreach my $l (@_) {
+               my $p = $m;
+               for (my $o = 0; $o < length $l; $o += 16) {
+                       my $c = substr $l, $o, 16;
+                       my $h = unpack "H*", $c;
+                       $c =~ s/[\x00-\x1f\x7f-\xff]/./g;
+                       my $left = 16 - length $c;
+                       $h .= ' ' x (2 * $left) if $left > 0;
+                       dbg($p . sprintf("%4d:", $o) . "$h $c");
+                       $p = ' ' x (length $p);
+               }
+       }
+}
+
+sub dbgadd
+{ 
+       my $entry;
+       
+       foreach $entry (@_) {
+               $dbglevel{$entry} = 1;
+       }
+}
+
+sub dbgsub
+{
+       my $entry;
+       
+       foreach $entry (@_) {
+               delete $dbglevel{$entry};
+       }
+}
+
+sub dbglist
+{
+       return keys (%dbglevel);
+}
+
+sub isdbg
+{
+       return undef unless $fp;
+       return $dbglevel{$_[0]};
+}
+
+sub shortmess 
+{
+       return Carp::shortmess(@_);
+}
+
+sub longmess 
+{ 
+       return Carp::longmess(@_);
+}
+
+1;
+__END__
+
+
+
+
+
+
+