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

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

=head1 SYNOPSIS

use Lire::First

=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<sort_fields> 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<field> parameter and the sort order can be passed
in the C<sort_fields> 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 <flacoste@logreport.org>
  Wolfang Sourdeau <wsourdeau@logreport.org>

=head1 VERSION

$Id: First.pm,v 1.15 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