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__

=head1 NAME

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

=cut

=head1 SYNOPSIS

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();

=cut

=head1 DESCRIPTION

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

=head2 Attributes

=over 4

=item *

data

The attribute holding the reference to the actual configuration
structure, the top-node so to speak.

=item * 

case

This is the attribute for holding the case parameter (see named
parameteres to the constructor below).

=item *

fn (filename), the attribute holding the filename of current
configuration, no matter whether it exists or not.

=back

=head2 Public Methods

=over 4

=item *

new

This is the constructor of the class. It takes a B<filename> as a
parameter, and additionally some named parameters:

=over 4

=item *

case

The argument given to case is used during the construction of the
objects by the B<_trans> function, to traverse and utilize on all
elements encountered during the traversal through the configuration
tree.

=item *

sig

This is a signal flag indicating whether a configuration should be read
from file (See B<ReadConfig>). If set a newly blessed object will be
initialized by B<ReadConfig>.

...missing docs...

=back

=back

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

=over 4

=item *

Sections

This method calls B<Parameters> and returns all the sections in the object.

...missing docs...

=item *

Parameters

...missing docs...

=item *

ReadConfig

This method reads a file pointed to by the B<fn> attribute and returns
a true value upon successful read and initialization (which overides
self) by using the B<new> method (constructor).

=item *

WriteConfig

The WriteConfig method can be used to write the contents of the
configuration object to a file. This method takes a filename as
argument. The B<WriteConfig> method is used internally by the
B<RewriteConfig> method.

=item *

RewriteConfig

The method is used to overwrite a serialized configuration object to a
file. It writes to the contents of the B<fn> attribute and used the
B<WriteConfig> method (see above).

=item *

TIEHASH

The B<TIEHASH> is just a wrapper for the B<new> method (the constructor).

=item *

FETCH

...missing docs...

=item *

STORE

The B<STORE> method takes 2 parameters, a key and a value. The value is
stored under the key. The method uses the private method B<_setval>.

=item *

DELETE

Deletes/removes the element specified as the argument, uses the private
method B<_delval>.

=item *

CLEAR

Empties/flushes the configuration object. Works with values underneath
the B<data> attribute.

=item *

EXISTS

Returns true if the element specified as a the parameter exists, else
it returns false. Works with values underneath the B<data> attribute.

=item *

FIRSTKEY

Retrieves the first element in the configuration object (tied hash).
Works with values underneath the B<data> attribute.

=item *

NEXTKEY

Retrieves the next element in the configuration object (tied hash), the
first element if none have been retrieved. Works with values underneath
the B<data> attribute.

=back

=head2 Private Methods

=over 4

=item *

_val

Returns the complete config object as a hashref in scalar context.

In list context the method returns a hash.

=item *

_setval

Sets a value in the structure. The method can be given a list of
parameters, the longer the list, the deeper the structure. The
B<_setval> method works from the B<data> attribute and below.

=item *

_newval

This method is just an 'alias' of the B<_setval> method. It is
currently now used anywhere in the class.

=item *

_delval

This method does the opposite of B<_setval>, meaning given a list it
can remove values at all levels of the configuration tree. The
B<_setval> method works from the B<data> attribute and below.

=back

=head2 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.

=over 4

=item *

_trans

The B<_trans> function takes the B<case> argument given to the constructor
and traverses the complete configuration tree and used the sub provided
as argument on the elements encountered.

=back

=cut

=head1 TODO

=over 4

=item *

Write documentation, figure out general uses etc.

=item *

_val (list and scalar context), examples and clarification.

=item *

sig parameter to B<new>, examples and clarification.

=item *

case parameter to B<new>, examples and clarification.

=item *

Make regression tests to find minimum versions of Tie::Hash and
Tie::DeepTied

=back

=head1 COPYRIGHT

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

=head1 AUTHOR

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>

=cut