package Lire::First; 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::First =head1 SYNOPSIS FIXME =head1 DESCRIPTION Class that implements the first operator. This operator will output the first 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::First object. The field attribute can be specified in the C parameter and the sort order can be passed in the C parameter. =cut sub new { my ( $class, %params ) = @_; my $self = bless {}, $class; $self->init( %params, 'op' => 'first' ); $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 specification's schemas" unless $self->report_spec()->has_field( $field ); } $self->{'field'} = $field; } $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 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 schema" 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_first_query( $query ); $self->set_missing_cases_aggr_expr( $query ); } sub _build_first_query { my ( $self, $query ) = @_; my @fields = map { sql_quote_name( $_ ) } @{ $self->sql_required_fields()}; $query->add_aggr_field( $self->name(), sprintf( 'lr_first(%s)', join( ",", @fields ))); if ( $self->{'sort_fields'} ) { $query->add_aggr_field( $self->name() . '_key', sprintf( 'lr_first_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 before 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::Last(3pm) =head1 AUTHORS Francis J. Lacoste Wolfang Sourdeau =head1 VERSION $Id: First.pm,v 1.14 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