Commit | Line | Data |
a687059c |
1 | package dumpvar; |
2 | |
154e51a4 |
3 | # translate control chars to ^X - Randal Schwartz |
4 | sub unctrl { |
5 | local($_) = @_; |
a0d0e21e |
6 | return \$_ if ref \$_ eq "GLOB"; |
154e51a4 |
7 | s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg; |
8 | $_; |
9 | } |
a687059c |
10 | sub main'dumpvar { |
154e51a4 |
11 | ($package,@vars) = @_; |
a0d0e21e |
12 | $package .= "::" unless $package =~ /::$/; |
13 | *stab = *{"main::"}; |
14 | while ($package =~ /(\w+?::)/g){ |
15 | *stab = ${stab}{$1}; |
16 | } |
a687059c |
17 | while (($key,$val) = each(%stab)) { |
18 | { |
154e51a4 |
19 | next if @vars && !grep($key eq $_,@vars); |
a687059c |
20 | local(*entry) = $val; |
21 | if (defined $entry) { |
a0d0e21e |
22 | print "\$",&unctrl($key)," = '",&unctrl($entry),"'\n"; |
a687059c |
23 | } |
24 | if (defined @entry) { |
25 | print "\@$key = (\n"; |
26 | foreach $num ($[ .. $#entry) { |
154e51a4 |
27 | print " $num\t'",&unctrl($entry[$num]),"'\n"; |
a687059c |
28 | } |
29 | print ")\n"; |
30 | } |
a0d0e21e |
31 | if ($key ne "main::" && $key ne "DB::" && defined %entry |
32 | && !($package eq "dumpvar" and $key eq "stab")) { |
a687059c |
33 | print "\%$key = (\n"; |
34 | foreach $key (sort keys(%entry)) { |
154e51a4 |
35 | print " $key\t'",&unctrl($entry{$key}),"'\n"; |
a687059c |
36 | } |
37 | print ")\n"; |
38 | } |
39 | } |
40 | } |
41 | } |
63f2c1e1 |
42 | |
43 | 1; |