lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / ReportSpec.pm

package Lire::ReportSpec;

use strict;

use base qw/ Lire::XMLSpecContainer /;

use Carp;

use Lire::Config;
use Lire::DataTypes qw/ check_xml_name /;
use Lire::XMLSpecContainer;
use Lire::Report::Subreport;
use Lire::Report::TableInfo;
use Lire::PluginManager;
use Lire::Utils qw/ check_param check_object_param /;

=pod

=head1 NAME

Lire::ReportSpec - API to the XML report specifications.

=head1 SYNOPSIS

    use Lire::ReportSpec;

=head1 DESCRIPTION

=head1 META INFORMATION METHODS

=head2 list_specs( $superservice )

Returns an array reference containing all the report specification
type available for the $superservice superservice.

=head2 has_spec( $superservice, $type )

Returns true if there is a $type specification available for the
$superservice.

=cut


########################################################################
#                        Lire::XMLSpecContainer METHODS
########################################################################

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

    return "report-spec";
}

sub spec_path {
    return Lire::Config->get( 'lr_reports_path' );
}

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

    my $pfx = ' ' x $indent;

    if ( defined $self->{'filter_spec'} ) {
        print $fh "$pfx<lire:filter-spec>\n";
        $self->{'filter_spec'}->print( $fh, $indent + 1);
        print $fh "\n$pfx</lire:filter-spec>\n\n";
    }

    if ( defined $self->{'_chart_configs'} || $self->{'charttype'} ) {
        print $fh "$pfx<lire:chart-configs>\n";
        foreach my $cfg ( @{$self->chart_configs()} ) {
            $cfg->save_xml( $fh, $indent + 1, 'lrcml:' );
        }
        print $fh "$pfx</lire:chart-configs>\n\n";
    }

    print $fh "$pfx<lire:report-calc-spec>\n";
    $self->{'calc_spec'}->print( $fh, $indent + 1 );
    print $fh "$pfx</lire:report-calc-spec>\n";
}

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

    my $spec = $self->SUPER::new_from_config( $value );

    $spec->subreport_id( $value->get( 'id' )->as_value() );
    $spec->{'_chart_configs'} = [];
    foreach my $cfg ( @{$value->get( 'charts' )->as_value()} ) {
        $spec->add_chart_config( $cfg );
    }

    return $spec;
}

=pod

=head1 OBJECT METHODS

=head2 subreport_id( [ $new_subreport_id ] )

Returns (and optionnally change) the id that will be associated
to the Subreport that will be generated by this specification.

=cut

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

    if ( defined $id ) {
        check_param( $id, 'subreport_id', \&check_xml_name );

	$self->{'_subreport_id'} = $id;
    }
    return $self->{'_subreport_id'};
}

sub charttype2chart_config {
    my ( $charttype, $id, $table_info ) = @_;

    check_param( $charttype, 'charttype', qr/^(histogram|pie|lines|bars)$/ );
    check_object_param( $table_info, 'table_info', 'Lire::Report::TableInfo' );

    my $cfg = new Lire::Report::ChartConfig();
    $cfg->basename( $id );

    my ( $name_col, $value_col );
    foreach my $col ( $table_info->column_infos() ) {
        $name_col = $col->name()
          if ! $name_col && $col->class() eq 'categorical';
        $value_col = $col->name()
          if ! $value_col && $col->class() eq 'numerical';
        last if $name_col && $value_col;
    }
    $cfg->get( 'case_var' )->set( $name_col );
    if ( $charttype eq 'pie' ) {
        $cfg->type( Lire::PluginManager->get_plugin( 'chart_type', 'pie' ) );
        $cfg->type_properties()->get( 'values' )->set( $value_col );
    } elsif ( $charttype eq 'lines' ) {
        $cfg->type( Lire::PluginManager->get_plugin( 'chart_type', 'lines' ) );
        $cfg->type_properties()->get( 'y' )->set( $value_col );
    } else {
        $cfg->type( Lire::PluginManager->get_plugin( 'chart_type', 'vbars' ) );
        $cfg->type_properties()->get( 'y' )->set( $value_col );
    }

    return $cfg;
}

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

    return undef unless $self->{'charttype'};

    return charttype2chart_config( $self->{'charttype'},
                                   $self->subreport_id(),
                                   $self->create_table_info() );
}

=pod

=head2 chart_configs()

Returns an array reference containing the Lire::Report::ChartConfig
objects that specifies the charts that should be generated when the
Lire::Report::Subrpeport object specified by this object will be
formatted.

=cut

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

    if ( $self->{'_chart_configs'} ) {
        return $self->{'_chart_configs'};
    } else {
        my $cfg = $self->default_chart_config();
        return $cfg ? [ $cfg ] : [];
    }
}

=pod

=head2 add_chart_config( $chart_config )

Adds a Lire::Report::ChartConfig object that should be added to the
Lire::Report::Subreport object that is specified by this object.

=cut

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

    check_object_param( $chart_config, 'chart_config',
                        'Lire::Report::ChartConfig' );

    $self->{'_chart_configs'} ||= [];
    push @{$self->{'_chart_configs'}}, $chart_config;

    return;
}

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

    if ( @_ == 2 ) {
        if ( $chart) {
            check_param( $chart, 'chart' );
            $self->{'charttype'} = $chart;
        } else {
            delete $self->{'charttype'};
        }
    }

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

=pod

=head2 filter_spec( [ $new_filter_spec ] )

Returns (and optionally changes) the Lire::FilterExpr that should be
applied to create the Lire::Report::Subreport specified by this
object. This will be undef if no filtering should be applied.

=cut

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

    if ( @_ == 2 ) {
        if ( defined $filter_spec ) {
            check_object_param( $filter_spec, 'filter_spec', 
                                'Lire::FilterExpr' );
            $self->{'filter_spec'} = $filter_spec;
        } else {
            delete $self->{'filter_spec'};
        }
    }

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

=pod

=head2 calc_spec( [ $new_aggregator ] )

Returns (and optionally changes) the Lire::Aggregator that should be
used to create the Lire::Report::Subreport specified by this object.

=cut

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

    if ( @_ == 2 ) {
        check_object_param( $calc_spec, 'calc_spec', 'Lire::Aggregator' );
        $self->{'calc_spec'} = $calc_spec;
    }

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

=pod

=head2 mark_missing( $reason )

Mark that the report that should be generated by this report
specification should be marked as missing. The $reason parameter gives
the reason why the subreport will be missing.

=cut

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

    $self->{'missing'} = $reason;

    return;
}

=pod

=head2 is_missing()

Returns true if the subreport generated by this report specification
should be marked missing.

=cut

sub is_missing {
    return defined $_[0]{'missing'};
}

=pod

=head2 set_store( $store )

Sets the DLF store upon which this ReportSpec will be generated when
create_subreport() will be called.

=cut

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

    check_object_param( $store, 'store', 'Lire::DlfStore' );

    croak "store doesn't contain a '", $self->schema()->id(), "' DLF stream "
      unless $store->has_dlf_stream(  $self->schema()->id() );

    $self->calc_spec()->_set_store( $store );

    return;
}

=pod

=head2 create_subreport()

Creates a Lire::Report::Subreport object based on this report
specification. This will be a missing subreport if the mark_missing()
method was called.

Called by Lire::ReportSection::create_report_section().

=cut

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

    if ( $self->{'missing'} ) {
        my $sub = new_missing Lire::Report::Subreport( $self->superservice(),
                                                       $self->id(),
                                                       $self->{'missing'} );
        $sub->id( $self->subreport_id() );
        $sub->schemas( @{$self->schemas()} );
        return $sub;
    }

    my $subreport = new Lire::Report::Subreport( $self->superservice(),
                                                 $self->id() );
    $subreport->id( $self->subreport_id() );
    $subreport->schemas( @{$self->schemas()} );
    $subreport->title( $self->expanded_display_title() );

    foreach my $cfg ( @{$self->chart_configs()} ) {
        $subreport->add_chart_config( $cfg->clone() );
    }
    $subreport->description( $self->expanded_display_description() );

    $subreport->table_info( $self->create_table_info() );

    $self->calc_spec()->create_entries( $subreport );
    $subreport->finalize();

    return $subreport;
}

=pod

=head2 create_table_info()

Returns a Lire::Report::TableInfo object that describes the table
generated by subreport of this type.

=cut

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

    my $info = new Lire::Report::TableInfo();

    $self->calc_spec()->create_group_info( $info );
    $info->compute_group_layout();

    return $info;
}

1;

__END__

=pod

=head1 SEE ALSO

  Lire::FilterSpec(3pm), Lire::ReportConfig(3pm),
  Lire::ReportSection(3pm)

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: ReportSpec.pm,v 1.59 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