]> scm.dxcluster.org Git - spider.git/blob - perl/DXDebug.pm
added ping and rcmd commands
[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(dbg dbgadd dbgsub dbglist isdbg);
15 @EXPORT_OK = qw(dbg dbgadd dbgsub dbglist isdbg);
16
17 use strict;
18 use vars qw(%dbglevel $fp);
19
20 use FileHandle;
21 use DXUtil;
22 use DXLog ();
23 use Carp;
24
25 %dbglevel = ();
26 $fp = DXLog::new('debug', 'dat', 'd');
27
28 no strict 'refs';
29
30 sub dbg
31 {
32         my $l = shift;
33         if ($dbglevel{$l}) {
34                 for (@_) {
35                         s/\n$//og;
36                 }
37                 print "@_\n" if defined \*STDOUT;
38                 my $t = time;
39                 $fp->writeunix($t, "$t^@_");
40         }
41 }
42
43 sub dbgadd
44
45         my $entry;
46         
47         foreach $entry (@_) {
48                 $dbglevel{$entry} = 1;
49         }
50 }
51
52 sub dbgsub
53 {
54         my $entry;
55         
56         foreach $entry (@_) {
57                 delete $dbglevel{entry};
58         }
59 }
60
61 sub dbglist
62 {
63         return keys (%dbglevel);
64 }
65
66 sub isdbg
67 {
68         return $dbglevel{shift};
69 }
70 1;
71 __END__