CUFP
shmem
<p>Greetings Monkses,</p>
<p>here is another item of the series "Funny Usages Of Perl".</p>
<p>Access a read-only configuration hash, which is a singleton:</p>
<c>
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;
</c>
Using eg. this foo.xml
<c>
<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>
</c>
lets you do
<c>
#!/usr/bin/perl
use XSConf qw(foo.xml);
for(qw(config database database_filesystems filesys_exclude_list filesys)) {
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
</c>
<p>The <c>^@^</c> there? Just kidding...</p>
<p>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.</p>
<p>But there's a dangerous aspect: if you happen to go past the end of the structure, you'll end up invoking a method.</p>
<code>
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...
</code>
<p>But then, this happens always if you dereference a scalar as a method.</p>
<p>update: version for older perls below (with code as per [ikegami]'s [id://907755|suggestion]).</p>
<readmore>
<c>
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::Str';
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;
</c>
</readmore>
<p>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 [doc://perltie|ties] the structure.<br>
And it saves you lots of curlies and brackets for later ;-)</p>