package Lire::XMLSpecContainer;

use strict;

use vars qw( $VERSION %SPEC_COUNT $the_factory );

use Lire::DlfSchema;
use Lire::DataTypes qw( :xml :special );
use Lire::Param;
use Lire::ReportSpecFactory;

use Carp;

BEGIN {
    ($VERSION)	= '$Revision: 1.7 $' =~ m!Revision: ([.\d]+)!;

    %SPEC_COUNT = ();
}

sub load {
    my ( $self, $super, $id, $factory ) = @_;

    $factory ||= new Lire::ReportSpecFactory();

    croak "invalid superservice: $super"
      unless check_superservice( $super );

    croak "invalid specification's id: $id"
      unless check_xml_name( $id );

    my $file = $self->file_from_id( $super, $id );
    open ( SPEC, $file )
      or croak "can't open XML specification $file for $id of $super: $!";

    my $parser = new XML::Parser ( Handlers	=> {
						    Init  => \&Init,
						    Final => \&Final,
						    Start => \&Start,
						    End	  => \&End,
						    Char  => \&Char,
						   },
				   Namespaces => 1,
				   NoLWP      => 1,
				 );
    $the_factory = $factory;
    my $spec;
    eval {
	$spec = $parser->parse(\*SPEC);
    };
    die "error while parsing XML specification $id: $@"
      if $@;

    close SPEC;

    $spec;
}

sub new {
    my $proto = shift;
    my $class = ref( $proto) || $proto;

    my $self = bless {
		      params => {},
		      display_descriptions => [],
		     }, $class;

    $self;
}

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

    if ( defined $id ) {
	croak "invalid id for a specification: $id"
	  unless ( check_xml_name( $id ));

	$SPEC_COUNT{ ref ($self ) . "/" . $id} ||= 0;
	$self->{id}	= $id;
	$self->{key}	= $id . "." . $SPEC_COUNT{ ref($self) . "/" . $id}++;
    }

    $self->{id};
}

sub key {
    $_[0]->{key};
}

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

    if ( defined $superservice ) {
	croak "invalid superservice : $superservice"
	  unless ( check_superservice( $superservice ));

	# Schema can't be valid if we switch superservice
	delete $self->{schema}
	  if defined $self->{superservice} &&
	    $self->{superservice} ne $superservice;

	$self->{superservice} = $superservice;
    }

    $self->{superservice};
}

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

    if ( @_ == 2 ) {
	if (defined $schema) {
	    my ( $super ) = $schema =~ /^(\w+)-/;
	    croak "invalid schema identifier: $schema"
	      unless $super;
	    croak "superservice of schema isn't correct: $super != $self->{superservice}"
	      unless $super eq $self->{superservice};
	    $self->{schema} = $schema;
	} else {
	    delete $self->{schema};
	}
    }

    return Lire::DlfSchema::load_schema( $self->{schema} ||
					 $self->{superservice} );
}

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

    if ( defined $title ) {
	$self->{title} = $title;
    }

    $self->{title};
}

sub description {
    my ( $self, $desc ) = @_;

    if ( defined $desc ) {
	$self->{description} = $desc;
    }

    $self->{description};
}

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

    return exists $self->{params}{$name};
}

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

    if ( defined $param ) {
	croak "param has invalid name $name != " . $param->name()
	  unless $name eq $param->name();
	$self->{params}{$name} = $param;
    }

    croak "Lire::XMLSpecContainer::param: no param $name defined"
      unless $self->has_param( $name );

    my $p = $self->{params}{$name};

    if ( @_ == 3 && ! defined $param) {
	# Remove it
	delete $self->{params}{$name};
    }

    $p;
}

sub param_names {
    my ( $self ) = @_;

    return map { $_->name } values %{$self->{params}};
}

sub display_title {
    my ( $self, $title ) = @_;

    if ( defined $title ) {
	my @wrong = $self->check_params( $title );
	if ( @wrong == 1 ) {
	    die "non-existent parameter '", $wrong[0],
	      "' used in display title\n";
	} elsif ( @wrong > 1 ) {
	    die "non-existent parameters (", join( ", ", @wrong ),
	      ") are used in display title\n";
	}
	$self->{display_title} = $title;
    }

    $self->{display_title};
}

sub target_users {
    my ( $self ) = @_;

    return map { $_->{name} } @{$self->{display_descriptions}};
}

sub display_description {
    my ( $self, $target_user, $desc ) = @_;

    my $desc_idx = 0;
    if ( @_ == 3 ) {
	my @wrong = $self->check_params( $desc );
	if ( @wrong == 1 ) {
	    die "non-existent parameter '", $wrong[0],
	      "' used in display description\n";
	} elsif ( @wrong > 1 ) {
	    die "non-existent parameters (", join( ", ", @wrong ),
	      ") are used in display description\n";
	}

	# Modify the description
	if ( defined $target_user ) {

	    # Look for existing target_user with same name
	    foreach my $d ( @{$self->{display_descriptions}} ) {
		if ($d->{name} eq $target_user) {
		    if ( ! defined $desc ) {
			# Remove that description
			splice @{$self->{display_descriptions}}, $desc_idx, 1;
			return undef;
		    } else {
			return $d->{desc} = $desc;
		    }
		}
		$desc_idx++;
	    }

	    # No description with this target_user, create one

	    my $d = { name => $target_user,
		      desc => $desc,
		    };

	    $self->{display_descriptions}[$desc_idx] = $d;

	} else {
	    # First one is the default
	    $self->{display_descriptions}[$desc_idx]{desc} = $desc;
	}
    } elsif ( defined $target_user ) {
	# Look for that target_user or use the first one
	my $i	    = 0;
	foreach my $d ( @{$self->{display_descriptions}} ) {
	    if ($d->{name} eq $target_user) {
		$desc_idx	= $i;
		last;
	    }
	    $i++
	}
	# $desc_idx defaults to 0
    } # else $desc_idx defaults to 0

    $self->{display_descriptions}[$desc_idx]{desc};
}

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

    $self->expand_params( $self->{display_title} );
}

sub expanded_display_description {
    my ( $self, $target_user ) = @_;

    my $desc = $self->display_description( $target_user );

    $self->expand_params( $desc );
}

# ------------------------------------------------------------------------
# Method check_params($str)
#
# Extracts the $ parameters contained in $str and returns the
# list of parameter which aren't available.
# 
# Returns the empty list if all parameters are valid
sub check_params {
    my ($self, $str ) = @_;

    my @wrong = ();
    my @params = $str =~ m|(?<!\$)\$([a-zA-Z]+[-:.\w]+)|g;
    foreach my $p ( @params ) {
	push @wrong, $p
	  unless $self->has_param( $p );
    }

    return @wrong;
}

sub expand_params {
    my ($self, $str) = @_;

    return $str if ( ! defined $str );

    # Replace all occurence of $name with the value of the
    # parameter with the same name. Ignore $$name which will become $name.
    # Will croak on non-existent parameters.
    $str =~ s|(?<!\$)\$([a-zA-Z]+[-:.\w]+)|$self->param($1)->value()|eg;

    # Unescape $$
    $str =~ s|\$\$|\$|g;

    $str;
}

sub print {
    my ($self, $fh) = @_;
    $fh ||= \*STDOUT;

    my $root = $self->root_element;
#
# The header
#
    print $fh <<EOF;
<?xml version="1.0" encoding="ISO-8859-1"?>
<!DOCTYPE lire:$root PUBLIC
  "-//LogReport.ORG//DTD Lire Report Specification Markup Language V1.0//EN"
  "http://www.logreport.org/LRSML/1.0/lrsml.dtd">
EOF
    print $fh qq{<lire:$root xmlns:lire="http://www.logreport.org/LRSML/"
 id="$self->{id}" superservice="$self->{superservice}"};
    print $fh qq{ schema="$self->{schema}"}
      if defined $self->{schema};
    print $fh $self->root_xml_attrs;
    print $fh ">\n\n";

#
# Title and description
#
    my $title = xml_encode( $self->{title} );
    print $fh <<EOF;
 <lire:title>$title</lire:title>
 <lire:description>$self->{description}</lire:description>

EOF

#
# Parameter specifications
#
    if ( keys %{$self->{params}}) {
	print $fh " <lire:param-spec>\n";

	foreach my $p ( values %{$self->{params}} ) {
	    my $name = $p->name();
	    my $type = $p->type();
	    my $default = xml_encode( $p->default() );
	    my $desc = $p->description();
	    print $fh qq{  <lire:param name="$name" type="$type"};
	    print $fh qq{ default="$default"}
	      if defined $default;
	    if (defined $desc ) {
		print $fh <<EOF;
>
   <lire:description>$desc</lire:description>
  </lire:param>

EOF
	    } else {
		print $fh, "/>\n\n";
	    }
	}
	print $fh " </lire:param-spec>\n";
    }


#
# Display-spec
#
    my $display_title = xml_encode( $self->{display_title} );
    print $fh <<EOF;
 <lire:display-spec>
  <lire:title>$display_title</lire:title>

EOF
    foreach my $d ( @{$self->{display_descriptions}}) {
	print $fh "   <lire:description";
	if ( defined $d->{name} ) {
	    print $fh qq{ target-user="$d->{name}"};
	}
	print $fh <<EOF;
>
    $d->{desc}
   </lire:description>

EOF
    }
    print $fh <<EOF;
 </lire:display-spec>

EOF

    $self->print_children( $fh, 1 );

    print $fh <<EOF;
</lire:$root>
EOF
}

########################################################################
#			 METHODS TO OVERRIDE
########################################################################

sub print_children {
    my ( $self, $fh, $indent ) = @_;

    croak "unimplemented method: ", ref $self || $self, "::print_children\n";
}

sub file_from_id {
    my ( $self, $super, $id ) = @_;

    croak "unimplemented method: ", ref $self || $self, "::file_from_id\n";
}

sub root_element {
    my ( $self ) = @_;

    croak "unimplemented method: ", ref $self || $self, "::root_element\n";
}

sub root_xml_attrs {
    return "";
}

########################################################################
#			 XML PARSING SECTION
########################################################################

use vars qw( $curr_spec $curr_param $curr_title $curr_target_user $curr_desc
	     @filter_expr_stack
	     @calc_stack @group_sort_fields
	     $LRSML_NS %LRSML_ELEMENTS );

BEGIN {
    $LRSML_NS = "http://www.logreport.org/LRSML/";

    my @elmnts = qw( report-spec global-filter-spec 
		     title description display-spec param-spec param
		     filter-spec eq ne gt ge lt le and or not match value
		     report-calc-spec
		     group rangegroup summary timegroup timeslot
		     field sum avg min max count records
		     extension
		   );

    %LRSML_ELEMENTS = map { $_ => 1 } @elmnts;

}

sub Init {
    my ($expat) = @_;
}

sub Final {
    return $curr_spec;
}

sub error {
    my ( $expat, $msg ) = @_;

    # Remove other at line message
    # $msg =~ s/( at.*?line \d+\n*)//gm;

    my $line = $expat->current_line;

    die $msg, " at line ", $line, "\n";
}

sub Start {
    my ( $expat, $name ) = @_;

    my $ns = $expat->namespace($name);
    $ns ||= ""; # Remove warning
    if ( $ns eq $LRSML_NS ) {
	# This is one of our element
	error( $expat, "unknown element: $name" )
	  unless exists $LRSML_ELEMENTS{$name};

	{
	    no strict 'refs';

	    my $sub = $name . "_start";
	    $sub =~ s/-/_/g;	# Hyphen aren't allowed in element name

	    eval {
		$sub->( @_ );
	    };
	    error( $expat, $@ ) if $@;
	};
    } else {
	# If we are in lire:description, this is probably a
	# DocBook element, append it to the current description.
	my $lire_desc = $expat->generate_ns_name( "description", $LRSML_NS );
	if ( $expat->within_element( $lire_desc ) ) {
	    $curr_desc .= $expat->original_string();
	} else {
	    error( $expat, "unknown element: $name" );
	}
    }
}

sub End {
    my ( $expat, $name ) = @_;

    my $ns = $expat->namespace($name);
    $ns ||= ""; # Remove warning
    if ( $ns eq $LRSML_NS ) {
	# This is one of our element
	error( $expat, "unknown element: $name" )
	  unless exists $LRSML_ELEMENTS{$name};

	{
	    no strict 'refs';

	    my $sub = $name . "_end";
	    $sub =~ s/-/_/g;	# Hyphen aren't allowed in element name

	    eval {
		$sub->( @_ );
	    };
	    error( $expat, $@ ) if $@;
	}
    } else {
	# If we are in lire:description, this is probably a
	# DocBook element, append it to the current description.
	my $lire_desc = $expat->generate_ns_name( "description", $LRSML_NS );
	if ( $expat->within_element( $lire_desc ) ) {
	    $curr_desc .= $expat->original_string();
	} else {
	    error( $expat, "unknown element: $name" );
	}
    }
}

sub Char {
    my ( $expat, $str ) = @_;

    # Character should only appear in title and description
    my $lire_title = $expat->generate_ns_name( "title", $LRSML_NS );
    my $lire_desc  = $expat->generate_ns_name( "description", $LRSML_NS );

    if ( $expat->in_element( $lire_title )) {
	$curr_title .= $str;
    } elsif ( $expat->within_element( $lire_desc )) {
	# Use original_string because we don't want parsed entities.
	$curr_desc  .= $expat->original_string();
    }
}

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

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

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

    $curr_spec->schema( $attr{schema})
      if exists $attr{schema};
}

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

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

    die "$name is missing a description element\n"
      unless ( defined $curr_spec->description );

    die "$name is missing a display title\n"
      unless ( defined $curr_spec->display_title );

}

sub global_filter_spec_start {
    my ( $expat, $name, %attr ) = @_;

    $curr_spec	= $the_factory->create_filter_spec();

    spec_start( @_ );
}

sub global_filter_spec_end {
    spec_end( @_ );
}

sub report_spec_start {
    my ( $expat, $name, %attr ) = @_;

    $curr_spec	= $the_factory->create_report_spec();

    spec_start( @_ );

    $curr_spec->charttype( $attr{charttype})
      if exists $attr{charttype};
}

sub report_spec_end {
    spec_end( @_ );
}

sub display_spec_start {}
sub display_spec_end {}

sub param_spec_start {}
sub param_spec_end {}

sub param_start {
    my ( $expat, $name, %attr ) = @_;

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

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

    $curr_param = new Lire::Param( %attr );

    $curr_spec->param( $curr_param->name, $curr_param );
}

sub param_end {
    $curr_param = undef;
}

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

    @filter_expr_stack = ();
    push @filter_expr_stack, [];
}

sub filter_spec_end {
    my $expr = pop @filter_expr_stack;

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

    $curr_spec->filter_spec( $expr->[0] );
}

sub ne_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_ne_expr( %attr, container => $curr_spec );
}
sub ne_end {}

sub eq_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_eq_expr( %attr, container => $curr_spec );
}

sub eq_end {}

sub le_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_le_expr( %attr, container => $curr_spec );
}
sub le_end {}

sub lt_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_lt_expr( %attr, container => $curr_spec );
}
sub lt_end {}

sub ge_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_ge_expr( %attr, container => $curr_spec );
}
sub ge_end {}

sub gt_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_gt_expr( %attr, container => $curr_spec );
}
sub gt_end {}

sub value_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_value_expr( %attr, container => $curr_spec );
}
sub value_end {}

sub match_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_match_expr( %attr, container => $curr_spec );
}
sub match_end {}

sub and_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_and_expr( %attr, container => $curr_spec );

    # Add one level to the stack
    push @filter_expr_stack, []
}

sub and_end {
    my $expr = pop @filter_expr_stack;
    die "and expression must contains at leat one expression\n"
      unless @$expr;

    my $and_level = $filter_expr_stack[$#filter_expr_stack];
    my $and = $and_level->[$#$and_level];
    $and->expr( $expr );
}

sub or_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_or_expr( %attr, container => $curr_spec );

    # Add one level to the stack
    push @filter_expr_stack, []
}

sub or_end {
    my $expr = pop @filter_expr_stack;
    die "or expression must contains at leat one expression\n"
      unless @$expr;

    my $or_level = $filter_expr_stack[$#filter_expr_stack];
    my $or = $or_level->[$#$or_level];
    $or->expr( $expr );
}

sub not_start {
    my ( $expat, $name, %attr ) = @_;

    push @{$filter_expr_stack[$#filter_expr_stack]},
      $the_factory->create_not_expr( %attr, container => $curr_spec );

    # Add one level to the stack
    push @filter_expr_stack, []
}

sub not_end {
    my $expr = pop @filter_expr_stack;
    die "not expression must contains one expression\n"
      unless @$expr == 1;

    my $not_level = $filter_expr_stack[$#filter_expr_stack];
    my $not = $not_level->[$#$not_level];
    $not->expr( $expr->[0] );
}

sub report_calc_spec_start {
    @calc_stack = ();
    push @calc_stack, [];
}

sub report_calc_spec_end {
    my $curr_calc = pop @calc_stack;
    die "report-calc must contains one aggregator (summary, group, timegroup or timeslot or rangegroup)\n"
      unless @$curr_calc == 1;

    $curr_spec->calc_spec( $curr_calc->[0] );
}

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

    # Sort fields attributes can only verified after fields and
    # operations are specified
    push @group_sort_fields, $attr{sort} || '';

    aggregator_start( $expat, $name, @_ );
}

sub group_end {
    my $content = pop @calc_stack;
    my @fields  = grep { UNIVERSAL::isa( $_, "Lire::GroupField" ) } @$content;
    my @ops	= grep { UNIVERSAL::isa( $_, "Lire::GroupOp" ) } @$content;

    die "group must contains at least one field\n"
      unless @fields;
    die "group must contains at least one group operation like min, max, avg, sum, count, etc.\n"
      unless @ops;
    die "group must only contains field and group operation elements\n"
      unless @fields + @ops == @$content;

    my $group_level = $calc_stack[$#calc_stack];
    my $group = $group_level->[$#$group_level];
    $group->group_fields( \@fields );
    $group->ops( \@ops );

    $group->sort_fields( [ split /\s+/, pop @group_sort_fields ] );
}

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

    {
	no strict 'refs';

	my $creator = "create_$name";
	if ( $#calc_stack ) {
	    # Nested
	    my $parent_level = $calc_stack[$#calc_stack - 1];
	    my $parent = $parent_level->[$#$parent_level];

	    push @{$calc_stack[$#calc_stack]},
	      $the_factory->$creator( %attr,
				      report_spec   => $curr_spec,
				      parent	    => $parent );
	} else {
	    # Top-level
	    push @{$calc_stack[$#calc_stack]},
	      $the_factory->$creator( %attr, report_spec => $curr_spec, );
	}
    }
    push @calc_stack, [];
}

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

    my $content = pop @calc_stack;
    my @ops	= grep { UNIVERSAL::isa( $_, "Lire::GroupOp" ) } @$content;

    die "$name must contains at least one group operation like min, max, avg, sum, count, etc.\n"
      unless @ops;
    die "$name must only contains group operations\n"
      unless @ops == @$content;

    my $aggregator_level = $calc_stack[$#calc_stack];
    my $aggregator = $aggregator_level->[$#$aggregator_level];
    $aggregator->ops( \@ops );
}

sub rangegroup_start {
    aggregator_start( @_ );
}

sub rangegroup_end {
    aggregator_end( @_ );
}

sub summary_start {

    die "summary element can be nested in other aggregator\n"
      if $#calc_stack;
    aggregator_start( @_ );
}

sub summary_end {
    aggregator_end( @_ );
}

sub timegroup_start {
    aggregator_start( @_ );
}

sub timegroup_end {
    aggregator_end( @_ );
}

sub timeslot_start {
    aggregator_start( @_ );
}

sub timeslot_end {
    aggregator_end( @_ );
}

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

    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_field( %attr, report_spec => $curr_spec );
}
sub field_end {}

sub sum_start {
    my ( $expat, $name, %attr ) = @_;

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];
    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_sum( %attr,
				 report_spec => $curr_spec,
				 parent => $parent,
			       );
}

sub sum_end {}

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

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

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];
    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_avg( %attr ,
				 report_spec => $curr_spec,
				 parent => $parent,
			       );
}
sub avg_end {}

sub min_start {
    my ( $expat, $name, %attr ) = @_;

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];
    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_min( %attr,
				 report_spec => $curr_spec,
				 parent => $parent,
			       );
}
sub min_end {}

sub max_start {
    my ( $expat, $name, %attr ) = @_;

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];
    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_max( %attr,
				report_spec => $curr_spec,
				parent => $parent,
			      );
}
sub max_end {}

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

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];

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

    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_count( %attr,
				  report_spec => $curr_spec,
				  parent => $parent,
				);
}

sub count_end {}

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

    my $parent_level = $calc_stack[$#calc_stack - 1];
    my $parent = $parent_level->[$#$parent_level];

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

    push @{$calc_stack[$#calc_stack]},
      $the_factory->create_records( %attr,
				    report_spec => $curr_spec,
				    parent => $parent,
				  );
}

sub records_end {}

sub extension_start {
    my ($expat, $name, %attr ) = @_;

    die "missing name attribute"
      unless exists $attr{name};

    my $ext_mod = $attr{name};
    eval "use $ext_mod;";
    die "error loading $ext_mod extension: $@\n" if $@;

    my $ext = eval {
	no strict 'refs';

	$ext_mod->new( %attr );
    };
    die "error creating instance of $ext_mod extension: $@\n" if $@;

    $curr_spec->extension( $ext );
}

sub extension_end {}

sub title_start{
    $curr_title = "";
}

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

    my $lire_spec	= $expat->generate_ns_name( "report-spec", $LRSML_NS );
    my $lire_filter	= $expat->generate_ns_name( "global-filter-spec", 
						    $LRSML_NS );
    my $lire_display	= $expat->generate_ns_name( "display-spec",
						    $LRSML_NS );
    if ($expat->in_element( $lire_spec) || $expat->in_element( $lire_filter)) {
	$curr_spec->title( $curr_title );
    } elsif ( $expat->in_element( $lire_display )) {
	$curr_spec->display_title( $curr_title );
    } else {
	die "encountered unexpected title\n";
    }
}

sub description_start {
    my ( $expat, $name, %attrs ) = @_;
    $curr_target_user   = $attrs{'target-user'};
    $curr_desc	    = "";
}

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

    my $lire_spec	= $expat->generate_ns_name( "report-spec", $LRSML_NS );
    my $lire_filter	= $expat->generate_ns_name( "global-filter-spec", 
						    $LRSML_NS );
    my $lire_param	= $expat->generate_ns_name( "param",	   $LRSML_NS );
    my $lire_display	= $expat->generate_ns_name( "display-spec",
						    $LRSML_NS );

    if ( $expat->in_element( $lire_display )) {
	$curr_spec->display_description( $curr_target_user, $curr_desc );
    } elsif ( $expat->in_element( $lire_param )) {
	$curr_param->description( $curr_desc );
    } elsif ( $expat->in_element( $lire_spec) || 
	      $expat->in_element( $lire_filter)) 
    {
	$curr_spec->description( $curr_desc );
    } else {
	die "encountered unexpected description\n";
    }
}

# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::ReportSpec - 

=head1 SYNOPSIS


=head1 DESCRIPTION

=head1 VERSION

$Id: XMLSpecContainer.pm,v 1.7 2002/08/16 18:23:24 flacoste Exp $

=head1 COPYRIGHT

Copyright (C) 2001 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 or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut
