Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

using AUTOLOAD to access read-only data structures

by shmem (Canon)
on Jun 02, 2011 at 05:43 UTC ( #907750=CUFP: print w/ replies, xml ) Need Help??

Greetings Monkses,

here is another item of the series "Funny Usages Of Perl".

Access a read-only configuration hash, which is a singleton:

package XSConf; use 5.10.0; use XML::Simple; use strict; use warnings; use feature 'switch'; my $config; sub import { shift; $config or $config = XMLin(shift) if @_; return; # don't give $config away } my $token; our $AUTOLOAD; sub AUTOLOAD { my $package = shift; $AUTOLOAD =~ s/.*:://; return if $AUTOLOAD eq 'DESTROY'; given ($AUTOLOAD) { when ('config' ) { $token = $config } when ('_type' ) { return ref $token || 'SCALAR' } when ('_keys' ) { return keys %$token } when ('_values') { return map { "$_" } values %$token } when ('_each' ) { return map { "$_" } each %$token } when (/^_len/ ) { return scalar @$token } when ('_last' ) { return $#$token } when ('_elems' ) { return map { "$_" } @$token } default { my $thing; given (ref $token) { when ('HASH') { die "$AUTOLOAD doesn't exist in $package\n" unless exists $token->{$AUTOLOAD}; $thing = $token->{$AUTOLOAD}; } when ('ARRAY') { $AUTOLOAD =~ s/^_//; die "index $AUTOLOAD out of range\n" if $AUTOLOAD > $#$token; $thing = $token->[$AUTOLOAD]; } } ref $thing and $token = $thing or return $thing; } } return $package; } 1;
Using eg. this foo.xml
<config> <database> <host>DBHOST</host> <user>DBUSER</user> <password>DBPASSWD</password> <port>DBPORT</port> <name>DBNAME</name> <codeset>iso-8859-1</codeset> <database_filesystems> <filesys_exclude_list> <filesys>/</filesys> <filesys>/usr</filesys> <filesys>/opt</filesys> <filesys>/var</filesys> </filesys_exclude_list> </database_filesystems> </database> <app> <hostservices> <service port="21">ftp</service> <service port="22">ssh</service> <service port="23">telnet</service> </hostservices> </app> </config>
lets you do
#!/usr/bin/perl use XSConf qw(foo.xml); for(qw(config database database_filesystems filesys_exclude_list files +ys)) { XSConf->$_; } # config now anchored at 'filesys' array print "root: ",XSConf->_0,$/; print "filesys $_\n" for XSConf->_elems; print XSConf->config->database->codeset,$/; XSConf->config->database; # config now anchored at 'database' hash while( my ($k,$v) = XSConf->_each ) { print "database: $k = $v ", ref $v ? '('.ref $v .')' : '', $/; } { local $"=":"; print "service @l\n", ^@^ if @l= XSConf->config->app->hostservices->service->_2->_values; } __END__ root: / filesys / filesys /usr filesys /opt filesys /var iso-8859-1 database: password = DBPASSWD database: database_filesystems = HASH(0x945f3ec) database: codeset = iso-8859-1 database: name = DBNAME database: user = DBUSER database: port = DBPORT database: host = DBHOST service telnet:23

The ^@^ there? Just kidding...

The major drawback of this is the default return value, which is __PACKAGE__. Then, you can't anchor XSConf at say, 'hostservices' in the above example and iterate through the 'service' array dereferencing it's hashes.

But there's a dangerous aspect: if you happen to go past the end of the structure, you'll end up invoking a method.

use XSConf qw(foo.xml); XSConf->config->database->codeset->foo; __END__ Can't locate object method "foo" via package "iso-8859-1" (perhaps you + forgot to load "iso-8859-1"?) at...

But then, this happens always if you dereference a scalar as a method.

update: version for older perls below (with code as per ikegami's suggestion).

package XSConf; use XML::Simple; use strict; use warnings; my $config; sub import { shift; $config or $config = XMLin(shift) if @_; $XSConf::strict = 1 if @_; return; # don't give $config away } my $token; our $AUTOLOAD; sub AUTOLOAD { my $package = shift; local $_ = $AUTOLOAD; s/.*:://; /^DESTROY$/ and return; # you may NOT use DESTROY in your config /^config$/ and $token = $config and return $package; /^_type$/ and return ref $token || 'SCALAR'; /^_keys$/ and return keys %$token; /^_values$/ and return map { "$_" } values %$token; /^_each$/ and return map { "$_" } each %$token; /^_len/ and return scalar @$token; /^_last$/ and return $#$token; /^_elems$/ and return map { "$_" } @$token; my $thing; if ( ref $token eq 'HASH' ) { die "$_ doesn't exist in $package\n" unless exists $token->{$_}; $thing = $token->{$_}; } elsif ( ref $token eq 'ARRAY' ) { s/^_//; die "index $_ out of range\n" if $_ > $#$token; $thing = $token->[$_]; } ref $thing and $token = $thing or return bless \$thing, 'XSConf::S +tr'; return $package; } package XSConf::Str; use overload '""' => \&str, fallback => 1; sub str { ${$_[0]} } our $AUTOLOAD; sub AUTOLOAD { return if $AUTOLOAD eq 'XSConf::Str::DESTROY'; $AUTOLOAD =~ s/.*:://; my @caller = caller; die "you cannot invoke the method '$AUTOLOAD' on the string '$_[0] +'" . " at $caller[1] line $caller[2]\n" if $XSConf::strict; $_[0]; } 1;

update: Why? It stringifies all your references, making your class data read-only, and it is easier to do (at least for me) than a module which ties the structure.
And it saves you lots of curlies and brackets for later ;-)

Comment on using AUTOLOAD to access read-only data structures
Select or Download Code
Re: using AUTOLOAD to access read-only data structures
by ikegami (Pope) on Jun 02, 2011 at 06:23 UTC
    The dangerous aspect can be mitigated by returning an object that stringifies or throws a better error on method call.
      It can't be done from within, since the method call is out of the scope of that package. It's like saying
      perl -le '$foo = "Blorf"; $foo->quux' Can't locate object method "quux" via package "Blorf" (perhaps you for +got to load "Blorf"?) at -e line 1.
        $foo doesn't hold an object that stringifies to Blorf or throws a better error on method call.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://907750]
Approved by ikegami
Front-paged by ikegami
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (12)
As of 2014-10-01 16:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (29 votes), past polls