You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
129 lines
3.2 KiB
129 lines
3.2 KiB
#!/usr/local/bin/perl -w
|
|
#
|
|
# $Id: Debug.pm,v 1.12 1997/12/02 13:22:52 aas Exp $
|
|
#
|
|
package LWP::Debug;
|
|
|
|
=head1 NAME
|
|
|
|
LWP::Debug - debug routines for the libwww-perl library
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use LWP::Debug qw(+ -conns);
|
|
|
|
# Used internally in the library
|
|
LWP::Debug::trace('send()');
|
|
LWP::Debug::debug('url ok');
|
|
LWP::Debug::conns("read $n bytes: $data");
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
LWP::Debug provides tracing facilities. The trace(), debug() and
|
|
conns() function are called within the library and they log
|
|
information at increasing levels of detail. Which level of detail is
|
|
actually printed is controlled with the C<level()> function.
|
|
|
|
The following functions are available:
|
|
|
|
=over 4
|
|
|
|
=item level(...)
|
|
|
|
The C<level()> function controls the level of detail being
|
|
logged. Passing '+' or '-' indicates full and no logging
|
|
respectively. Inidividual levels can switched on and of by passing the
|
|
name of the level with a '+' or '-' prepended. The levels are:
|
|
|
|
trace : trace function calls
|
|
debug : print debug messages
|
|
conns : show all data transfered over the connections
|
|
|
|
The LWP::Debug module provide a special import() method that allows
|
|
you to pass the level() arguments with initial use statement. If a
|
|
use argument start with '+' or '-' then it is passed to the level
|
|
function, else the name is exported as usual. The following two
|
|
statements are thus equivalent (if you ignore that the second pollutes
|
|
your namespace):
|
|
|
|
use LWP::Debug qw(+);
|
|
use LWP::Debug qw(level); level('+');
|
|
|
|
=item trace($msg)
|
|
|
|
The C<trace()> function is used for tracing function
|
|
calls. The package and calling subroutine name is
|
|
printed along with the passed argument. This should
|
|
be called at the start of every major function.
|
|
|
|
=item debug($msg)
|
|
|
|
The C<debug()> function is used for high-granularity
|
|
reporting of state in functions.
|
|
|
|
=item conns($msg)
|
|
|
|
The C<conns()> function is used to show data being
|
|
transferred over the connections. This may generate
|
|
considerable output.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
require Exporter;
|
|
@ISA = qw(Exporter);
|
|
@EXPORT_OK = qw(level trace debug conns);
|
|
|
|
use Carp ();
|
|
|
|
my @levels = qw(trace debug conns);
|
|
%current_level = ();
|
|
|
|
sub import
|
|
{
|
|
my $pack = shift;
|
|
my $callpkg = caller(0);
|
|
my @symbols = ();
|
|
my @levels = ();
|
|
for (@_) {
|
|
if (/^[-+]/) {
|
|
push(@levels, $_);
|
|
} else {
|
|
push(@symbols, $_);
|
|
}
|
|
}
|
|
Exporter::export($pack, $callpkg, @symbols);
|
|
level(@levels);
|
|
}
|
|
|
|
sub level
|
|
{
|
|
for (@_) {
|
|
if ($_ eq '+') { # all on
|
|
# switch on all levels
|
|
%current_level = map { $_ => 1 } @levels;
|
|
} elsif ($_ eq '-') { # all off
|
|
%current_level = ();
|
|
} elsif (/^([-+])(\w+)$/) {
|
|
$current_level{$2} = $1 eq '+';
|
|
} else {
|
|
Carp::croak("Illegal level format $_");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub trace { _log(@_) if $current_level{'trace'}; }
|
|
sub debug { _log(@_) if $current_level{'debug'}; }
|
|
sub conns { _log(@_) if $current_level{'conns'}; }
|
|
|
|
sub _log
|
|
{
|
|
my $msg = shift;
|
|
$msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
|
|
|
|
my($package,$filename,$line,$sub) = caller(2);
|
|
print STDERR "$sub: $msg";
|
|
}
|
|
|
|
1;
|