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

package Lire::Sum;

use strict;

use base qw/ Lire::SimpleStat /;

use Carp;

use Lire::DataTypes qw/ is_numeric_type format_numeric_type/;
use Lire::Utils qw/ ratio100 sql_quote_name /;

=pod

=head1 NAME

Lire::Sum - Lire class that implements the sum operator

=head1 SYNOPSIS

 use Lire::Sum

=head1 DESCRIPTION

Class that implements the sum operator. This operator will compute the
field's sum in a group of DLF records.

It's possible to compute a weighted sum in which each value is first
multiplied by the value of another DLF field.

Its also possible to express the count as a ratio of the total count
for the group or table.

=head1 METHODS

=head2 new( %params )

Creates a new Lire::Count object. In addition to the values
supported by its parents, the weight and ratio attributes will be
initialized to the values specified in the %params argument.

=cut

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self  = bless { 'ratio' => 'none', }, $class;

    $self->init( @_, 'op' => "sum" );

    my %args = @_;
    $self->weight(  $args{'weight'} )
      if exists $args{'weight'};

    $self->ratio(  $args{'ratio'} )
      if exists $args{'ratio'};

    return $self;
}

=pod

=head2 weight( [$new_weight] )

Returns the DLF field's name by which the values will be multiplied
before being summed.

You can change the weight field by specifying a new name as the
$new_weight parameter. Use undef to remove the use of a weighting
field.

=cut

sub weight {
    my ( $self, $weight ) = @_;

    if ( @_ == 2 ) {
	if ( defined $weight ) {
	    croak "'$weight' isn't a defined field in the specification's schema"
		unless $self->report_spec()->has_field( $weight );

	    croak "$weight isn't a numeric type",
	      unless is_numeric_type( $self->report_spec()->field( $weight )->type );

	}

	$self->{'weight'} = $weight;
    }

    $self->{'weight'};
}

=pod

=head2 ratio([$new_ratio])

Returns how the sum will be expressed. This can one of three possible
values:

=over

=item none

Default. The absolute sum will be used.

=item group

The sum will be expressed as a percentage of the group's sum.

=item table

The sum will be expressed as a percentage of the table's total sum.

=back

=cut

sub ratio {
    my ( $self, $ratio ) = @_;

    if ( @_ == 2 ) {
	croak "invalid value for ratio attribute: $ratio, should be one of none, group or table"
	  unless $ratio =~ /^(none|group|table)$/;

	$self->{'ratio'} = $ratio;
    }
    $self->{'ratio'};
}

#------------------------------------------------------------------------
# Method xml_attrs()
#
# Implementation needed by Lire::Aggregate
sub xml_attrs {
    my ($self) = @_;

    my $attr = $self->SUPER::xml_attrs;

    $attr .= qq{ weight="$self->{'weight'}"}
      if defined $self->{'weight'};

    $attr .= qq{ ratio="$self->{'ratio'}"};

    $attr;
}

# Implements Lire::SimpleStat::sql_aggr_expr
sub sql_aggr_expr {
    my $self = $_[0];

    my $sum_expr =  sql_quote_name( $self->{'field'} );
    $sum_expr .= "*" . sql_quote_name( $self->{'weight'} )
      if defined $self->{'weight'};

    return 'sum(' . $sum_expr . ')';
}

# Overrides Lire::SimpleStat::sql_required_fields
sub sql_required_fields {
    my $self = $_[0];
    my @fields = ( $self->{'field'} );
    push @fields, $self->{'weight'}
      if defined $self->{'weight'};

    return \@fields;
}

# Implements Lire::Aggregate::create_value()
sub create_value {
    my ( $self, $parent_group, $row ) = @_;

    my %value;
    my $name = $self->name();
    $value{'value'} = $row->{$name};
    $self->set_missing_cases_value( $row, \%value );

    if ( $self->{'ratio'} eq 'none' ) {
        $value{'content'} =
          format_numeric_type( $row->{$name}, $self->dlf_field()->type() );
    } else {
        my $group_sum = $self->_get_ratio_denominator( $parent_group );;
        my $total = defined $group_sum->{'value'} ?
            $group_sum->{'value'} : $row->{$name};
        $value{'content'} = ratio100( $row->{$name}, $total );
    }

    return \%value;
}

sub _get_ratio_denominator {
    my ( $self, $parent_group ) = @_;

    return ( $self->{'ratio'} eq 'table' || ! $parent_group->parent_entry() )
      ? $parent_group->subreport()->get_summary_value( $self->name())
      : $parent_group->get_summary_value( $self->name() );
}

# Implements Lire::ReportOperator::merge_group_data()
sub merge_group_data {
    my ( $self, $value, $data ) = @_;

    # To merge two sums, we simply add them
    $$data += $value->{'value'};

    return;
}

# Implements Lire::Aggregate::data2dlf()
sub data2dlf {
    my ($self, $data) = @_;

    my $name = $self->name();
    return { "$name" => $$data,
             "_lr_${name}_mc" => $self->missing_cases( $data ),
           };
}

# keep perl happy
1;

__END__

=head1 SEE ALSO

zLire::ReportSpec(3pm), Lire::ReportOperator(3pm), Lire::Aggregator(3pm), Lire::Aggregate(3pm).

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: Sum.pm,v 1.17 2008/03/09 19:27:31 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001, 2002 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