Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

Comment on

( #3333=superdoc: 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 ;-)

In reply to using AUTOLOAD to access read-only data structures by shmem

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (3)
    As of 2018-05-20 13:05 GMT
    Find Nodes?
      Voting Booth?