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 sub dbg
  29 {
  30         my $l = shift;
  31         if ($dbglevel{$l}) {
  32             my @in = @_;
  33                 my $t = time;
  34                 for (@in) {
  35                     s/\n$//o;
  36                         s/\a//og;   # beeps
  37                         print "$_\n" if defined \*STDOUT;
  38                         $fp->writeunix($t, "$t^$_");
  39                 }
  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         my $s = shift;
  69         return $dbglevel{$s};
  70 }
  71 1;
  72 __END__