This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.002beta2 patch: lib/Term/ReadLine.pm
[perl5.git] / lib / dumpvar.pl
CommitLineData
a687059c
LW
1package dumpvar;
2
154e51a4
LW
3# translate control chars to ^X - Randal Schwartz
4sub unctrl {
5 local($_) = @_;
a0d0e21e 6 return \$_ if ref \$_ eq "GLOB";
154e51a4
LW
7 s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
8 $_;
9}
a687059c 10sub main'dumpvar {
154e51a4 11 ($package,@vars) = @_;
a0d0e21e
LW
12 $package .= "::" unless $package =~ /::$/;
13 *stab = *{"main::"};
14 while ($package =~ /(\w+?::)/g){
15 *stab = ${stab}{$1};
16 }
a687059c
LW
17 while (($key,$val) = each(%stab)) {
18 {
154e51a4 19 next if @vars && !grep($key eq $_,@vars);
a687059c
LW
20 local(*entry) = $val;
21 if (defined $entry) {
a0d0e21e 22 print "\$",&unctrl($key)," = '",&unctrl($entry),"'\n";
a687059c
LW
23 }
24 if (defined @entry) {
25 print "\@$key = (\n";
26 foreach $num ($[ .. $#entry) {
154e51a4 27 print " $num\t'",&unctrl($entry[$num]),"'\n";
a687059c
LW
28 }
29 print ")\n";
30 }
a0d0e21e
LW
31 if ($key ne "main::" && $key ne "DB::" && defined %entry
32 && !($package eq "dumpvar" and $key eq "stab")) {
a687059c
LW
33 print "\%$key = (\n";
34 foreach $key (sort keys(%entry)) {
154e51a4 35 print " $key\t'",&unctrl($entry{$key}),"'\n";
a687059c
LW
36 }
37 print ")\n";
38 }
39 }
40 }
41}
63f2c1e1
LW
42
431;