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