XML::Conf - a simple configuration module based on XML

XML-Conf documentation Contained in the XML-Conf distribution.

Index

Code Index:

NAME

Top

XML::Conf - a simple configuration module based on XML

SYNOPSIS

Top

Here follows some examples as the tests are done.

use XML::Conf;

my $c = XML::Conf->new($filename);

$w = $c->FIRSTKEY();

$v = $c->NEXTKEY();

$c->EXISTS($v);

$c->DELETE($v);

$c->CLEAR();

DESCRIPTION

Top

This is the description of the class, currently it only containg only the descriptions of the private and public methods and attributes.

Attributes

Public Methods

Apart from the public interface of the new method, the method is also used internally from some of the other methods, the methods usings the constructor are described below.

Private Methods

Private Functions

This paragraf contains functions which are not related to the class in public use, these functions are used during construction of the object.

TODO

Top

COPYRIGHT

Top

XML::Conf is free software and is released under the Artistic License. See <http://www.perl.com/language/misc/Artistic.html> for details.

AUTHOR

Top

This is originally the work of Ariel Brosh, a member of Israel.pm and author of several contributions to CPAN. He has unfortunately passed away and have left behind several Perl modules where this is just one of them.

I volunteered to contribute further to the development of the module, but it is still kept under the name of Ariel Brosh - the original author.

Jonas B. Nielsen <jonasbn@cpan.org>

XML-Conf documentation Contained in the XML-Conf distribution. 
package XML::Conf;

# $Id: Conf.pm,v 1.6 2003/12/14 20:44:11 jonasbn Exp $

use XML::Simple;
use strict;
use vars qw($VERSION @ISA);
use Tie::DeepTied;
use Tie::Hash;
use Carp;

$VERSION = 0.04;

sub new {
    my ($class, $filename, %opts) = @_;
    my $xml;
    my $fn;

    if (ref($filename) eq 'SCALAR') { #Internal use (TIEHASH)
        $xml = $$filename;
    } elsif ($filename =~ m/^\s*\<.*\>\s*$/s) { #internal use (TIEHASH)
        $xml = $filename;
    } else { #internal use (ReadConfig)
        $filename = "./$filename" if ($filename !~ /^[\/\.]/ && -e "./$filename");
        open(I, $filename) || croak "Could not open $filename: $!";
        $xml = join("", <I>);
        close(I);
        $fn = $filename;
    }
    my $hash = XML::Simple::XMLin($xml) || return undef;
    my $case = $opts{'case'}?$opts{'case'}:'_dummysub';
    #my $case = $opts{'case'};
    $hash = &_trans($hash, eval "sub { $case(\$_);} ") if ($case);
    #$hash = &_trans($hash, $case) if ($case);
    my $self = {'data' => $hash, 'case' => $case, 'fn' => $fn};
    my $sig = $opts{'sig'};
    if ($sig) {
        $SIG{$sig} = sub { $self->ReadConfig; };
    }
    bless $self, $class;
}

sub _dummysub {
	my $val = shift; 
}

sub _trans {
    my ($tree, $case) = @_;
    return $tree unless (UNIVERSAL::isa($tree, 'HASH'));
    my %hash;
    no strict 'refs';
    foreach (keys %$tree) {
        $hash{ &$case($_) } = &_trans($tree->{$_}, $case);
    }
    use strict 'refs';
    \%hash;
}

sub _val {
    my $self = shift;
    my $data = $self->{'data'};

    foreach (@_) {
        $data = $data->{$_};
    }
    wantarray ? split("\n", $data) : $data;
}

sub _setval {
    my $self = shift;
    my $data = \$self->{'data'};
    while (@_ > 1) {
        $data = \($$data->{shift()});
    }
    $$data = shift;
}

sub _newval {
    my $self = shift;
    $self->_setval(@_);
}

sub _delval {
    my $self = shift;
    my $data = $self->{'data'};
    while (@_ > 1) {
        $data = $data->{shift()};
    }
    delete $data->{shift()};
}

sub ReadConfig {
    my $self = shift;
    my $fn = $self->{'fn'};
    return undef unless ($fn);
    my $new = &new(__PACKAGE__, $fn, 'case' => $self->{'case'});
    %$self = %$new;
    1;
}

sub Sections {
    my $self = shift;
    $self->Parameters(@_);
}

sub Parameters {
    my $self = shift;
    my $val = $self->_val(@_);
    my $case = $self->{'case'};
    no strict 'refs';
    map { &$case($_); } keys %$val;
    use strict 'refs';
}

sub RewriteConfig {
    my $self = shift;
    my $fn = $self->{'fn'};
    croak "No filename" unless ($fn);
    $self->WriteConfig($fn);
}

sub WriteConfig {
    my ($self, $name) = @_;
    my $xml = XMLout($self->{'data'}, xmldecl => 1);
    open(O, ">$name") || croak "Can't rewrite $name: $!";
    print O $xml;
    close(O);
}

sub TIEHASH {
    my $class = shift;
    $class->new(@_);
}

sub FETCH {
    my ($self, $key) = @_;
    my $val = $self->_val($key);
    if (UNIVERSAL::isa($val, 'HASH') && !tied(%$val)) {
        my %h = %$val;
        tie %$val, 'Tie::StdHash', $self, $key;
        %$val = %h;
        tie %$val, 'Tie::DeepTied', $self, $key;
    }
    $val;
}

sub STORE {
    my ($self, $key, $val) = @_;
    $self->_setval($key, $val);
}

sub DELETE {
    my ($self, $key) = @_;
    $self->_delval($key);
}

sub CLEAR {
    my $self = shift;
    $self->{'data'} = {};
}

sub EXISTS {
    my ($self, $key) = @_;
    exists $self->{'data'}->{$key};
}

sub FIRSTKEY {
    my $self = shift;
    keys %{$self->{'data'}};
    each %{$self->{'data'}};
}

sub NEXTKEY {
    my $self = shift;
    each %{$self->{'data'}};
}

1;

__END__