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<sort_fields> 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 <flacoste@logreport.org>
Wolfgang Sourdeau <wsourdeau@logreport.org>
=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
syntax highlighted by Code2HTML, v. 0.9.1