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);
  15
  16 use strict;
  17 use vars qw(%dbglevel $dbgfh);
  18
  19 use FileHandle;
  20 use DXUtil;
  21
  22 %dbglevel = ();
  23 $dbgfh = "";
  24
  25 no strict 'refs';
  26
  27 sub dbginit
  28 {
  29   my $fhname = shift;
  30   $dbgfh = new FileHandle;
  31   $dbgfh->open(">>$fhname") or die "can't open debug file '$fhname' $!";
  32   $dbgfh->autoflush(1);
  33 }
  34
  35 sub dbg
  36 {
  37   my $l = shift;
  38   if ($dbglevel{$l}) {
  39     print @_;
  40         print $dbgfh atime, @_ if $dbgfh;
  41   }
  42 }
  43
  44 sub dbgadd
  45 {
  46   my $entry;
  47
  48   foreach $entry (@_) {
  49     $dbglevel{$entry} = 1;
  50   }
  51 }
  52
  53 sub dbgsub
  54 {
  55   my $entry;
  56
  57   foreach $entry (@_) {
  58     delete $dbglevel{entry};
  59   }
  60 }
  61
  62 sub dbglist
  63 {
  64   return keys (%dbglevel);
  65 }
  66
  67 sub isdbg
  68 {
  69   return $dbglevel{shift};
  70 }
  71 1;
  72 __END__