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
14 @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose confess croak cluck cluck);
17 use vars qw(%dbglevel $fp);
24 $fp = DXLog::new('debug', 'dat', 'd');
26 # Avoid generating "subroutine redefined" warnings with the following
27 # hack (from CGI::Carp):
28 if (!defined $DB::VERSION) {
30 eval qq( sub confess {
31 \$SIG{__DIE__} = 'DEFAULT';
32 DXDebug::_store(\$@, Carp::shortmess(\@_));
36 \$SIG{__DIE__} = 'DEFAULT';
37 DXDebug::_store(\$@, Carp::longmess(\@_));
40 sub carp { DXDebug::_store(Carp::shortmess(\@_)); }
41 sub cluck { DXDebug::_store(Carp::longmess(\@_)); }
44 CORE::die(Carp::shortmess($@)) if $@;
46 eval qq( sub confess { Carp::confess(\@_); };
47 sub cluck { Carp::cluck(\@_); };
59 print "$_\n" if defined \*STDOUT;
60 $fp->writeunix($t, "$t^$_");
67 # add sig{__DIE__} handling
68 if (!defined $DB::VERSION) {
69 $SIG{__WARN__} = sub { _store($@, Carp::shortmess(@_)); };
70 $SIG{__DIE__} = sub { _store($@, Carp::longmess(@_)); };
76 $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
83 if ($dbglevel{$l} || $l eq 'err') {
89 print "$_\n" if defined \*STDOUT;
90 $fp->writeunix($t, "$t^$_");
100 $dbglevel{$entry} = 1;
108 foreach $entry (@_) {
109 delete $dbglevel{$entry};
115 return keys (%dbglevel);
121 return $dbglevel{$s};
126 return Carp::shortmess(@_);
131 return Carp::longmess(@_);