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