home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / dumpvar.pl < prev    next >
Perl Script  |  1994-10-02  |  1KB  |  44 lines
  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;
  44.