package Lire::Aggregate; use strict; use base qw/ Lire::ReportOperator /; use Carp; use Lire::DataTypes qw/ check_field /; use Lire::ReportOperator; use Lire::Utils qw/ sql_quote_name check_param /; =pod =head1 NAME Lire::Aggregate - Base class for all operators that compute values from a group of DLF records =head1 SYNOPSIS use Lire::Aggregate; use base qw/ Lire::Aggregate /; =head1 DESCRIPTION The Lire::Aggregate is the base class of all operators that computes values from a group of DLF records. These are the operators that are used inside aggregators. This package also defines most of the classes that represents the group operators available in Lire report specification. =head1 METHODS FOR SUBCLASSES OF Aggregate =head2 init( %params ) Two supplemental parameters are needed for Aggregates: =over =item parent The Lire::Aggregator which contain this Aggregate. =item name The identifier that can be used to find this operator in the report specification. It will be returned by the name() method. =back =cut sub init { my ( $self, %params ) = @_; check_param( $params{'parent'}, 'parent' ); check_param( $params{'name'}, 'name' ); $self->SUPER::init( %params ); $self->set_name( $params{'name'} ); return; } =pod =head2 print( $fh, $prefix) This methods implements the print() method required by Lire::ReportOperator. It prints an empty XML element named after op(). It also takes care of writing the name and label attributes. Other attributes can be added to the XML element by overriding the xml_attrs() method. =cut sub print { my ($self,$fh, $prefix) = @_; $fh ||= \*STDOUT; $prefix ||= 0; my $pfx = " " x $prefix; my $attrs = $self->xml_attrs; print $fh $pfx, "op, ' name="', $self->name, '"'; print $fh qq{ label="$self->{'label'}"} if $self->{'label'}; print $fh $attrs if length $attrs; print $fh "/>\n"; } =pod =head2 xml_attrs() This method can be used to write additional XML attributes. The returned string will be output in the XML element. =cut sub xml_attrs { return ""; } # Implemented Lire::ReportOperator::name sub name { return $_[0]{'name'}; } =pod =head2 set_name( $name ) Changes this operator's name. =cut sub set_name { my ( $self, $name ) = @_; check_param( $name, 'name', \&check_field, 'invalid field name' ); croak "name '$name' is already defined" if defined $self->{'name'} && $name ne $self->{'name'} && $self->last_parent->is_name_defined( $name ); $self->{'name'} = $name; return; } =pod =head2 create_numerical_info( $group_info ) Subclass must implement this method. The $group_info parameter is a Lire::Report::GroupInfo object to which the operator implementation should add the appropriate ColumnInfo object to represent the data generated by the aggregate. =cut sub create_numerical_info { croak( "unimplemented create_numerical_info() method in ", ref $_[0] ); } =pod =head2 build_query( $query ) FIXME. Provides a default implementation of build_query =cut sub build_query { my ( $self, $query ) = @_; $query->add_aggr_field( $self->name(), $self->sql_aggr_expr() ); $self->set_missing_cases_aggr_expr( $query ); return; } =pod =head2 set_missing_cases_aggr_expr( $query ) Adds the aggregate expression to compute the number of missing cases based on the required fields returned by the sql_required_fields() method. The method set_missing_cases_value() can be used to set the value from the returned DLF row. =cut sub set_missing_cases_aggr_expr { my ( $self, $query ) = @_; my $req_fields_expr = join( ",", map { sql_quote_name( $_ ) } @{$self->sql_required_fields} ); $query->add_aggr_field( '_lr_' . $self->name() . '_mc', sprintf( 'lr_missing_cases(%s)', $req_fields_expr ) ); return; } =pod =head2 set_missing_cases_value( $row, $value ) Sets the missing-cases value in $value to the value computed by the expression sets using set_missing_cases_aggr_expr(). =cut sub set_missing_cases_value { my ( $self, $row, $value ) = @_; $value->{'missing_cases'} = $row->{'_lr_' . $self->name() . '_mc'}; return; } =pod =head2 sql_aggr_expr() Method used by the default implementation of build_query(). It should return the SQL agregate expression that should be associated to this Aggregate's name. For example, a simple Count implementation could have returned 'count(*)' here. =cut sub sql_aggr_expr { croak( "unimplemented sql_aggr_expr() method in ", ref $_[0] ); } =pod =head2 sql_required_fields() Method used by the set_missing_cases_aggr_expr() to sets an aggregate expression that will return the number of missing cases for this aggregate. It should returns a list of fields that will create a missing case when a value is NULL. =cut sub sql_required_fields { croak( "unimplemented sql_required_fields() method in ", ref $_[0] ); } =pod =head2 create_value( $parent_group, $row ) Method that is used by Aggregator when building the report table. The report should return an hash reference with the appropriate keys set. Consult Lire::Report::Entry(3pm) for details. The $parent_group parameter is the Lire::Report::Group to which the value is added. This will be the table or containing group for values added to Entries, and it will be the Group's parent when creating a summary value. The $row parameter is an hash ref containing the DlfResult row for which the value should be created. Implementation should use the set_missing_cases_value() method to set the value's 'missing_cases' attribute. =cut sub create_value { croak( "unimplemented create_value() method in ", ref $_[0] ); } # Defines Lire::ReportOperator::init_merge() sub init_merge {} # Defines Lire::ReportOperator::end_merge() sub end_merge {} # OPTIMIZATION OF THE DATA STRUCTURE #. # Scalar ref takes less place then array refs which takes less spec # then hash ref. We use only scalar or array refs. # # As a side effects, we also get a little speed optimization : # perl -MBenchmark=cmpthese -e ' # my $dummy = 0; # my $scalar = \$dummy; # my $array = [0]; # my $hash = { 'value' => 0}; # cmpthese( 500000, { # 'SCALAR' => sub { $$scalar++ }, # 'ARRAY' => sub { $array->[0]++ }, # 'HASH' => sub { $hash->{'value'}++ }, # }); # Benchmark: timing 500000 iterations of ARRAY, HASH, SCALAR... # ARRAY: 0 wallclock secs ( 0.57 usr + 0.00 sys = 0.57 CPU) @ 877192.98/s (n=500000) # HASH: 1 wallclock secs ( 0.67 usr + 0.00 sys = 0.67 CPU) @ 746268.66/s (n=500000) # SCALAR: 1 wallclock secs ( 0.41 usr + 0.00 sys = 0.41 CPU) @ 1219512.20/s (n=500000) # Rate HASH ARRAY SCALAR # HASH 746269/s -- -15% -39% # ARRAY 877193/s 18% -- -28% # SCALAR 1219512/s 63% 39% -- # # Make default implementation uses a scalar reference # Implements Lire::ReportOperator::init_group_data sub init_group_data { my $scalar = 0; return \$scalar; } # Implements Lire::ReportOperator::end_group_data sub end_group_data {} # Implements Lire::ReportOperator::add_entry_value sub add_entry_value { my ( $self, $entry, $data ) = @_; my $v = $self->create_value( $entry->group(), $self->data2dlf( $data ) ); $entry->add_value( %$v ); return; } # Method used by Lire::Aggregator:: to dispath to # Lire::*::create_value() sub data2dlf { croak "Unimplemented data2dlf() in ", ref $_[0]; } #------------------------------------------------------------------------ # missing_cases( $data ) # # This method returns the number of missing-cases encountered # while processing $data. sub missing_cases { my ( $self, $data ); return 0 unless ( defined $self->{'_missing_cases'} && defined $self->{'_missing_cases'}{$data} ); return $self->{'_missing_cases'}{$data}; } # keep perl happy 1; __END__ =head1 SEE ALSO Lire::ReportSpec(3pm), Lire::ReportOperator(3pm), Lire::Aggregator(3pm). =head1 AUTHORS Francis J. Lacoste Wolfgang Sourdeau =head1 VERSION $Id: Aggregate.pm,v 1.16 2006/07/23 13:16:27 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2001-2003 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