package Lire::Report::Group; use strict; use Carp; use Lire::Report::Entry; use Lire::Utils qw/ check_param check_object_param tree_apply /; =pod =head1 NAME Lire::Report::Group - Object that include subgroups and other entries. =head1 SYNOPSIS foreach my $e ( $group->entries() ) { # Process entries' data. } =head1 DESCRIPTION The Lire::Report::Group object contains entries grouped together in a subreport. =head1 CONSTRUCTOR You create new Lire::Report::Group object by calling the create_group() method on one Lire::Report::Entry object. =cut sub new { my ( $class, $entry, $group_info ) = @_; check_object_param( $entry, 'entry', 'Lire::Report::Entry' ); check_object_param( $group_info, 'group_info', 'Lire::Report::GroupInfo' ); return bless( { 'type' => 'group', 'entries' => [], 'summary' => {}, 'nrecords' => 0, 'missing_cases' => 0, 'show' => undef, 'parent_entry' => $entry, 'group_info' => $group_info, 'row_idx' => undef }, $class ); } =pod =head1 OBJECT METHODS =head2 parent_entry() Returns the entry in which this goup is contained. This will be undef for the Subreport since it's not contained in any entry. =cut sub parent_entry { return $_[0]{'parent_entry'}; } =pod =head2 group_info() Returns the Lire::Report::GroupInfo which contains the information describing the entries of this group. =cut sub group_info { return $_[0]{'group_info'} } =pod =head2 subreport() Returns the Lire::Report::Subreport object in which this entry is =cut sub subreport { return $_[0]->parent_entry->subreport(); } =pod =head2 row_idx() Returns the row index in the table body where this group's summary should be displayed. If undef, this group isn't displayed. =cut sub row_idx { $_[0]{'row_idx'} = $_[1] if @_ == 2; return $_[0]{'row_idx'}; } sub assign_row_indices { my ( $self, $nrow_idx ) = @_; $self->{'row_idx'} = $nrow_idx++; my $count = 1; foreach my $e ( @{$self->{'entries'}} ) { last if (defined $self->{'show'} && $count > $self->{'show'} ); $e->row_idx( $nrow_idx ); my $max = $nrow_idx; foreach my $group ( $e->data() ) { next unless UNIVERSAL::isa( $group, 'Lire::Report::Group' ); my $tmp_idx = $group->assign_row_indices( $nrow_idx ); $max = $tmp_idx if ($tmp_idx > $max); } $nrow_idx = $max + 1; $count++; } return $nrow_idx - 1; } sub compute_column_info_stats { my $self = $_[0]; $self->_init_chars_stats(); $self->_update_chars_stats(); $self->_finish_chars_stats(); return; } sub _init_chars_stats { my $self = $_[0]; tree_apply( $self->group_info(), sub { return $_[0]->isa( 'Lire::Report::GroupInfo' ) ? [ $_[0]->children() ] : [] }, sub { my $child = $_[0]; $child->init_chars_stats() if $child->isa( 'Lire::Report::ColumnInfo' ); return; } ); return; } sub _update_chars_stats { my $self = $_[0]; my $count = 1; my $max = $self->{'show'}; foreach my $sum ( values %{$self->{'summary'}} ) { $sum->{'col_info'}->update_chars_stats( $sum->{'content'} ); } foreach my $entry ( @{$self->{'entries'}} ) { last if $max && $count++ > $max; foreach my $child ( $entry->data() ) { if ( UNIVERSAL::isa( $child, 'Lire::Report::Group' ) ) { $child->_update_chars_stats(); } else { $child->{'col_info'}->update_chars_stats( $child->{'content'}); } } } return; } sub _finish_chars_stats { my $self = $_[0]; tree_apply( $self->group_info(), sub { return( $_[0]->isa( 'Lire::Report::GroupInfo' ) ? [ $_[0]->children() ] : [] ) }, sub { my $child = $_[0]; $child->finish_chars_stats() if $child->isa( 'Lire::Report::ColumnInfo' ); return; } ); return; } =pod =head2 show( [$show] ) Returns the number of entries that should be displayed in the formatted report. There may be more entries than that in the group. When this parameter is zero or undefined, all available entries should be displayed. If the $show is parameter is set, the group's show parameter will be set to this new value. =cut sub show { $_[0]{'show'} = $_[1] if @_ == 2; return $_[0]{'show'}; } =pod =head2 nrecords( [$n] ) Returns the number of DLF records that were included in this group. =cut sub nrecords { if ( @_ == 2 ) { $_[0]{'nrecords'} = defined $_[1] ? $_[1] : 0; } return $_[0]{'nrecords'}; } =pod =head2 missing_cases( [$n] ) Returns the number of DLF records that contained missing cases which prevent them from being unclude in the subreport. =cut sub missing_cases { if ( @_ == 2 ) { $_[0]{'missing_cases'} = defined $_[1] ? $_[1] : 0; } return $_[0]{'missing_cases'}; } =pod =head2 summary_values() Returns the summary values of this group. This is an array of hash reference like the ones returnes by the values() method described in Lire::Report::Entry(3pm). =cut sub summary_values { my $self = $_[0]; # Sort the columns according to column info's index. return sort { $a->{'col_info'}->index() <=> $b->{'col_info'}->index() } values %{$self->{'summary'}}; } =pod =head2 get_summary_value( $name ) Returns the summary value of the operator $name. This is an hash reference like is returned by the values() method described in Lire::Report::Entry(3pm). Returns undef if the summary value wasn't computed for operator $name. =cut sub get_summary_value { return $_[0]->{'summary'}{$_[1]}; } =pod =head2 set_summary_value( $name, %value ) Sets the value of the operator $name computed over all the DLF records of the group. Consult the add_value() method in Lire::Report::Entry(3pm) for information on the parameters. =cut sub set_summary_value { my ( $self, $name, %value ) = @_; check_param( $name, 'name' ); $value{'content'}= "" unless defined $value{'content'}; $value{'value'}= $value{'content'} unless defined $value{'value'}; my $info = $self->{'group_info'}->column_info_by_name( $name ); croak "there is no column named '$name'" unless $info; croak( "Operator $name is an aggregator" ) unless $info->isa( "Lire::Report::ColumnInfo" ); $value{'type'} = 'value'; $value{'col_info'} = $info; $value{'n'} = undef unless exists $value{'n'}; $value{'total'} = undef unless exists $value{'total'}; $value{'missing_cases'} = 0 unless defined $value{'missing_cases'}; $self->{'summary'}{$name} = \%value; return; } =pod =head2 entries() Returns the entries in the group. =cut sub entries { return @{$_[0]{'entries'}}; } =pod =head2 create_entry() Adds a data entry to this group. This will create a new Lire::Report::Entry object which can then be filled with data. =cut sub create_entry { my $self = $_[0]; my $entry = new Lire::Report::Entry( $self ); push @{$self->{'entries'}}, $entry; return $entry; } =pod =head2 find_entry( $name, $dlf ) =cut sub find_entry { my ( $self, $name, $dlf ) = @_; my $key_names = $self->{'group_info'}->categorical_names(); foreach my $n ( @$key_names ) { return undef if ! defined $dlf->{$n}; } my $entry = undef; ENTRY: foreach my $e ( @{$self->{'entries'}} ) { foreach my $n ( @$key_names ) { next ENTRY unless ( $e->data_by_name( $n )->{'value'} eq $dlf->{$n} ); } $entry = $e; last ENTRY; } return undef unless defined $entry; return $entry if $name eq $self->{'group_info'}->name(); return $self->_find_entry_in_group_children( $name, $dlf, $entry ); } sub _find_entry_in_group_children { my ( $self, $name, $dlf, $entry ) = @_; foreach my $c ( $entry->data() ) { if ( UNIVERSAL::isa( $c, 'Lire::Report::Group' ) ) { my $e = $c->find_entry( $name, $dlf ); return $e if defined $e; } } return undef; } # ------------------------------------------------------------------------ # Method write_report( [$fh, [$index]] ) # sub write_report { my ( $self, $fh, $indent ) = @_; $fh ||= *STDOUT; my $pfx = ' ' x $indent; print $fh $pfx, "{'show'}; print $fh ">\n"; $self->write_group_summary( $fh, $indent + 1); foreach my $e ( $self->entries ) { $e->write_report( $fh, $indent + 1 ); } print $fh $pfx, "\n"; return; } # # helper method for Lire::Report::Subreport::last_row_idx() # sub _last_row_idx { my $self = $_[0]; my $i = $#{$self->{'entries'}}; while ( $i >= 0 ) { my $last_idx = $self->{'entries'}[$i]->_last_row_idx(); return $last_idx if defined $last_idx; $i--; } return undef; } # # helper method for Lire::Report::Subreport::getrow_by_idx # sub _getrow_by_idx { my ( $self, $idx, $row ) = @_; for ( my $i = $#{$self->{'entries'}}; $i >= 0; $i-- ) { next unless defined $self->{'entries'}[$i]->row_idx(); if ( $self->{'entries'}[$i]->row_idx() <= $idx ) { $self->{'entries'}[$i]->_getrow_by_idx( $idx, $row ); return; } } return; } # ------------------------------------------------------------------------ # write_group_summary( $fh, $indent ) # # Write the group-summary element for this group sub write_group_summary { my ( $self, $fh, $indent ) = @_; my $pfx = ' ' x $indent; print $fh $pfx, qq!{'row_idx'}; print $fh ">\n"; foreach my $value ( $self->summary_values() ) { Lire::Report::Entry::write_value( $fh, $pfx . ' ', $value ); } print $fh $pfx, "\n"; return; } #------------------------------------------------------------------------ # Method delete() # # Remove circular references sub delete { my $self = $_[0]; $self->{'group_info'}->delete(); foreach my $entry ( @{$self->{'entries'}} ) { $entry->delete(); } %$self = (); return; } # keep perl happy 1; __END__ =pod =head1 SEE ALSO Lire::ReportParser::ReportBuilder(3pm) Lire::Report(3pm) Lire::Report::Subreport(3pm) Lire::Report::Entry(3pm) Lire::Report::ChartConfig(3pm) Lire::Report::Section(3pm) =head1 VERSION $Id: Group.pm,v 1.33 2006/07/23 13:16:31 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2002 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