package Lire::Last; use strict; use base qw/ Lire::SimpleStat /; use Carp; use Lire::Utils qw/ sql_quote_name check_object_param /; use Lire::DataTypes qw/ is_numeric_type /; =pod =head1 NAME Lire::Last =head1 SYNOPSIS FIXME =head1 DESCRIPTION Class that implements the first operator. This operator will output the last value appearing in its field when the DLF records are sorted according to the C attribute. The default sort order is the default timestamp sort. =head1 METHODS =head2 new( %params ) Creates a new Lire::Last object. =cut sub new { my ( $class, %params ) = @_; my $self = bless {}, $class; $self->init( %params, 'op' => 'last' ); $self->sort_fields( $params{'sort_fields'} ); return $self; } #------------------------------------------------------------------------ # Method field( [$field] # # Overrides Lire::SimpleStat one since the field doesn't have # to be numeric. sub field { my ( $self, $field ) = @_; if ( @_ == 2 ) { if ( defined $field ) { croak "'$field' isn't a defined field in the specifcation's schemas" unless $self->report_spec()->has_field( $field ); } $self->{'field'} = $field; } return $self->{'field'}; } =pod =head2 sort_fields( [$new_sort_fields] ) Returns the fields that are going to be used to sort the DLF records. This a reference to an array of DLF field names. If the $new_sort_fields parameter is set, it will be used as the new sort order. It must be an array reference and should only contains valid field names for the current report specification's schema. When no sort_fields are set, the default is to use the default timestamp field. =cut =cut sub sort_fields { my ($self, $sort_fields) = @_; if ( @_ == 2 ) { if ( defined $sort_fields ) { check_object_param( $sort_fields, 'sort_fields', 'ARRAY' ); foreach my $f ( @$sort_fields ) { croak "'$f' isn't a defined field in the specification's schemas" unless $self->report_spec()->has_field( $f ); } } $self->{'sort_fields'} = $sort_fields; } return $self->{'sort_fields'}; } #------------------------------------------------------------------------ # Method xml_attrs() # # Implementation needed by Lire::Aggregate sub xml_attrs { my ($self) = @_; my $attr = $self->SUPER::xml_attrs; if ( exists $self->{'sort_fields'} ) { my $sort_fields = join " ", @{$self->{'sort_fields'}}; $attr .= qq{ sort="$sort_fields"}; } return $attr; } # Overrides Lire::SimpleStat::sql_required_fields sub sql_required_fields { my $self = $_[0]; my @fields = ( $self->{'field'} ); push @fields, @{ $self->{'sort_fields'} } if defined $self->{'sort_fields'}; return \@fields; } # Overrides Lire::Aggregate::build_query sub build_query { my ( $self, $query ) = @_; $self->_build_last_query( $query ); $self->set_missing_cases_aggr_expr( $query ); } sub _build_last_query { my ( $self, $query ) = @_; my @fields = map { sql_quote_name( $_ ) } @{ $self->sql_required_fields()}; $query->add_aggr_field( $self->name(), sprintf( 'lr_last(%s)', join( ",", @fields ))); if ( $self->{'sort_fields'} ) { $query->add_aggr_field( $self->name() . '_key', sprintf( 'lr_last_key(%s)', join( ",", @fields ))); } return; } # Overrides Lire::SimpleStat::create_value sub create_value { my ( $self, $parent_group, $row ) = @_; my $v = $self->SUPER::create_value( $parent_group, $row ); if ( ! is_numeric_type( $self->dlf_field()->type() ) ) { $v->{'content'} = $row->{ $self->name() }; } $v->{'total'} = $row->{ $self->name() . "_key" }; return $v; } # Implements Lire::ReportOperator::init_merge() sub init_merge { my $self = $_[0]; $self->SUPER::init_merge(); my $sort_fields = $self->sort_fields(); unless ( $sort_fields && @$sort_fields ) { $sort_fields = [ $self->report_spec()->schema()->timestamp_field()->name() ]; } my @cmp = (); my $i = 0; foreach my $f ( @$sort_fields ) { my $type = $self->report_spec()->schema()->field( $f )->type(); my $cmp = is_numeric_type( $type ) ? '<=>' : 'cmp'; push @cmp, "\$_[0][$i] $cmp \$_[1][$i]"; $i++; } my $sort_code = "sub { " . join( " && ", @cmp ) . " }"; $self->{'sort_func'} = eval $sort_code; croak "failed to compile sort function ($sort_code): $@" if $@; $self->{'total_func'} = sub { return defined $_[0] ? join( " ", @{$_[0]} ) : ''; }; return; } # Implements Lire::ReportOperator::init_group_data() sub init_group_data { return []; } # Implements Lire::ReportOperator::merge_group_data() sub merge_group_data { my ( $self, $value, $data ) = @_; return unless $value->{'total'}; my $fields = [ split / /, $value->{'total'} ]; unless (defined $data->[0]) { $data->[0] = $value->{'value'}; $data->[1] = $fields; return; } # Change the value only if the fields sorts after the last one if ( $self->{'sort_func'}->( $fields, $data->[1] ) > 0 ) { $data->[0] = $value->{'value'}; $data->[1] = $fields; } return; } # Implements Lire::Aggregate::data2dlf() sub data2dlf { my ($self, $data) = @_; my $name = $self->name(); return { "$name" => $data->[0], "${name}_key" => $self->{'total_func'}->( $data->[1] ), "_lr_${name}_mc" => $self->missing_cases( $data ), }; } # keep perl happy 1; __END__ =head1 SEE ALSO Lire::ReportSpec(3pm), Lire::ReportOperator(3pm), Lire::Aggregator(3pm), Lire::Aggregate(3pm), Lire::First(3pm) =head1 AUTHORS Francis J. Lacoste Wolfgang Sourdeau =head1 VERSION $Id: Last.pm,v 1.13 2006/07/23 13:16:29 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