File Coverage

blib/lib/HTTP/OAI/Debug.pm

Criterion	Covered	Total	%
statement	13	29	44.8
branch	2	16	12.5
condition			n/a
subroutine	5	8	62.5
pod	0	5	0.0
total	20	58	34.4

package HTTP::OAI::Debug;

=pod

=head1 NAME

B - debug the HTTP::OAI libraries

=head1 DESCRIPTION

This package is a copy of L and exposes the same API. In addition to "trace", "debug" and "conns" this exposes a "sax" level for debugging SAX events.

=cut

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(level trace debug conns);

our $VERSION = '4.13';

use Carp ();

my @levels = qw(trace debug conns sax);
%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 sax    { _log(@_) if $current_level{'sax'}; }


sub _log
{
    my $msg = shift;
	$msg =~ s/\n$//;
	$msg =~ s/\n/\\n/g;

    my($package,$filename,$line,$sub) = caller(2);
    print STDERR "$sub: $msg\n";
}

1;