File Coverage

lib/CPAN/Debug.pm
Criterion Covered Total %
statement 15 22 68.2
branch 4 10 40.0
condition 0 3 0.0
subroutine 3 3 100.0
pod 0 1 0.0
total 22 39 56.4


line stmt bran cond sub pod time code
1             package CPAN::Debug;
2 6     6   92 use strict;
  6         178  
  6         90  
3 6     6   90 use vars qw($VERSION);
  6         125  
  6         86  
4              
5             $VERSION = sprintf "%.6f", substr(q$Rev: 844 $,4)/1000000 + 5.4;
6             # module is internal to CPAN.pm
7              
8             %CPAN::DEBUG = qw[
9             CPAN 1
10             Index 2
11             InfoObj 4
12             Author 8
13             Distribution 16
14             Bundle 32
15             Module 64
16             CacheMgr 128
17             Complete 256
18             FTP 512
19             Shell 1024
20             Eval 2048
21             HandleConfig 4096
22             Tarzip 8192
23             Version 16384
24             Queue 32768
25             FirstTime 65536
26             ];
27              
28             $CPAN::DEBUG ||= 0;
29              
30             #-> sub CPAN::Debug::debug ;
31             sub debug {
32 170     170 0 2869     my($self,$arg) = @_;
33 170         6283     my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
34             # Complete, caller(1)
35             # eg readline
36 170         3082     ($caller) = caller(0);
37 170         3713     $caller =~ s/.*:://;
38 170 50       2206     $arg = "" unless defined $arg;
39 170         2326     pop @rest while @rest > 5;
40 170 100       11786     my $rest = join ",", map { defined $_ ? $_ : "UNDEF" } @rest;
  15         273  
41 170 50       2923     if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
42 0 0 0               if ($arg and ref $arg) {
43 0                       eval { require Data::Dumper };
  0            
44 0 0                     if ($@) {
45 0                           $CPAN::Frontend->myprint($arg->as_string);
46                         } else {
47 0                           $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
48                         }
49                     } else {
50 0                       $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
51                     }
52                 }
53             }
54              
55             1;
56              
57             __END__
58             =head1 LICENSE
59            
60             This program is free software; you can redistribute it and/or
61             modify it under the same terms as Perl itself.
62            
63             =cut
64