1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2package CPAN::Debug;
3use strict;
4use 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 ;
32sub 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
701;
71
72__END__
73
74=head1 NAME
75
76CPAN::Debug - internal debugging for CPAN.pm
77
78=head1 LICENSE
79
80This program is free software; you can redistribute it and/or
81modify it under the same terms as Perl itself.
82
83=cut
84