views:

78

answers:

6

Given a typeglob, how can I find which types are actually defined?

In my application, we user PERL as a simple configuration format. I'd like to require() the user config file, then be able to see which variables are defined, as well as what types they are.

Code: (questionable quality advisory)

#!/usr/bin/env perl

use strict;
use warnings;

my %before = %main::;
require "/path/to/my.config";
my %after = %main::;

foreach my $key (sort keys %after) {
    next if exists $before{$symbol}; 

    local *myglob = $after{$symbol};
    #the SCALAR glob is always defined, so we check the value instead
    if ( defined ${ *myglob{SCALAR} } ) {
        my $val = ${ *myglob{SCALAR} };
        print "\$$symbol = '".$val."'\n" ;
    }
    if ( defined *myglob{ARRAY} ) {
        my @val = @{ *myglob{ARRAY} };
        print "\@$symbol = ( '". join("', '", @val) . "' )\n" ;
    }
    if ( defined *myglob{HASH} ) {
        my %val = %{ *myglob{HASH} };
        print "\%$symbol = ( ";
        while(  my ($key, $val) = each %val )  {
            print "$key=>'$val', ";
        }
        print ")\n" ;
    }
}

my.config:

@A = ( a, b, c );
%B = ( b=>'bee' );
$C = 'see';

output:

@A = ( 'a', 'b', 'c' )
%B = ( b=>'bee', )
$C = 'see'
$_<my.config = 'my.config'
+4  A: 
Greg Bacon
I just looked at what `Package::Stash` does, and it goes with the obvious workaround: when looking at SCALAR it dereferences the scalarref from the glob and sees if the scalar is defined. So if for some reason you create a scalar but leave undef in it, it won't show up, but at least fictitious scalars don't get in the way.
hobbs
@hobbs: the difference between an undefined scalar and a scalar with an undef value is tenuous at best. I'm ok with lumping them in the same category.
bukzor
@gbacon: quite nice. If you'll add values to the output, I'll accept this answer and remove my ugly attempt above.
bukzor
@bukzor Thanks! See updated answer.
Greg Bacon
+1  A: 
molecules
+3  A: 

Beginning in 5.010, you can distinguish whether a SCALAR exists using the B introspection module; see http://stackoverflow.com/questions/3335425/detecting-declared-package-variables-in-perl/3337046#3337046

Update: example copied from that answer:

# package main;
our $f;
sub f {}
sub g {}

use B;
use 5.010;
if ( ${ B::svref_2object(\*f)->SV } ) {
    say "f: Thar be a scalar tharrr!";
}
if ( ${ B::svref_2object(\*g)->SV } ) {
    say "g: Thar be a scalar tharrr!";
}

1;
ysth
@ysth I wasn't able to garner much from that thread or the B documentation. Do you have a brief example?
bukzor
@bukzor: copied the example from the linked answer; was there something else? The SV method will return a B::SPECIAL object for the null value in the SV slot, but that class is also used for a few other special values and doesn't provide good methods for determining which it is, but since B objects are just blessed references to scalars storing the numeric actual address, you can deref and test if that's 0 or not.
ysth
@ysth: I'm really a python guy. I don't know what most of that means.
bukzor
+3  A: 

Working code using a CPAN module that gets some of the hair out of the way, Package::Stash. As noted in my comment to gbacon's answer, this is blind to the config file doing $someval = undef but that seems to be unavoidable, and at least the other cases are caught. It also limits itself to the SCALAR, ARRAY, HASH, CODE, and IO types -- getting GLOB and FORMAT is possible but it makes the code less pretty and also creates noise in the output :)

#!perl

use strict;
use warnings;

use Package::Stash;

sub all_vars_in {
  my ($package) = @_;
  my @ret;

  my $stash = Package::Stash->new($package);
  for my $sym ($stash->list_all_package_symbols) {
    for my $sigil (qw($ @ % &), '') {
          my $fullsym = "$sigil$sym";
      push @ret, $fullsym if $stash->has_package_symbol($fullsym);
    }
  }
  @ret;
}

my %before;
$before{$_} ++ for all_vars_in('main');

require "my.config";

for my $var (all_vars_in('main')) {
  print "$var\n" unless exists $before{$var};
}
hobbs
A: 

If you don't mind parsing Data::Dump output, you could use it to tease out the differences.

use strict;
use warnings;
use Data::Dump qw{ dump };

my %before = %main::;
require "my.config";
my %after = %main::;

foreach my $key ( sort keys %after ) {
    if ( not exists $before{$key} ) {
        my $glob = $after{$key};
        print "'$key' " . dump( $glob) . "\n";
    }
}

Using this code with the following config file:

$FOO1 = 3;
$FOO2 = 'my_scalar';
%FOO2 = ( a=>'b', c=>'d' );
@FOO3 = ( 1 .. 5);
$FOO4 = [ 1 .. 5 ];

I believe that this output provides enough information to be able to figure out which parts of each type glob are defined:

'FOO1' do {
  my $a = *main::FOO1;
  $a = \3;
  $a;
}
'FOO2' do {
  my $a = *main::FOO2;
  $a = \"my_scalar";
  $a = { a => "b", c => "d" };
  $a;
}
'FOO3' do {
  my $a = *main::FOO3;
  $a = [1 .. 5];
  $a;
}
'FOO4' do {
  my $a = *main::FOO4;
  $a = \[1 .. 5];
  $a;
}
'_<my.config' do {
  my $a = *main::_<my.config;
  $a = \"my.config";
  $a;
}
molecules
+1  A: 

I hate to ask, but instead of messing around with typeglobs, why not switch to a real configuration format? e.g. check out Config::Simple and YAML.

I wouldn't recommend messing around with typeglobs and symbol tables in normal cases (some CPAN modules do that, but only at the bottom levels of large systems - e.g. Moose in the lowest levels of Class::MOP). Perl gives you a lot of rope to work with, but that rope is also quite happy to self-noosify and self-tie-around-your-neck if you're not careful :)

See also: How do you manage configuration files in Perl?

Ether
@Ether my users are supposed to know simple PERL. At the time, we thought this would be simple way to configure things, but perhaps we were mistaken. On the surface the config looks quite nice, so it won't change unless I can present an authoritative argument to management.
bukzor
+1. Good job looking past the question to the actual need.
molecules