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