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 22     22   159 use strict;
  22         106  
  22         1077  
4 22     22   127 use vars qw($VERSION);
  22         46  
  22         12952  
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 69     69 0 300 my($self,$arg) = @_;
34              
35 69         177 my @caller;
36 69         143 my $i = 0;
37 69         144 while () {
38 207 100       1907 my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
39 207 50       668 last unless defined $c[0];
40 207         422 push @caller, \@c;
41 207         465 for (0,3) {
42 414 100       931 last if $_ > $#c;
43 345         1747 $c[$_] =~ s/.*:://;
44             }
45 207         449 for (1) {
46 207         799 $c[$_] =~ s|.*/||;
47             }
48 207 100       581 last if ++$i>=3;
49             }
50 69         182 pop @caller;
51 69 50       834 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__