X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fdumpvar.pl;h=f473c45bd3fbd12d6e406db93d0b40227a2043c5;hb=f1612b5c9ea43d9872ae3595ce140e5a62ae6cf4;hp=c32bc2fb5e1f453f5952f2ef02454fedaab9fdb2;hpb=74b5f52c9579e21851cb5b0b04ee78401a947eb0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index c32bc2f..f473c45 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -22,6 +22,8 @@ $printUndef = 1 unless defined $printUndef;
 $tick = "auto" unless defined $tick;
 $unctrl = 'quote' unless defined $unctrl;
 $subdump = 1;
+$dumpReused = 0 unless defined $dumpReused;
+$bareStringify = 1 unless defined $bareStringify;
 
 sub main::dumpValue {
   local %address;
@@ -49,6 +51,10 @@ sub stringify {
 
 	return 'undef' unless defined $_ or not $printUndef;
 	return $_ . "" if ref \$_ eq 'GLOB';
+	$_ = &{'overload::StrVal'}($_) 
+	  if $bareStringify and ref $_ 
+	    and %overload:: and defined &{'overload::StrVal'};
+	
 	if ($tick eq 'auto') {
 	  if (/[\000-\011\013-\037\177]/) {
 	    $tick = '"';
@@ -109,7 +115,7 @@ sub unwrap {
     return if $DB::signal;
     local($v) = shift ; 
     local($s) = shift ; # extra no of spaces
-    local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ;
+    local(%v,@v,$sp,$value,$key,@sortKeys,$more,$shortmore,$short) ;
     local($tHashDepth,$tArrayDepth) ;
 
     $sp = " " x $s ;
@@ -117,9 +123,11 @@ sub unwrap {
 
     # Check for reused addresses
     if (ref $v) { 
-      ($address) = $v =~ /(0x[0-9a-f]+)\)$/ ; 
-      if (defined $address) { 
-	($type) = $v =~ /=(.*?)\([^=]+$/ ;
+      my $val = $v;
+      $val = &{'overload::StrVal'}($v) 
+	if %overload:: and defined &{'overload::StrVal'};
+      ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ; 
+      if (!$dumpReused && defined $address) { 
 	$address{$address}++ ;
 	if ( $address{$address} > 1 ) { 
 	  print "${sp}-> REUSED_ADDRESS\n" ; 
@@ -135,6 +143,13 @@ sub unwrap {
       } 
     }
 
+    if (ref $v eq 'Regexp') {
+      my $re = "$v";
+      $re =~ s,/,\\/,g;
+      print "$sp-> qr/$re/\n";
+      return;
+    }
+
     if ( UNIVERSAL::isa($v, 'HASH') ) { 
 	@sortKeys = sort keys(%$v) ;
 	undef $more ; 
@@ -274,12 +289,12 @@ sub dumpglob {
       print( (' ' x $off) . "\$", &unctrl($key), " = " );
       DumpElem $entry, 3+$off;
     }
-    if (($key !~ /^_</ or $dumpDBFiles) and defined @entry) {
+    if (($key !~ /^_</ or $dumpDBFiles) and @entry) {
       print( (' ' x $off) . "\@$key = (\n" );
       unwrap(\@entry,3+$off) ;
       print( (' ' x $off) .  ")\n" );
     }
-    if ($key ne "main::" && $key ne "DB::" && defined %entry
+    if ($key ne "main::" && $key ne "DB::" && %entry
 	&& ($dumpPackages or $key !~ /::$/)
 	&& ($key !~ /^_</ or $dumpDBFiles)
 	&& !($package eq "dumpvar" and $key eq "stab")) {
@@ -308,7 +323,7 @@ sub dumpsub {
 }
 
 sub findsubs {
-  return undef unless defined %DB::sub;
+  return undef unless %DB::sub;
   my ($addr, $name, $loc);
   while (($name, $loc) = each %DB::sub) {
     $addr = \&$name;
@@ -380,8 +395,8 @@ sub globUsage {			# glob ref, name
   local *name = *{$_[0]};
   $total = 0;
   $total += scalarUsage $name if defined $name;
-  $total += arrayUsage \@name, $_[1] if defined @name;
-  $total += hashUsage \%name, $_[1] if defined %name and $_[1] ne "main::" 
+  $total += arrayUsage \@name, $_[1] if @name;
+  $total += hashUsage \%name, $_[1] if %name and $_[1] ne "main::" 
     and $_[1] ne "DB::";   #and !($package eq "dumpvar" and $key eq "stab"));
   $total;
 }