blob: 4ebcb5203df1e4fa17f1aed58fdf9d01dd63e73b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
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) = @_;
$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 "\$",&unctrl($key)," = '",&unctrl($entry),"'\n";
}
if (defined @entry) {
print "\@$key = (\n";
foreach $num ($[ .. $#entry) {
print " $num\t'",&unctrl($entry[$num]),"'\n";
}
print ")\n";
}
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";
}
print ")\n";
}
}
}
}
1;
|
