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;