Commit | Line | Data |
7d97ad34 |
1 | # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- |
e82b9348 |
2 | package CPAN::Debug; |
3 | use strict; |
4 | use vars qw($VERSION); |
5 | |
7d97ad34 |
6 | $VERSION = sprintf "%.6f", substr(q$Rev: 955 $,4)/1000000 + 5.4; |
e82b9348 |
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 |
27 | ]; |
28 | |
29 | $CPAN::DEBUG ||= 0; |
30 | |
31 | #-> sub CPAN::Debug::debug ; |
32 | sub debug { |
33 | my($self,$arg) = @_; |
7d97ad34 |
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; |
51 | if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG){ |
e82b9348 |
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 |
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 |
66 | } |
67 | } |
68 | } |
69 | |
70 | 1; |
26844e27 |
71 | |
72 | __END__ |
135a59c2 |
73 | |
26844e27 |
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 |