src/Modules/DumpVars.pl

   1 #
   2 #  DumpVars.pl: Perl variables dumper.
   3 #   Maintained: dms
   4 #      Version: v0.1 (20000114)
   5 #      Created: 20000114
   6 #         NOTE: Ripped from ActivePerl "asp sample" example.
   7 #
   8
   9 # FIXME
  10 #use strict;
  11
  12 #use vars qw();
  13
  14 my $countlines = 0;
  15
  16 sub dumpvarslog {
  17     my ($line) = @_;
  18     if (&IsParam('dumpvarsLogFile')) {
  19         print DUMPVARS $line."\n";
  20     } else {
  21         &status("DV: ".$line);
  22     }
  23 }
  24
  25 sub DumpNames(\%$) {
  26     my ($package,$packname) =  @_;
  27     my $symname = 0;
  28     my $line;
  29
  30     if ($packname eq 'main::') {
  31         &dumpvarslog('Packages');
  32
  33         foreach $symname (sort keys %$package) {
  34             local *sym = $$package{$symname};
  35             next unless (defined %sym);
  36             next unless ($symname =~/::/);
  37             &dumpvarslog("   $symname");
  38             $countlines++;
  39         }
  40     }
  41
  42     # Scalars.
  43     foreach $symname (sort keys %$package) {
  44         local *sym = $$package{$symname};
  45         next unless (defined $sym);
  46
  47         my $line;
  48         if (length($sym) > 512) {
  49             &dumpvarslog("Scalar '$packname' $symname too long.");
  50         } else {
  51             &dumpvarslog("Scalar '$packname' \$ $symname => '$sym'");
  52         }
  53         $countlines++;
  54     }
  55
  56     # Functions.
  57     foreach $symname (sort keys %$package) {
  58         local *sym = $$package{$symname};
  59         next unless (defined &sym);
  60
  61         &dumpvarslog("Function '$packname' $symname()");
  62         $countlines++;
  63     }
  64
  65     # Lists.
  66     foreach $symname (sort keys %$package) {
  67         local *sym = $$package{$symname};
  68         next unless (defined @sym);
  69
  70         &dumpvarslog("List '$packname' \@$symname (". scalar(@{$symname}) .")");
  71         $countlines++;
  72
  73         next unless ($packname eq 'main::');
  74         foreach (@{$symname}) {
  75             if (defined $_) {
  76                 &dumpvarslog("   => '$_'.");
  77             } else {
  78                 &dumpvarslog("   => <NULL>.");
  79             }
  80         }
  81     }
  82
  83     # Hashes.
  84     foreach $symname (sort keys %$package) {
  85         local *sym = $$package{$symname};
  86         next unless (defined %sym);
  87         next if ($symname =~/::/);
  88
  89         &dumpvarslog("Hash '$packname' \%$symname");
  90         $countlines++;
  91
  92         next unless ($packname eq 'main::');
  93         foreach (keys %{$symname}) {
  94             my $val = ${$symname}{$_};
  95             if (defined $val) {
  96                 &dumpvarslog("   $_ => '$val'.");
  97             } else {
  98                 &dumpvarslog("   $_ => <NULL>.");
  99             }
 100         }
 101     }
 102
 103     return unless ($packname eq 'main::');
 104
 105     foreach $symname (sort keys %$package) {
 106         local *sym = $$package{$symname};
 107         next unless (defined %sym);
 108         next unless ($symname =~/::/);
 109         next if ($symname eq 'main::');
 110
 111         DumpNames(\%sym,$symname)
 112     }
 113 }
 114
 115 sub dumpallvars {
 116     if (&IsParam('dumpvarsLogFile')) {
 117         my $file = $param{'dumpvarsLogFile'};
 118         &status("opening fh to dumpvars ($file)");
 119         if (!open(DUMPVARS,">$file")) {
 120             &ERROR("cannot open dumpvars.");
 121             return;
 122         }
 123     }
 124
 125     DumpNames(%main::,'main::');
 126
 127     if (&IsParam('dumpvarsLogFile')) {
 128         &status("closing fh to dumpvars");
 129         close DUMPVARS;
 130     }
 131
 132     &status("DV: count == $countlines");
 133 }
 134
 135 1;
 136
 137 # vim:ts=4:sw=4:expandtab:tw=80