package Lire::Report::Subreport; use strict; use base qw/ Lire::Report::Group /; use Carp; use POSIX qw/ strftime /; use Lire::DataTypes qw/ check_xml_name check_chart /; use Lire::Utils qw/ xml_encode check_param check_object_param /; use Lire::ReportSpec; =pod =head1 NAME Lire::Subreport - Interface to a Lire subreport. =head1 SYNOPSIS use Lire::ReportParser::ReportBuilder; my $parser = new Lire::ReportParser::ReportBuilder; my $report = $parser->parse( "report.xml" ); foreach my $s ( $report->sections() ) { print "Section: '", $s->title(), "\n\n"; foreach my $r ( $s->subreports() ) { print "Subreport ", $r->title(), " has ", scalar $r->entries(), " entries\n"; } } =head1 DESCRIPTION This module offers an API to the subreports included in the sections of a Lire's report. This object has all the methods that the Lire::Report::Group(3pm) object offers. You'll find more information on to access the data contained in a subreport in that man page. =head1 CONSTRUCTORS =head2 new( $superservice, $type) Creates a new Lire::Report::Subreport object. The $superservice parameter and $type parameters defines the report specification which was used to generate this subreport's data. =cut sub new { my ( $class, $superservice, $type ) = @_; check_param( $superservice, 'superservice', \&check_xml_name, "invalid superservice's name" ); check_param( $type, 'type', \&check_xml_name, 'invalid type' ); return bless( { 'superservice' => $superservice, 'type' => $type, 'entries' => [], 'missing' => 0, 'summary' => {}, 'parent_entry' => undef, 'nrecords' => 0, 'missing_cases' => 0, 'row_idx' => undef, 'title' => undef, 'description' => undef, 'show' => undef, '_schemas' => undef, '_chart_configs' => [], }, $class ); } =pod =head2 new_missing( $superservice, $type, [$reason]) Creates a new Lire::Report::Subreport object marked as missing. The $superservice parameter and $type parameters defines the report specification which was used to generate this subreport's data. The $reason parameter sets the reason why this subreport is missing. =cut sub new_missing { my ( $class, $superservice, $type, $reason ) = @_; check_param( $superservice, 'superservice', \&check_xml_name, "invalid superservice's name" ); check_param( $type, 'type', \&check_xml_name, 'invalid type' ); return bless( { 'superservice' => $superservice, 'type' => $type, 'missing' => 1, 'entries' => [], 'reason' => $reason }, $class ); } =pod =head1 OBJECT METHODS =head2 id( [ $new_id ] ) Returns (and optionnally change) the id of this subreport. The subreport's ID uniquely identify it in its Report. Subreports with the same ID will be merged together. =cut sub id { my ( $self, $id ) = @_; if ( @_ == 2 ) { check_param( $id, 'id', \&check_xml_name, 'ID should be a valid XML name' ); $self->{'_id'} = $id; } return $self->{'_id'}; } =pod =head2 is_missing() Returns true if this subreport was marked as missing in the XML file. A missing subreport is a subreport which was present in the report configure file but which was marked as missing in the XML report. This happens when the report specification requires fields that weren't available in the DLF files generated. It can also happen when an error occurs in the report generation process. =cut sub is_missing { return $_[0]{'missing'}; } =pod =head2 missing_reason() Reports why the subreport is missing. This will be undefined when the subreport is not missing. =cut sub missing_reason { return $_[0]{'reason'}; } =pod =head2 superservice() Returns the superservice of this subreport. This is the superservice that defined the report specification from which the subreport was generated. =cut sub superservice { return $_[0]{'superservice'}; } =pod =head2 type() Returns the type of this subreport. This is the ID of the report specification that was used to generate this subreport. =cut sub type { return $_[0]{'type'}; } =pod =head2 schemas( [ $schema, ... ] ) Returns the schemas used by this Subreport. =cut sub schemas { my $self = shift; if ( @_ ) { $self->{'_schemas'} = [ @_ ]; } if ( ! $self->{'_schemas'} ) { my $spec = Lire::ReportSpec->load( $self->{'superservice'}, $self->{'type'} ); $self->{'_schemas'} = [ @{ $spec->schemas() } ]; } return $self->{'_schemas'}; } =cut =pod =head2 field_schema( $field ) Returns the schema which contain field $field. Returns undef if this name isn't defined in any schema. =cut sub field_schema { my ( $self, $field ) = @_; check_param( $field, 'field' ); foreach my $s ( @{ $self->schemas() } ) { return $s if ( Lire::DlfSchema::load_schema( $s )->has_field( $field)); } return undef; } =pod =head2 chart_configs() Returns an array reference containing Lire::Report::ChartConfig objects specifying the charts that should be generated from this Subreport. =cut sub chart_configs { return $_[0]{'_chart_configs'}; } =pod =head2 add_chart_config( $chart_config ) Adds a Lire::Report::ChartConfig object specifying a chart that should be generated from this Subreport's data. =cut sub add_chart_config { my ( $self, $chart_config ) = @_; check_object_param( $chart_config, 'chart_config', 'Lire::Report::ChartConfig' ); push @{$self->{'_chart_configs'}}, $chart_config; return; } =pod =head2 title( [$title] ) Returns the subreport's title. If the $title is parameter is set, the subreport's title will be set to this new value. =cut sub title { $_[0]{'title'} = $_[1] if defined $_[1]; return $_[0]{'title'}; } =pod =head2 description( [$new_desc] ) Returns this subreport's description. The description is encoded in DocBook XML. If the $description parameter is set, this method will set this subreport's description to this new value. If the $description parameter is undef, that description will be removed. =cut sub description { $_[0]->{'description'} = $_[1] if @_ == 2; return $_[0]->{'description'}; } =pod =head2 table_info( [$table_info] ) Returns the top-level Lire::Report::TableInfo object describing this table layout. If $table_info parameter is set, the subreport table info will be set to this object. =cut sub table_info { my ( $self, $info ) = @_; if ( @_ == 2 ) { croak ( "can't change table_info once entries were added" ) if @{$self->{'entries'}}; check_object_param( $info, 'info', "Lire::Report::TableInfo" ); $self->{'table_info'} = $info; $self->{'group_info'} = $info; } return $self->{'table_info'}; } =pod =head2 nrows() Returns the number of rows in the table. =cut sub nrows { my $self = $_[0]; return $self->{'_nrows'} if defined $self->{'_nrows'}; my $last_idx = $_[0]->_last_row_idx(); return $self->{'_nrows'} = defined $last_idx ? $last_idx + 1 : 0; } =pod =head2 last_row_idx() Returns the index of the last row of data. =cut sub last_row_idx { return $_[0]->nrows() - 1; } =pod =head2 getrow_by_idx( $index ) Returns an array reference containing row 'idx' of the subreport data. A row will contain all the values (categorical and numerical) that would appear on the same row. When an entry is made of categorical variables plus nested groups, the group's summary values will appear on the same row than the categorical variable. Each value is the hash reference that is returned by Entry::data_by_name() for that column and it is in the row at the column's index. =cut sub getrow_by_idx { my ( $self, $idx ) = @_; check_param( $idx, 'idx', qr/^-?[0-9]+$/, "'idx' parameter should be an integer" ); croak "index out of bounds: $idx" if ( $idx < 0 ? $idx < -$self->nrows() : $idx > $self->last_row_idx() ); $idx = $self->nrows() + $idx if $idx < 0; my $row = []; $self->_getrow_by_idx( $idx, $row ); return $row; } =pod =head2 getrows() Returns all rows contained in the subreport. This method is useful for rendering the subreport table. =cut sub getrows { my $self = $_[0]; my @rows; for ( my $i = 0; $i < $self->_last_row_idx() + 1; $i++ ) { push @rows, $self->getrow_by_idx( $i ); } return \@rows; } =pod =head2 finalize() This method should be called after all entries were added. It assign row-idx and computes column width and statistics. =cut sub finalize { my $self = $_[0]; $self->assign_row_indices(); $self->compute_column_info_stats(); $self->{'table_info'}->compute_columns_width(); return; } sub assign_row_indices { my ( $self, $start ) = @_; # Prevent infinite recursion as parent call back this # implementation return $self->SUPER::assign_row_indices( $start ) if defined $start; my $idx = $self->assign_row_indices( -1 ); $self->{'row_idx'} = undef; return $idx; } # Overrides Lire::Report::Group::subreport sub subreport { return $_[0]; } sub write_report { my ( $self, $fh, $indent ) = @_; $fh ||= *STDOUT; my $pfx = ' ' x $indent; my $schemas = join( " ", @{ $self->schemas() } ); if ( $self->{'missing'} ) { print $fh qq!$pfx\n\n!; } else { print $fh qq!$pfx\n!; print $fh "$pfx ", xml_encode( $self->{'title'} ), "\n\n"; if ( $self->description() ) { print $fh "$pfx "; print $fh $self->description(), "\n\n"; } print $fh "$pfx {'show'}; print $fh ">\n"; $self->table_info()->write_report( $fh, $indent + 2 ); $self->write_group_summary( $fh, $indent + 2 ); foreach my $e ( $self->entries() ) { $e->write_report( $fh, $indent + 2 ); } print $fh "$pfx \n"; if ( @{$self->{'_chart_configs'}} ) { print $fh "$pfx \n"; foreach my $cfg ( @{$self->{'_chart_configs'}} ) { $cfg->save_xml( $fh, $indent + 1, 'lrcml:' ); } print $fh "$pfx \n\n"; } print $fh "$pfx\n\n"; } return; } #------------------------------------------------------------------------ # Method delete() # # Remove circular references sub delete { my $self = $_[0]; $self->{'table_info'}->delete() if $self->{'table_info'}; foreach my $e ( $self->entries() ) { $e->delete(); } return; } # keep perl happy 1; __END__ =pod =head1 SEE ALSO Lire::ReportParser::ReportBuilder(3pm) Lire::Report::Section(3pm) Lire::Report::Report(3pm) Lire::Report::Entry(3pm), Lire::Report::Group(3pm), Lire::Report::ChartConfig(3pm) =head1 VERSION $Id: Subreport.pm,v 1.46 2006/07/23 13:16:31 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. =head1 AUTHOR Francis J. Lacoste =cut