Commit | Line | Data |
---|---|---|
9f9a456c C |
1 | package dumpvar; |
2 | ||
3 | # translate control chars to ^X - Randal Schwartz | |
4 | sub unctrl { | |
5 | local($_) = @_; | |
6 | s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg; | |
7 | $_; | |
8 | } | |
9 | sub main'dumpvar { | |
10 | ($package,@vars) = @_; | |
11 | local(*stab) = eval("*_$package"); | |
12 | while (($key,$val) = each(%stab)) { | |
13 | { | |
14 | next if @vars && !grep($key eq $_,@vars); | |
15 | local(*entry) = $val; | |
16 | if (defined $entry) { | |
17 | print "\$$key = '",&unctrl($entry),"'\n"; | |
18 | } | |
19 | if (defined @entry) { | |
20 | print "\@$key = (\n"; | |
21 | foreach $num ($[ .. $#entry) { | |
22 | print " $num\t'",&unctrl($entry[$num]),"'\n"; | |
23 | } | |
24 | print ")\n"; | |
25 | } | |
26 | if ($key ne "_$package" && $key ne "_DB" && defined %entry) { | |
27 | print "\%$key = (\n"; | |
28 | foreach $key (sort keys(%entry)) { | |
29 | print " $key\t'",&unctrl($entry{$key}),"'\n"; | |
30 | } | |
31 | print ")\n"; | |
32 | } | |
33 | } | |
34 | } | |
35 | } | |
36 | ||
37 | 1; |