Commit | Line | Data |
---|---|---|
7d97ad34 | 1 | # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- |
e82b9348 SP |
2 | package CPAN::Debug; |
3 | use strict; | |
4 | use vars qw($VERSION); | |
5 | ||
547d3dfd | 6 | $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4; |
e82b9348 SP |
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 | |
c9869e1c | 26 | FirstTime 65536 |
e82b9348 SP |
27 | ]; |
28 | ||
29 | $CPAN::DEBUG ||= 0; | |
30 | ||
31 | #-> sub CPAN::Debug::debug ; | |
32 | sub debug { | |
33 | my($self,$arg) = @_; | |
7d97ad34 SP |
34 | |
35 | my @caller; | |
36 | my $i = 0; | |
37 | while () { | |
38 | my(@c) = (caller($i))[0 .. ($i ? 3 : 2)]; | |
39 | last unless defined $c[0]; | |
40 | push @caller, \@c; | |
41 | for (0,3) { | |
42 | last if $_ > $#c; | |
43 | $c[$_] =~ s/.*:://; | |
44 | } | |
45 | for (1) { | |
46 | $c[$_] =~ s|.*/||; | |
47 | } | |
48 | last if ++$i>=3; | |
49 | } | |
50 | pop @caller; | |
547d3dfd | 51 | if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) { |
e82b9348 SP |
52 | if ($arg and ref $arg) { |
53 | eval { require Data::Dumper }; | |
54 | if ($@) { | |
55 | $CPAN::Frontend->myprint($arg->as_string); | |
56 | } else { | |
57 | $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg)); | |
58 | } | |
59 | } else { | |
7d97ad34 SP |
60 | my $outer = ""; |
61 | local $" = ","; | |
62 | if (@caller>1) { | |
63 | $outer = ",[@{$caller[1]}]"; | |
64 | } | |
65 | $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n"); | |
e82b9348 SP |
66 | } |
67 | } | |
68 | } | |
69 | ||
70 | 1; | |
26844e27 SP |
71 | |
72 | __END__ | |
135a59c2 | 73 | |
26844e27 SP |
74 | =head1 LICENSE |
75 | ||
76 | This program is free software; you can redistribute it and/or | |
77 | modify it under the same terms as Perl itself. | |
78 | ||
79 | =cut |