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<lire:missing-subreport id="$self->{'_id'}" superservice="$self->{'superservice'}" type="$self->{'type'}" schemas='$schemas' !,
'reason="', xml_encode( $self->{'reason'} ), qq!"/>\n\n!;
} else {
print $fh qq!$pfx<lire:subreport id="$self->{'_id'}" superservice="$self->{'superservice'}" type="$self->{'type'}" schemas='$schemas'>\n!;
print $fh "$pfx <lire:title>", xml_encode( $self->{'title'} ),
"</lire:title>\n\n";
if ( $self->description() ) {
print $fh "$pfx <lire:description>";
print $fh $self->description(), "</lire:description>\n\n";
}
print $fh "$pfx <lire:table";
print $fh qq! show="$self->{'show'}"!
if defined $self->{'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 </lire:table>\n";
if ( @{$self->{'_chart_configs'}} ) {
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:subreport>\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 <flacoste@logreport.org>
=cut
syntax highlighted by Code2HTML, v. 0.9.1