diff options
author | Larry Wall <lwall@netlabs.com> | 1994-10-17 23:00:00 +0000 |
---|---|---|
committer | Larry Wall <lwall@netlabs.com> | 1994-10-17 23:00:00 +0000 |
commit | a0d0e21ea6ea90a22318550944fe6cb09ae10cda (patch) | |
tree | faca1018149b736b1142f487e44d1ff2de5cc1fa /lib/dumpvar.pl | |
parent | 85e6fe838fb25b257a1b363debf8691c0992ef71 (diff) | |
download | perl-a0d0e21ea6ea90a22318550944fe6cb09ae10cda.tar.gz |
perl 5.000perl-5.000
[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details. Andy notes that;
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge
backup tapes from that era seem to be readable anymore. I guess 13 years
exceeds the shelf life for that backup technology :-(.
]
Diffstat (limited to 'lib/dumpvar.pl')
-rw-r--r-- | lib/dumpvar.pl | 12 |
1 files changed, 9 insertions, 3 deletions
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl index 03dbbcd8fe..4ebcb5203d 100644 --- a/lib/dumpvar.pl +++ b/lib/dumpvar.pl @@ -3,18 +3,23 @@ package dumpvar; # translate control chars to ^X - Randal Schwartz sub unctrl { local($_) = @_; + return \$_ if ref \$_ eq "GLOB"; s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg; $_; } sub main'dumpvar { ($package,@vars) = @_; - local(*stab) = *{"::_$package"}; + $package .= "::" unless $package =~ /::$/; + *stab = *{"main::"}; + while ($package =~ /(\w+?::)/g){ + *stab = ${stab}{$1}; + } while (($key,$val) = each(%stab)) { { next if @vars && !grep($key eq $_,@vars); local(*entry) = $val; if (defined $entry) { - print "\$$key = '",&unctrl($entry),"'\n"; + print "\$",&unctrl($key)," = '",&unctrl($entry),"'\n"; } if (defined @entry) { print "\@$key = (\n"; @@ -23,7 +28,8 @@ sub main'dumpvar { } print ")\n"; } - if ($key ne "_$package" && $key ne "_DB" && defined %entry) { + if ($key ne "main::" && $key ne "DB::" && defined %entry + && !($package eq "dumpvar" and $key eq "stab")) { print "\%$key = (\n"; foreach $key (sort keys(%entry)) { print " $key\t'",&unctrl($entry{$key}),"'\n"; |