+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN::Debug;
use strict;
use vars qw($VERSION);
-$VERSION = sprintf "%.2f", substr(q$Rev: 286 $,4)/100;
+$VERSION = sprintf "%.6f", substr(q$Rev: 955 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm
%CPAN::DEBUG = qw[
Tarzip 8192
Version 16384
Queue 32768
+ FirstTime 65536
];
$CPAN::DEBUG ||= 0;
#-> sub CPAN::Debug::debug ;
sub debug {
my($self,$arg) = @_;
- my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
- # Complete, caller(1)
- # eg readline
- ($caller) = caller(0);
- $caller =~ s/.*:://;
- $arg = "" unless defined $arg;
- my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
- if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
+
+ my @caller;
+ my $i = 0;
+ while () {
+ my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
+ last unless defined $c[0];
+ push @caller, \@c;
+ for (0,3) {
+ last if $_ > $#c;
+ $c[$_] =~ s/.*:://;
+ }
+ for (1) {
+ $c[$_] =~ s|.*/||;
+ }
+ last if ++$i>=3;
+ }
+ pop @caller;
+ if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG){
if ($arg and ref $arg) {
eval { require Data::Dumper };
if ($@) {
$CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
}
} else {
- $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
+ my $outer = "";
+ local $" = ",";
+ if (@caller>1) {
+ $outer = ",[@{$caller[1]}]";
+ }
+ $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n");
}
}
}
1;
+
+__END__
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut