2 # The system variables - those indicated will need to be changed to suit your
3 # circumstances (and callsign)
5 # Copyright (c) 1998 - Dirk Koopman G1TLH
7 # This library is free software; you can redistribute it and/or
8 # modify it under the same terms as Perl itself.
16 @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck carp);
20 use vars qw(%dbglevel $fp);
25 use Time::HiRes qw(gettimeofday);
30 # Avoid generating "subroutine redefined" warnings with the following
31 # hack (from CGI::Carp):
32 if (!defined $DB::VERSION) {
34 eval qq( sub confess {
35 \$SIG{__DIE__} = 'DEFAULT';
36 Debug::dbg(\$@, Carp::shortmess(\@_));
40 \$SIG{__DIE__} = 'DEFAULT';
41 Debug::dbg(\$@, Carp::longmess(\@_));
44 sub carp { Debug::dbg(Carp::shortmess(\@_)); }
45 sub cluck { Debug::dbg(Carp::longmess(\@_)); }
48 CORE::die(Carp::shortmess($@)) if $@;
50 eval qq( sub confess { Carp::confess(\@_); }
51 sub cluck { Carp::cluck(\@_); }
52 sub carp { Carp::cluck(\@_); }
60 my ($t,$ut) = gettimeofday;
61 my $ts = sprintf "%02d:%02d:%02d:%03d", (gmtime($t))[2,1,0], $ut/1000;
65 my @l = split /\n/, $r;
67 s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
68 # print "$_\n" if defined \*STDOUT;
69 $fp->writeunix($t, "$ts $_");
76 # add sig{__DIE__} handling
77 if (!defined $DB::VERSION) {
78 $SIG{__WARN__} = sub { dbg($@, Carp::shortmess(@_)); };
79 $SIG{__DIE__} = sub { dbg($@, Carp::longmess(@_)); };
82 $fp = SMGLog->new('debug', 'log', 'd');
87 $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
98 for (my $o = 0; $o < length $l; $o += 16) {
99 my $c = substr $l, $o, 16;
100 my $h = unpack "H*", $c;
101 $c =~ s/[\x00-\x1f\x7f-\xff]/./g;
102 my $left = 16 - length $c;
103 $h .= ' ' x (2 * $left) if $left > 0;
104 dbg($p . sprintf("%4d:", $o) . "$h $c");
105 $p = ' ' x (length $p);
114 foreach $entry (@_) {
115 $dbglevel{$entry} = 1;
123 foreach $entry (@_) {
124 delete $dbglevel{$entry};
130 return keys (%dbglevel);
135 return undef unless $fp;
136 return $dbglevel{$_[0]};
141 return Carp::shortmess(@_);
146 return Carp::longmess(@_);