This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade CPAN from 1.94_55 to 1.94_56
[perl5.git] / cpan / CPAN / lib / CPAN / Debug.pm
1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 package CPAN::Debug;
3 use strict;
4 use vars qw($VERSION);
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     my($self,$arg) = @_;
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) {
52         if ($arg and ref $arg) {
53             eval { require Data::Dumper };
54             if ($@) {
55                 $CPAN::Frontend->myprint("Debug(\n" . $arg->as_string . ")\n");
56             } else {
57                 $CPAN::Frontend->myprint("Debug(\n" . Data::Dumper::Dumper($arg) . ")\n");
58             }
59         } else {
60             my $outer = "";
61             local $" = ",";
62             if (@caller>1) {
63                 $outer = ",[@{$caller[1]}]";
64             }
65             $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n");
66         }
67     }
68 }
69
70 1;
71
72 __END__
73
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