Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.

Programmatic Discovery of Package Variables in Perl? 3 Comments More | Login | Reply /

 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • PadWalker can see both lexical and package variables, just fill %pad_vars with peek_our first and let peek_my override it (since lexical variables hide package variables).

    • #!/usr/bin/perl

      use strict;
      use warnings;

      use PadWalker qw/peek_our peek_my/;
      use Scalar::Util 'refaddr';
      use Data::Dumper;

      our $foo = 1;
      our $bar = 2;
      {
              my $foo = 3;
              print "my masks our\n", dumper(\$foo, \$bar);
      }
      print "now both are our\n", dumper(\$foo, \$bar);

      sub dumper {
              my $package = peek_our(1);
              my $lexical = peek_my(1);
              my %pad_vars;
              while ( my

      • This seems to handle $" and the like:

        #!/usr/bin/perl

        use strict;
        use warnings;

        use PadWalker qw/peek_our peek_my/;
        use Scalar::Util 'refaddr';
        use Data::Dumper;

        our $foo = 1;
        our $bar = 2;
        {
                my $foo = 3;
                print "my masks our\n", dumper(\$foo, \$bar, \$");
        }
        print "now both are our\n", dumper(\$foo, \$bar, \$");

        sub dumper {
                my $package = peek_our(1);
                my $lexical = peek_my(1);
                my %pad_vars;
                while ( my ( $var, $ref ) = each %$package ) {

                        # we no longer remove the '$' sigil because we don't want
                        # "$foo = \@array" reported as "@foo".
                        $var =~ s/^[\@\%]/*/;
                        $pad_vars{ refaddr $ref } = $var;
                }
                foreach my $var (keys %main::) {
                        my $glob = $main::{$var};

                        if (defined ${$glob}) {
                                $pad_vars{ refaddr \${$glob} } = "\$$var";
                        }

                        if (defined @{$glob}) {
                                $pad_vars{ refaddr \@{$glob} } = $var;
                        }

                        if (defined %{$glob}) {
                                $pad_vars{ refaddr \%{$glob} } = $var;
                        }
                }

                while ( my ( $var, $ref ) = each %$lexical ) {

                        # we no longer remove the '$' sigil because we don't want
                        # "$foo = \@array" reported as "@foo".
                        $var =~ s/^[\@\%]/*/;
                        $pad_vars{ refaddr $ref } = $var;
                }
                my @names;
                my $varcount = 1;
                foreach (@_) {
                        my $name;
                        INNER: foreach ( \$_, $_ ) {
                                no warnings 'uninitialized';
                                $name = $pad_vars{ refaddr $_} and last INNER;
                        }
                        push @names, $name;
                }

                return Data::Dumper->Dump( \@_, \@names );
        }

Stories, comments, journals, and other submissions on use Perl; are Copyright 1998-2006, their respective owners.