File Coverage

blib/lib/CPAN/Debug.pm
Criterion Covered Total %
statement 21 34 61.7
branch 8 16 50.0
condition 0 3 0.0
subroutine 3 3 100.0
pod 0 1 0.0
total 32 57 56.1


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             package CPAN::Debug;
3 13     13   86 use strict;
  13         25  
  13         502  
4 13     13   72 use vars qw($VERSION);
  13         34  
  13         6508  
5              
6             $VERSION = "5.5001";
7             # module is internal to CPAN.pm
8              
9             %CPAN::DEBUG = qw[
10             CPAN 1
11             Index 2
12             InfoObj 4
13             Author 8
14             Distribution 16
15             Bundle 32
16             Module 64
17             CacheMgr 128
18             Complete 256
19             FTP 512
20             Shell 1024
21             Eval 2048
22             HandleConfig 4096
23             Tarzip 8192
24             Version 16384
25             Queue 32768
26             FirstTime 65536
27             ];
28              
29             $CPAN::DEBUG ||= 0;
30              
31             #-> sub CPAN::Debug::debug ;
32             sub debug {
33 6     6 0 19 my($self,$arg) = @_;
34              
35 6         10 my @caller;
36 6         12 my $i = 0;
37 6         7 while () {
38 18 100       125 my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
39 18 50       48 last unless defined $c[0];
40 18         26 push @caller, \@c;
41 18         33 for (0,3) {
42 36 100       71 last if $_ > $#c;
43 30         129 $c[$_] =~ s/.*:://;
44             }
45 18         33 for (1) {
46 18         59 $c[$_] =~ s|.*/||;
47             }
48 18 100       46 last if ++$i>=3;
49             }
50 6         9 pop @caller;
51 6 50       42 if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) {
52 0 0 0       if ($arg and ref $arg) {
53 0           eval { require Data::Dumper };
  0            
54 0 0         if ($@) {
55 0           $CPAN::Frontend->myprint("Debug(\n" . $arg->as_string . ")\n");
56             } else {
57 0           $CPAN::Frontend->myprint("Debug(\n" . Data::Dumper::Dumper($arg) . ")\n");
58             }
59             } else {
60 0           my $outer = "";
61 0           local $" = ",";
62 0 0         if (@caller>1) {
63 0           $outer = ",[@{$caller[1]}]";
  0            
64             }
65 0           $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n");
  0            
66             }
67             }
68             }
69              
70             1;
71              
72             __END__