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     }
  21     else {
  22         &status( "DV: " . $line );
  23     }
  24 }
  25
  26 sub DumpNames(\%$) {
  27     my ( $package, $packname ) = @_;
  28     my $symname = 0;
  29     my $line;
  30
  31     if ( $packname eq 'main::' ) {
  32         &dumpvarslog('Packages');
  33
  34         foreach $symname ( sort keys %$package ) {
  35             local *sym = $$package{$symname};
  36             next unless ( %sym );
  37             next unless ( $symname =~ /::/ );
  38             &dumpvarslog("   $symname");
  39             $countlines++;
  40         }
  41     }
  42
  43     # Scalars.
  44     foreach $symname ( sort keys %$package ) {
  45         local *sym = $$package{$symname};
  46         next unless ( defined $sym );
  47
  48         my $line;
  49         if ( length($sym) > 512 ) {
  50             &dumpvarslog("Scalar '$packname' $symname too long.");
  51         }
  52         else {
  53             &dumpvarslog("Scalar '$packname' \$ $symname => '$sym'");
  54         }
  55         $countlines++;
  56     }
  57
  58     # Functions.
  59     foreach $symname ( sort keys %$package ) {
  60         local *sym = $$package{$symname};
  61         next unless ( defined &sym );
  62
  63         &dumpvarslog("Function '$packname' $symname()");
  64         $countlines++;
  65     }
  66
  67     # Lists.
  68     foreach $symname ( sort keys %$package ) {
  69         local *sym = $$package{$symname};
  70         next unless ( @sym );
  71
  72         &dumpvarslog(
  73             "List '$packname' \@$symname (" . scalar( @{$symname} ) . ")" );
  74         $countlines++;
  75
  76         next unless ( $packname eq 'main::' );
  77         foreach ( @{$symname} ) {
  78             if ( defined $_ ) {
  79                 &dumpvarslog("   => '$_'.");
  80             }
  81             else {
  82                 &dumpvarslog("   => <NULL>.");
  83             }
  84         }
  85     }
  86
  87     # Hashes.
  88     foreach $symname ( sort keys %$package ) {
  89         local *sym = $$package{$symname};
  90         next unless ( %sym );
  91         next if ( $symname =~ /::/ );
  92
  93         &dumpvarslog("Hash '$packname' \%$symname");
  94         $countlines++;
  95
  96         next unless ( $packname eq 'main::' );
  97         foreach ( keys %{$symname} ) {
  98             my $val = ${$symname}{$_};
  99             if ( defined $val ) {
 100                 &dumpvarslog("   $_ => '$val'.");
 101             }
 102             else {
 103                 &dumpvarslog("   $_ => <NULL>.");
 104             }
 105         }
 106     }
 107
 108     return unless ( $packname eq 'main::' );
 109
 110     foreach $symname ( sort keys %$package ) {
 111         local *sym = $$package{$symname};
 112         next unless ( %sym );
 113         next unless ( $symname =~ /::/ );
 114         next if ( $symname eq 'main::' );
 115
 116         DumpNames( \%sym, $symname );
 117     }
 118 }
 119
 120 sub dumpallvars {
 121     if ( &IsParam('dumpvarsLogFile') ) {
 122         my $file = $param{'dumpvarsLogFile'};
 123         &status("opening fh to dumpvars ($file)");
 124         if ( !open( DUMPVARS, ">$file" ) ) {
 125             &ERROR("cannot open dumpvars.");
 126             return;
 127         }
 128     }
 129
 130     DumpNames( %main::, 'main::' );
 131
 132     if ( &IsParam('dumpvarsLogFile') ) {
 133         &status("closing fh to dumpvars");
 134         close DUMPVARS;
 135     }
 136
 137     &status("DV: count == $countlines");
 138 }
 139
 140 1;
 141
 142 # vim:ts=4:sw=4:expandtab:tw=80