package Lire::Config::Parser;

use strict;

use base qw/Lire::XMLParser/;

use Lire::Utils qw/ check_object_param /;
use Lire::Config::TypeSpec;
use Lire::Config::Value;
use Carp;

=pod

=head1 NAME

Lire::Config::Parser - Creates a Lire::Config::ConfigFile object from XML

=head1 SYNOPSIS

  use Lire::Config;
  use Lire::Config::Parser;

  my $parser = new Lire::Config::Parser( 'spec' => Lire::Config->config_spec());
  my $conf = $parser->parsefile( 'config.xml' );

=head1 DESCRIPTION

Rather straightforward XML parser that follows the configuration
specification to parse an XML file.

=head2 new( 'spec' => $spec )

Creates a parser object which will parse configuration file which
validates against the Lire::Config::ConfigSpec specification $spec.

=cut

sub new {
    my $self = shift->SUPER::new();
    my %args = @_;

    check_object_param( $args{'spec'}, 'spec',
                        'Lire::Config::ConfigSpec' );

    $self->{'spec'} = $args{'spec'};

    return $self;
}

sub namespaces {
    return { 'http://www.logreport.org/LRCML/' => 'lrcml' };
}

sub elements_spec {
    return {
            'lrcml:config' => [ 'lrcml:global', 'lrcml:param' ],
            'lrcml:global' => [ 'lrcml:param' ],
            'lrcml:param' => [ 'PCDATA', 'lrcml:param' ],
           };
}

=pod

=head2 load_config_file( $file )

Parses the $file XML file and returns a Lire::Config::ConfigFile
object representing it.

=cut

sub load_config_file {
    my ( $self, $file ) = @_;

    $self->{'filename'} = $file;
    my $conf =  eval { $self->parsefile( $file ) };;
    croak "error while parsing XML Config $file: $@"
      if $@;

    return $conf;
}

sub parse_start {
    my $self = $_[0];

    $self->{'conf'} =
      new Lire::Config::ConfigFile( 'spec' => $self->{'spec'},
                                    'filename' => $self->{'filename'},
                                  );
    $self->init_stack( 'config_spec' );
    $self->init_stack( 'config_value' );

    return;
}

sub parse_end {
    my $self = $_[0];

    return $self->{'conf'};
}

sub param_char {
    my ( $self, $text ) = @_;

    $self->collect( 'lrcml:param' . $self->depth(), $text );

    return;
}

sub current_param_spec {
    my ( $self, $name ) = @_;

    return $self->stack_peek( 'config_spec' )->get(  $name );
}

sub param_start {
    my ( $self, $param, $attr ) = @_;

    $self->error( "<config> must be the root element" )
      if $self->is_stack_empty( 'config_spec' );

    my $spec = $self->current_param_spec( $attr->{'name'} );
    my $value = $spec->instance( %$attr );

    unless ( $self->is_stack_empty( 'config_value' ) ) {
        my $parent_value = $self->stack_peek( 'config_value' );

        if( $parent_value->isa( "Lire::Config::List" ) ) {
            $parent_value->append( $value );
        } elsif ( $parent_value->isa("Lire::Config::Dictionary") ) {
            $parent_value->set($value);
        } else {
            $self->error( "unknown parameter container type: $parent_value" );
        }
    }

    $spec = $value->get_properties_spec()
      if $value->isa( 'Lire::Config::Plugin' );
    # Remove any default since the value is redefined.
    $value->clear() if $value->isa( 'Lire::Config::List' );

    $self->stack_push( 'config_spec', $spec );
    $self->stack_push( 'config_value', $value );

    $self->init_collector( 'lrcml:param' . ($self->depth() + 1) );

    return;
}

sub param_end {
    my $self = $_[0];

    $self->stack_pop( 'config_spec' );
    my $value = $self->stack_pop( 'config_value' );
    if( $value->isa( "Lire::Config::Scalar" ) ) {
        local $SIG{'__WARN__'} = sub {};
        my $text = $self->get_collector( 'lrcml:param' . ($self->depth() + 1));
        $value->set( $text )
          unless $text eq '' && $value->get() ne '';
    }

    return;
}

sub config_start {
    my ( $self, $name, $attr ) = @_;

    $self->error( "<config> must be the root element" )
      unless $self->is_stack_empty( 'config_spec' );

    my $global_conf = $self->{'spec'}->instance();
    $self->{'conf'}->global( $global_conf );

    $self->stack_push( 'config_spec', $self->{'spec'} );
    $self->stack_push( 'config_value', $global_conf );

    return;
}

sub config_end {
    my $self = $_[0];

    $self->stack_pop( 'config_spec' );
    $self->stack_pop( 'config_value' );

    $self->error( "<config> must be the root element" )
        unless $self->is_stack_empty( 'config_spec' );

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO 

 Lire::Config::ConfigFile(3pm), Lire::Config::SpecParser(3pm),
 Lire::Config::ConfigSpec(3pm)

=head1 AUTHORS

  Wessel Dankers <wsl@logreport.org>
  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: Parser.pm,v 1.49 2006/07/23 13:16:30 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2002, 2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut