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