require Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(dbg dbgadd dbgsub dbglist isdbg);
-@EXPORT_OK = qw(dbg dbgadd dbgsub dbglist isdbg);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
+@EXPORT_OK = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
use strict;
use vars qw(%dbglevel $fp);
-use FileHandle;
use DXUtil;
use DXLog ();
use Carp;
%dbglevel = ();
$fp = DXLog::new('debug', 'dat', 'd');
-no strict 'refs';
+sub _store
+{
+ my $t = time;
+ $fp->writeunix($t, "$t^$@") if $@;
+ $fp->writeunix($t, "$t^$!") if $!;
+ for (@_) {
+ $fp->writeunix($t, "$t^$_");
+ print STDERR $_;
+ }
+}
+
+sub dbginit
+{
+ # add sig{__DIE__} handling
+ if (!defined $DB::VERSION) {
+ $SIG{__WARN__} = $SIG{__DIE__} = \&_store;
+ }
+}
+
+sub dbgclose
+{
+ $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
+ $fp->close();
+}
sub dbg
{
my $l = shift;
if ($dbglevel{$l}) {
- for (@_) {
- s/\n$//og;
- }
- print "@_\n" if defined \*STDOUT;
+ my @in = @_;
my $t = time;
- $fp->writeunix($t, "$t^@_");
+ for (@in) {
+ s/\n$//o;
+ s/\a//og; # beeps
+ print "$_\n" if defined \*STDOUT;
+ $fp->writeunix($t, "$t^$_");
+ }
}
}
my $entry;
foreach $entry (@_) {
- delete $dbglevel{entry};
+ delete $dbglevel{$entry};
}
}
sub isdbg
{
- return $dbglevel{shift};
+ my $s = shift;
+ return $dbglevel{$s};
}
1;
__END__