home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / LWP / Debug.pm next >
Text File  |  1996-04-09  |  3KB  |  126 lines
  1. #!/usr/local/bin/perl -w
  2. #
  3. # $Id: Debug.pm,v 1.11 1996/04/09 15:44:25 aas Exp $
  4. #
  5. package LWP::Debug;
  6.  
  7. =head1 NAME
  8.  
  9. LWP::Debug - debug routines for the libwww-perl library
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.  use LWP::Debug qw(+ -conns);
  14.  
  15.  # Used internally in the library
  16.  LWP::Debug::trace('send()');
  17.  LWP::Debug::debug('url ok');
  18.  LWP::Debug::conns("read $n bytes: $data");
  19.  
  20. =head1 DESCRIPTION
  21.  
  22. LWP::Debug provides tracing facilities. The trace(), debug() and
  23. conns() function are called within the library and they log
  24. information at increasing levels of detail. Which level of detail is
  25. actually printed is controlled with the C<level()> function.
  26.  
  27. =head1 FUNCTIONS
  28.  
  29. =head2 level(...)
  30.  
  31. The C<level()> function controls the level of detail being
  32. logged. Passing '+' or '-' indicates full and no logging
  33. respectively. Inidividual levels can switched on and of by passing the
  34. name of the level with a '+' or '-' prepended.  The levels are:
  35.  
  36.   trace   : trace function calls
  37.   debug   : print debug messages
  38.   conns   : show all data transfered over the connections
  39.  
  40. The LWP::Debug module provide a special import() method that allows
  41. you to pass the level() arguments with initial use statement.  If a
  42. use argument start with '+' or '-' then it is passed to the level
  43. function, else the name is exported as usual.  The following two
  44. statements are thus equivalent (if you ignore that the second pollutes
  45. your namespace):
  46.  
  47.   use LWP::Debug qw(+);
  48.   use LWP::Debug qw(level); level('+');
  49.  
  50. =head2 trace($msg)
  51.  
  52. The C<trace()> function is used for tracing function
  53. calls. The package and calling subroutine name is
  54. printed along with the passed argument. This should
  55. be called at the start of every major function.
  56.  
  57. =head2 debug($msg)
  58.  
  59. The C<debug()> function is used for high-granularity
  60. reporting of state in functions.
  61.  
  62. =head2 conns($msg)
  63.  
  64. The C<conns()> function is used to show data being
  65. transferred over the connections. This may generate
  66. considerable output.
  67.  
  68. =cut
  69.  
  70. require Exporter;
  71. @ISA = qw(Exporter);
  72. @EXPORT_OK = qw(level trace debug conns);
  73.  
  74. use Carp ();
  75.  
  76. my @levels = qw(trace debug conns);
  77. %current_level = ();
  78.  
  79. sub import
  80. {
  81.     my $pack = shift;
  82.     my $callpkg = caller(0);
  83.     my @symbols = ();
  84.     my @levels = ();
  85.     for (@_) {
  86.     if (/^[-+]/) {
  87.         push(@levels, $_);
  88.     } else {
  89.         push(@symbols, $_);
  90.     }
  91.     }
  92.     Exporter::export($pack, $callpkg, @symbols);
  93.     level(@levels);
  94. }
  95.  
  96. sub level
  97. {
  98.     for (@_) {
  99.     if ($_ eq '+') {              # all on
  100.         # switch on all levels
  101.         %current_level = map { $_ => 1 } @levels;
  102.     } elsif ($_ eq '-') {           # all off
  103.         %current_level = ();
  104.     } elsif (/^([-+])(\w+)$/) {
  105.         $current_level{$2} = $1 eq '+';
  106.     } else {
  107.         Carp::croak("Illegal level format $_");
  108.     }
  109.     }
  110. }
  111.  
  112. sub trace  { _log(@_) if $current_level{'trace'}; }
  113. sub debug  { _log(@_) if $current_level{'debug'}; }
  114. sub conns  { _log(@_) if $current_level{'conns'}; }
  115.  
  116. sub _log
  117. {
  118.     my $msg = shift;
  119.     $msg .= "\n" unless $msg =~ /\n$/;  # ensure trailing "\n"
  120.  
  121.     my($package,$filename,$line,$sub) = caller(2);
  122.     print STDERR "$sub: $msg";
  123. }
  124.  
  125. 1;
  126.