lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / Last.pm

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 - Lire class that implements the last operator

=head1 SYNOPSIS

 use Lire::Last

=head1 DESCRIPTION

Class that implements the last 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.14 2008/03/09 19:27:31 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