src/Modules/DumpVars.pl

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