vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/lib/LWP/Debug.pm

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