package Lire::XMLSpecParser;

use strict;

use base qw/Lire::DocBookParser Lire::Config::Parser/;

use Lire::ReportSpec;
use Lire::FilterSpec;
use Lire::FilterExpr;
use Lire::Average;
use Lire::First;
use Lire::Last;
use Lire::Min;
use Lire::Max;
use Lire::Sum;
use Lire::Count;
use Lire::Group;
use Lire::GroupField;
use Lire::Rangegroup;
use Lire::Records;
use Lire::Timegroup;
use Lire::Timeslot;
use Lire::Param;

use Lire::Config::ListSpec;
use Lire::Config::ChartSpec;

=pod

=head1 NAME

Lire::XMLSpecParser - Creates Lire::XMLSpecContainer object form XML files.

=head1 SYNOPSIS

  use Lire::XMLSpecParser;

  my $parser = new Lire::XMLSpecParser;
  my $spec = $parser->parsefile( 'top-files.xml' );

=head1 DESCRIPTION

This is a Lire::XMLParser subclass that can be used to creates
Lire::ReportSpec and Lire::FilterSpec objects from XML files.

=cut


my @aggregators_mix = qw/lrsml:group lrsml:rangegroup lrsml:records
                         lrsml:timegroup lrsml:timeslot/;
my @aggregates_mix = qw/lrsml:sum lrsml:avg lrsml:min lrsml:max
                        lrsml:first lrsml:last lrsml:count/;
my @scalar_filters_mix = qw/lrsml:eq lrsml:ne lrsml:gt lrsml:ge
                           lrsml:lt lrsml:le lrsml:match lrsml:value/;
my @compound_filters_mix = qw/lrsml:and lrsml:or lrsml:not/;

my @meta_infos_mix = qw/lrsml:title lrsml:description
                        lrsml:display-spec lrsml:param-spec/;
my %spec = (
            'lrsml:report-spec' =>
            { 'start' => 'spec_start',
              'end'   => 'spec_end',
              'content' => [ @meta_infos_mix, 'lrsml:filter-spec',
                             'lrsml:chart-configs',
                             'lrsml:report-calc-spec' ],
            },
            'lrsml:global-filter-spec' =>
            { 'start' => 'spec_start',
              'end' => 'spec_end',
              'content' => [ @meta_infos_mix, 'lrsml:filter-spec' ],
            },
            'lrsml:title' => { 'start' => 'collector_start',
                               'char' => 'collector_char',
                               'end' => 'title_end',
                               'content' => [ 'PCDATA' ], },
            'lrsml:description' => { 'start' => 'dbk_init',
                                     'char' => 'dbk_element_char',
                                     'end' => 'description_end',
                                     'content' => [ 'para' ], },
            'lrsml:display-spec' => [ 'lrsml:title', 'lrsml:description' ],
            'lrsml:param-spec' => [ 'lrsml:param' ],
            'lrsml:param' => { 'start' => 'lrsml_param_start',
                               'end' => 'lrsml_param_end',
                               'content' => [ 'lrsml:description' ] },
            'lrsml:filter-spec' => [ @compound_filters_mix,
                                     @scalar_filters_mix ],
            'lrsml:chart-configs' => [ 'lrcml:param' ],
            'lrsml:report-calc-spec' => [ @aggregators_mix ],

            'lrsml:group' => [ 'lrsml:field', @aggregators_mix,
                               @aggregates_mix ],
            'lrsml:field' => [],
            'lrsml:not' => { 'start' => 'compound_filter_start',
                             'end' => 'not_end',
                             'content' => [ @compound_filters_mix,
                                            @scalar_filters_mix ] },
            'lrsml:avg' => [],
            'lrsml:count' => [],
            'lrsml:first' => [],
            'lrsml:last' => [],
            'lrsml:records' => [],
           );
foreach my $aggr ( ( @aggregates_mix ) ) {
    $spec{$aggr} = { 'start' => 'aggregate_start', 'content' => [] }
      unless exists $spec{$aggr};
}
foreach my $aggr ( @aggregators_mix ) {
    $spec{$aggr} = { 'start' => 'aggregator_start',
                     'end' => 'aggregator_end',
                     'content' => [ @aggregators_mix, @aggregates_mix ] }
      unless exists $spec{$aggr};
}
foreach my $filter ( @scalar_filters_mix ) {
    $spec{$filter} = { 'start' => 'scalar_filter_start',
                       'content' => [] }
      unless exists $spec{$filter};

}
foreach my $filter ( @compound_filters_mix ) {
    $spec{$filter} = { 'start' => 'compound_filter_start',
                       'end' => 'compound_filter_end',
                       'content' => [ @compound_filters_mix,
                                      @scalar_filters_mix ] }
      unless exists $spec{$filter};
}

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

    my $ns = { %{$self->Lire::Config::Parser::namespaces()} };
    $ns->{'http://www.logreport.org/LRSML/'} = 'lrsml';

    return $ns;
}

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

    return {
            %{$self->Lire::Config::Parser::elements_spec()},
            %{$self->Lire::DocBookParser::elements_spec()},
            %spec,
           };
}

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

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

    return;
}

sub parse_end {
    return $_[0]{'_spec'};
}

my %factories =
  ( 'lrsml:avg' => 'Lire::Average',
    'lrsml:count', => 'Lire::Count',
    'lrsml:first' => 'Lire::First',
    'lrsml:last' => 'Lire::Last',
    'lrsml:min' => 'Lire::Min',
    'lrsml:max' => 'Lire::Max',
    'lrsml:sum' => 'Lire::Sum',
    'lrsml:group' => 'Lire::Group',
    'lrsml:rangegroup' => 'Lire::Rangegroup',
    'lrsml:timegroup' => 'Lire::Timegroup',
    'lrsml:timeslot' => 'Lire::Timeslot',
    'lrsml:records' => 'Lire::Records',
    'lrsml:le' => 'Lire::FilterExpr::Le',
    'lrsml:lt' => 'Lire::FilterExpr::Lt',
    'lrsml:ge' => 'Lire::FilterExpr::Ge',
    'lrsml:gt' => 'Lire::FilterExpr::Gt',
    'lrsml:eq' => 'Lire::FilterExpr::Eq',
    'lrsml:ne' => 'Lire::FilterExpr::Ne',
    'lrsml:value' => 'Lire::FilterExpr::Value',
    'lrsml:match' => 'Lire::FilterExpr::Match',
    'lrsml:and' => 'Lire::FilterExpr::And',
    'lrsml:or' => 'Lire::FilterExpr::Or',
    'lrsml:not' => 'Lire::FilterExpr::Not',
    'lrsml:report-spec' => 'Lire::ReportSpec',
    'lrsml:global-filter-spec' => 'Lire::FilterSpec',
    'lrsml:field' => 'Lire::GroupField',
    'lrsml:param' => 'Lire::Param',
  );

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

    $self->{'_spec'} = $factories{$name}->new();

    die "missing 'id' attribute\n"
      unless exists $attr->{'id'};
    $self->{'_spec'}->id( $attr->{'id'} );

    die "missing 'superservice' attribute\n"
      unless exists $attr->{'superservice'};
    $self->{'_spec'}->superservice( $attr->{'superservice'} );

    $self->{'_spec'}->schema( $attr->{'schema'})
      if exists $attr->{'schema'};

    $self->{'_spec'}->joined_schemas( [ split /\s+/, $attr->{'joined-schemas'} ] )
      if exists $attr->{'joined-schemas'};

    $self->{'_spec'}->charttype( $attr->{'charttype'} )
      if exists $attr->{'charttype'};

    return;
}

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

    # Check that display-spec isn't missing
    die "$name is missing a title element\n"
      unless ( defined $self->{'_spec'}->title() );

    die "$name is missing a description element\n"
      unless ( defined $self->{'_spec'}->description() );

    die "$name is missing a display title\n"
      unless ( defined $self->{'_spec'}->display_title() );
    return;
}

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

    my $spec = new Lire::Config::ListSpec( 'name' => 'chart_configs' );
    $spec->add( new Lire::Config::ChartSpec( 'name' => 'chart' ) );
    $self->stack_push( 'config_spec', $spec );
    $self->stack_push( 'config_value', $spec->instance() );

    return;
}

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

    $self->stack_pop( 'config_spec' );

    foreach my $cfg ( @{$self->stack_pop( 'config_value' )->as_value()}) {
        $self->{'_spec'}->add_chart_config( $cfg );
    }

    return;
}

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

    my $title = $self->get_collector( 'lrsml:title' );
    if ( $self->within_element( 'lrsml:display-spec' ) ) {
	$self->{'_spec'}->display_title( $title );
    } else {
	$self->{'_spec'}->title( $title );
    }
    return;
}

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

    if ( $self->in_element( 'lrsml:display-spec' )) {
	$self->{'_spec'}->display_description( $self->dbk_string() );
    } elsif ( $self->in_element( 'lrsml:param' ) ) {
	$self->{'_curr_param'}->description( $self->dbk_string() );
    } else {
	$self->{'_spec'}->description( $self->dbk_string() );
    }
    return;
}


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

    die "$name missing 'name' attribute\n"
      unless exists $attr->{'name'};

    die "$name is missing 'type' attribute\n"
      unless exists $attr->{'type'};

    $self->{'_curr_param'} =
      $factories{$name}->new( 'i18n_domain' =>
                              'lire-'.$self->{'_spec'}->superservice(),
                              %$attr );

    $self->{'_spec'}->param( $self->{'_curr_param'}->name(),
                              $self->{'_curr_param'} );
    return;
}

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

    delete $self->{'_curr_param'};
    return;
}

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

    $self->init_stack( 'filter-spec' );
    $self->stack_push( 'filter-spec', [] );

    return;
}

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

    my $expr = $self->stack_pop( 'filter-spec' );

    die "filter-spec can contains only one expression"
      if @$expr > 1;
    die "filter-spec must contains one expression"
      if @$expr == 0;

    $self->{'_spec'}->filter_spec( $expr->[0] );

    return;
}

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

    my $parent_content = $self->stack_peek( 'filter-spec' );
    push @$parent_content,
      $factories{$name}->new( %$attr,
                              'container' => $self->{'_spec'} );

    $self->stack_push( 'filter-spec', [] );

    return;
}

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

    my $expr = $self->stack_pop( 'filter-spec' );
    die "$name expression must contains at leat one expression\n"
      unless @$expr;

    $self->stack_peek( 'filter-spec' )->[-1]->expr( $expr );

    return;
}

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

    my $expr = $self->stack_pop( 'filter-spec' );
    die "$name element must contains one expression\n"
      unless @$expr == 1;

    $self->stack_peek( 'filter-spec' )->[-1]->expr( $expr->[0] );

    return;
}

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

    my $content = $self->stack_peek( 'filter-spec' );
    push @$content, $factories{$name}->new( %$attr,
                                            'container' => $self->{'_spec'} );
    return;
}

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

    $self->init_stack( 'calc-spec' );
    $self->init_stack( 'group-sort-fields' );
    $self->stack_push( 'calc-spec', [] );

    return;
}

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

    my $curr_calc = $self->stack_pop( 'calc-spec' );
    die "$name must contains one aggregator (", join( ", ", @aggregators_mix ), ")\n"
      unless @$curr_calc == 1;

    $self->{'_spec'}->calc_spec( $curr_calc->[0] );

    return;
}

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

    # Sort fields attributes can only verified after fields and
    # operations are specified
    $self->stack_push( 'group-sort-fields', $attr->{'sort'} || '' );
    $self->aggregator_start( $name, $attr );

    return;
}

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

    my $content = $self->stack_pop( 'calc-spec' );
    my @fields = grep { UNIVERSAL::isa( $_, "Lire::GroupField" ) } @$content;
    my @ops = grep { UNIVERSAL::isa( $_, "Lire::ReportOperator" ) } @$content;

    die "$name must contains at least one field\n"
      unless @fields;
    die "$name must contains at least one aggregate\n"
      unless @ops;
    die "$name must only contains field and report operators elements\n"
      unless @fields + @ops == @$content;

    my $group = $self->stack_peek( 'calc-spec' )->[-1];
    $group->group_fields( \@fields );
    $group->ops( \@ops );

    $group->sort_fields( [ split /\s+/,
                           $self->stack_pop( 'group-sort-fields' ) ] );
    return;
}

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

    my $parent_content = $self->stack_pop( 'calc-spec' );
    my $parent;
    $parent = $self->stack_peek( 'calc-spec' )->[-1]
      unless $self->is_stack_empty( 'calc-spec' );
    push @$parent_content,
      $factories{$name}->new( %$attr, 'report_spec' => $self->{'_spec'},
                              'parent' => $parent );
    $self->stack_push( 'calc-spec', $parent_content );
    $self->stack_push( 'calc-spec', [] );

    return;
}

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

    my $content = $self->stack_pop( 'calc-spec' );
    my @ops = grep { UNIVERSAL::isa( $_, "Lire::ReportOperator" ) } @$content;

    die "$name must contains at least one aggregate.\n"
      unless @ops;
    die "$name must only contains aggregates\n"
      unless @ops == @$content;

    $self->stack_peek( 'calc-spec' )->[-1]->ops( \@ops );

    return;
}

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

    my $content = $self->stack_peek( 'calc-spec' );
    push @$content,
      $factories{$name}->new( %$attr,
                              'i18n_domain' => 'lire-' . $self->{'_spec'}->superservice(),
                              'report_spec' => $self->{'_spec'} );
    return;
}

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

    my $parent_content = $self->stack_pop( 'calc-spec' );
    my $parent = $self->stack_peek( 'calc-spec' )->[-1];
    push @$parent_content,
      $factories{$name}->new( %$attr,
                              'report_spec' => $self->{'_spec'},
                              'parent' => $parent,
                            );
    $self->stack_push( 'calc-spec', $parent_content );
    return;
}

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

    $attr->{'by-fields'} = [ split /\s+/, $attr->{'by-fields'}]
      if exists $attr->{'by-fields'};

    $self->aggregate_start( $name, $attr );

    return;
}

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

    $attr->{'sort_fields'} = [split /\s+/, $attr->{'sort'}]
      if exists $attr->{'sort'};

    $self->aggregate_start( $name, $attr );

    return;
}

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

    $attr->{'sort_fields'} = [split /\s+/, $attr->{'sort'}]
      if exists $attr->{'sort'};

    $self->aggregate_start( $name, $attr );

    return;
}

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

    $attr->{'fields'} = [split /\s+/, $attr->{'fields'}]
      if exists $attr->{'fields'};

    $self->aggregate_start( $name, $attr );

    return;
}

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

    $attr->{'fields'} = [ split /\s+/, $attr->{'fields'} ]
      if exists $attr->{'fields'};

    $self->aggregate_start( $name, $attr );

    return;
}

1;

__END__

=pod

=head1 SEE ALSO 

 Lire::XMLParser(3pm, Lire::ReportSpec(3pm), Lire::FilterSpec(3pm),
 Lire::XMLSpecContainer(3pm).

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

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

=head1 COPYRIGHT

Copyright (C) 2001-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