Upgrade to CPAN-1.88_52

p4raw-id: //depot/perl@28920

1 files changed, 26 insertions, 11 deletions

diff --git a/lib/CPAN/Debug.pm b/lib/CPAN/Debug.pm
index 211cac7d1c..239fb6b0ea 100644
--- a/lib/CPAN/Debug.pm
+++ b/lib/CPAN/Debug.pm
@@ -1,8 +1,9 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN::Debug;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4;
+$VERSION = sprintf "%.6f", substr(q$Rev: 955 $,4)/1000000 + 5.4;
 # module is internal to CPAN.pm
 
 %CPAN::DEBUG = qw[
@@ -30,15 +31,24 @@ $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;
-    pop @rest while @rest > 5;
-    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 ($@) {
@@ -47,7 +57,12 @@ sub debug {
                 $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");
         }
     }
 }