]> scm.dxcluster.org Git - spider.git/blob - perl/DXDebug.pm
removed ~ from the end of a PC18
[spider.git] / perl / DXDebug.pm
1 #
2 # The system variables - those indicated will need to be changed to suit your
3 # circumstances (and callsign)
4 #
5 # Copyright (c) 1998 - Dirk Koopman G1TLH
6 #
7 # $Id$
8 #
9
10 package DXDebug;
11
12 require Exporter;
13 @ISA = qw(Exporter);
14 @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
15 @EXPORT_OK = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose);
16
17 use strict;
18 use vars qw(%dbglevel $fp);
19
20 use DXUtil;
21 use DXLog ();
22 use Carp;
23
24 %dbglevel = ();
25 $fp = DXLog::new('debug', 'dat', 'd');
26
27 sub _store
28 {
29         my $t = time; 
30         for (@_) {
31                 $fp->writeunix($t, "$t^$_"); 
32                 print STDERR $_;
33         }
34 }
35
36 sub dbginit
37 {
38         # add sig{__DIE__} handling
39         if (!defined $DB::VERSION) {
40                 $SIG{__WARN__} = $SIG{__DIE__} = \&_store;
41         }
42 }
43
44 sub dbgclose
45 {
46         $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT';
47         $fp->close();
48 }
49
50 sub dbg
51 {
52         my $l = shift;
53         if ($dbglevel{$l}) {
54             my @in = @_;
55                 my $t = time;
56                 for (@in) {
57                     s/\n$//o;
58                         s/\a//og;   # beeps
59                         print "$_\n" if defined \*STDOUT;
60                         $fp->writeunix($t, "$t^$_");
61                 }
62         }
63 }
64
65 sub dbgadd
66
67         my $entry;
68         
69         foreach $entry (@_) {
70                 $dbglevel{$entry} = 1;
71         }
72 }
73
74 sub dbgsub
75 {
76         my $entry;
77         
78         foreach $entry (@_) {
79                 delete $dbglevel{$entry};
80         }
81 }
82
83 sub dbglist
84 {
85         return keys (%dbglevel);
86 }
87
88 sub isdbg
89 {
90         my $s = shift;
91         return $dbglevel{$s};
92 }
93 1;
94 __END__