PageRenderTime 33ms CodeModel.GetById 11ms app.highlight 18ms RepoModel.GetById 1ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/site/lib/LWP/Debug.pm

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