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   83 use strict;
  13         24  
  13         551  
4 13     13   74 use vars qw($VERSION);
  13         25  
  13         7060  
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 16 my($self,$arg) = @_;
34              
35 6         11 my @caller;
36 6         9 my $i = 0;
37 6         8 while () {
38 18 100       122 my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
39 18 50       48 last unless defined $c[0];
40 18         28 push @caller, \@c;
41 18         34 for (0,3) {
42 36 100       68 last if $_ > $#c;
43 30         138 $c[$_] =~ s/.*:://;
44             }
45 18         32 for (1) {
46 18         78 $c[$_] =~ s|.*/||;
47             }
48 18 100       49 last if ++$i>=3;
49             }
50 6         11 pop @caller;
51 6 50       37 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__