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

package Lire::Timeslot;

use strict;

use base qw/ Lire::Aggregator /;

use Carp;
use POSIX qw/ setlocale strftime LC_TIME /;

use Lire::Aggregator;
use Lire::DataTypes qw/ check_duration 
                        duration2sec minutely_duration hourly_duration
                        daily_duration weekly_duration monthly_duration /;
use Lire::Utils qw/ sql_quote_name /;
use Lire::WeekCalculator;

use vars qw/ @MONTHS @DAYS  %unit_index /;

BEGIN {
    @MONTHS = qw/January February March
                 April   May      June
                 July    August   September
                 October November December/;

    @DAYS =  qw/Sunday   Monday Tuesday  Wednesday
                Thursday Friday Saturday/;

    %unit_index = ( 'h' => 2,
                    'd' => 6,
                    'M' => 4,
                    'm' => 1,
                    's' => 0 );
}

=pod

=head1 NAME

Lire::Timegroup - Base class for implementation of the timeslot
aggregator

=head1 SYNOPSIS

    use Lire::Timeslot;

=head1 DESCRIPTION

This module is the base class for implementation of the timeslot
aggregator. This aggregator will split the DLF records based on a unit
of time. For example, if the unit is 1h, all DLF records occuring on
the same hour of day (independant of the day on which it occurs) are
grouped together.

=head1 CONSTRUCTOR

=head2 new( %params )

Creates a new instance of a timegroup aggregator. In addition to the
normal report operator parameters, the timegroup aggregator can take
several parameters:

=over

=item field

This optional parameter contains the DLF field which contains the time
value used to group the DLF records together. See the field() method
for more information.

=item unit

This mandatory parameter should contains the time unit that will be
used to group the records. See the unit() method for more information.

=back

=cut

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

    my %params = @_;

    croak( "Missing unit parameter" )
      unless exists $params{'unit'};

    my $self = bless {}, $class;
    $self->SUPER::init( %params, 'op' => "timeslot" );

    $self->field( $params{'field'} );
    $self->unit( $params{'unit'} );

    return $self;
}

=pod

=head1 METHODS

=head2 field( [$new_field] )

Returns the DLF field's name that is used to group the DLF records.
This should be a valid timestamp DLF field in the current schema. By
default, the default timestamp field of the DLF schema is used.

You can change the field by passing a $new_field parameter.

=cut

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

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

	    croak "'$field' isn't a timestamp field"
	      unless $self->report_spec()->field( $field )->type()
		eq "timestamp";

	} else {
	    $field = $self->report_spec()->schema()->timestamp_field()->name();
	}
	$self->{'field'} = $field;
    }

    return $self->{'field'};
}

=pod

=head2 unit( [$new_unit])

Returns the time unit that will be used to group the DLF records. The
unit is expressed as a duration value (for example 1s), but it should
be noted that this will group the records based on the second unit of
the DLF record's timestamp value. It could also be the name of a
report specification's parameter containing a duration value.

The time unit can be changed by using the $new_unit parameter.

=cut

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

    if (@_ == 2 ) {
	my $unit_sec;
	if ( $unit =~ /^\$/ ) {
	    my $name = substr $unit, 1;
	    croak "$name isn't a defined parameter"
	      unless $self->report_spec->has_param( $name );

	    croak "$name parameter isn't of type duration"
	      unless $self->report_spec->param( $name )->type()
		eq "duration";
	} else {
	    croak "$unit isn't a valid duration"
	      unless check_duration( $unit );
	}

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

    return $self->{'unit'};
}

# ------------------------------------------------------------------------
# Method xml_attrs()
#
# Implementation of the method required by Lire::Aggregator
sub xml_attrs {
    my ( $self ) = @_;

    return qq{field="$self->{'field'}" unit="$self->{'unit'}"};
}

# Implements Lire::ReportOperator::name()
sub name {
    return 'timeslot:' . $_[0]->{'field'};
}

# ------------------------------------------------------------------------
# Method create_categorical_info( $info )
#
# Implementation of the method required by Lire::Aggregator
sub create_categorical_info {
    my ( $self, $info ) = @_;

    my $dlf_field = $self->report_spec()->field( $self->field() );
    $info->create_column_info( $self->name(), 'categorical',
                               $dlf_field->type(), $self->label() );
}

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

    $self->SUPER::build_query( $query );

    my $unit = $self->report_spec()->resolve_param_ref( $self->{'unit'} );
    my ( $range, $unit_char ) = $unit =~ /(\d+)\s*(\w)/;
    my $func = ( $unit_char eq 'w' ) ? 'lr_timeslot_week' : 'lr_timeslot';
    my $param = ",$range";
    $param .= ",'$unit_char'" if ( $unit_char ne 'w' );

    $query->add_group_field( $self->name(),
                             sprintf( '%s(%s%s)', $func,
                                      sql_quote_name( $self->{'field'} ),
                                      $param) );
    $query->set_sort_spec(  $self->name() );

    return;
}

sub create_entry {
    my ( $self, $group, $row ) = @_;

    my $entry = $group->create_entry();
    my $slot = $row->{ $self->name() };

    unless ( defined $slot ) {
        $group->missing_cases( $row->{'_lr_nrecords'} );
        return undef;
    }

    my $unit = $self->report_spec->resolve_param_ref($self->{'unit'});

    my ( $range, $unit_char ) = $unit =~ /(\d+)\s*(\w)/;

    my $idx  = int( $slot / $range );
    my ($content, $value);
    if ( $unit_char eq 'M' ) {
        $value = "M$idx";
        $content = $MONTHS[$slot];
    } elsif ( $unit_char eq 'd' ) {
        $value = "D$idx";
        $content = $DAYS[$slot];
    } elsif ( $unit_char eq 'w' ) {
        $value = "W". int ( ( ($slot || 1) -1) / $range );
        my $fmt = Lire::Config->get( 'lr_week_numbering' ) eq 'ISO' ?
          '-W%02d' : 'Week %02d';
        $content = sprintf( $fmt, $slot );
    } else {
        $value = $unit_index{$unit_char} .'-' . $idx;
        my %unit_fmts = ( 'h' => '%.2d:00',
                          'm' => '00:%.2d',
                          's' => '00:00:%.2d' );
        $content = sprintf( $unit_fmts{$unit_char}, $slot );
    }

    $entry->add_name( $content, $value, $range );

    return $entry;
}

use vars qw/ @SLOT_UNIT @MAX_SLOTS @SLOT_INDEX @SLOT_FMT /;

BEGIN {
    # SLOT_INDEX: where in a localtime(3) struct we can find relevant entry;
    #  since there is no weeknumber represented in localtime, we use a `wk'
    #  as placeholder
    #
    #              mday, wk, wday, hour,  min, sec

    @SLOT_UNIT  = qw/1M  1w   1d    1h    1m    1s/;
    @MAX_SLOTS  = qw/12  52    7    24    60    60/;
    @SLOT_INDEX = qw/4   wk    6     2     1     0/;
    @SLOT_FMT   = qw/mo  wk   dw    %H:00 00:%M 00:00:%S/;
}

# Implements Lire::ReportOperator::init_merge()
sub init_merge {
    my $self = $_[0];

    $self->SUPER::init_merge();

    my $unit = $self->report_spec()->resolve_param_ref( $self->unit() );
    my $unit_sec = duration2sec( $unit );

    # Determine if we have a valid duration value for a timeslot
    my $unit_idx = 5;
    if ( monthly_duration( $unit ) ) {
	$unit_idx = 0;
    } elsif ( weekly_duration( $unit ) ) {
	$unit_idx = 1;
    } elsif ( daily_duration( $unit ) ) {
	$unit_idx = 2;
    } elsif ( hourly_duration( $unit ) ) {
	$unit_idx = 3;
    } elsif ( minutely_duration( $unit ) ) {
	$unit_idx = 4
    } else {
	$unit_idx = 5
    }

    my $unit_ok = 0;
    my $sec = duration2sec( $SLOT_UNIT[$unit_idx] );
    if ( $unit_sec >= $sec && !( $unit_sec % $sec ) ) {
	croak "$unit is a too big muliple of $SLOT_UNIT[$unit_idx]. ",
	  "Max is $MAX_SLOTS[$unit_idx]"
	    if $unit_sec > $MAX_SLOTS[$unit_idx] * $sec;

	$self->{'slot_index'} = $SLOT_INDEX[$unit_idx];
	$self->{'time_fmt'}   = $SLOT_FMT[$unit_idx];
	$self->{'multiplier'} = $unit_sec / $sec;

	$unit_ok = 1;
    }
    croak "invalid timeslot value: must be an even multiple of 1M, 1wk, 1d, 1h, 1m or 1s"
      unless $unit_ok;

    return;
}

# Implements Lire::Aggregator::init_aggregator_data()
sub init_aggregator_data {
    return [];
}

# Implements Lire::Aggregator::merge_aggregator_data()
sub merge_aggregator_data {
    my ( $self, $group, $timeslots ) = @_;

    foreach my $e ( $group->entries() ) {
	my @names = $e->names();
	die "wrong number of names for a timeslot subreport: ",
	  scalar @names, "\n" unless @names == 1;
	my $slot = $names[0]{'value'};
	my $mult = $names[0]{'range'};

	# Are the multipliers compatible?
	# They are only if the target multiplier is a multiple 
	# of the source one.
	# Non-multiple would need interpolation, which would be hard
	# to achieve for other operation than sum and count
	die "incompatible unit multiplier: $self->{'multiplier'} isn't a multiple of $mult\n"
	  unless $self->{'multiplier'} % $mult == 0;

	# Are the used slot compatible?
	my $index;
	if ( $self->{'time_fmt'} eq 'mo' ) {
	    croak "incompatible timeslot unit: $slot\n"
	      unless $slot =~ /^M(\d+)$/;
	    $index = $1;
	} elsif ( $self->{'time_fmt'} eq 'dw' ) {
	    croak "incompatible timeslot unit: $slot\n"
	      unless $slot =~ /^D(\d+)$/;
	    $index = $1;
	} elsif ( $self->{'time_fmt'} eq 'wk' ) {
	    croak "incompatible timeslot unit: $slot\n"
	      unless $slot =~ /^W(\d+)$/;
	    $index = $1;
	} else {
	    my $type;
	    ( $type, $index ) = $slot =~ /^(\d)-(\d+)$/
	      or croak "invalid timeslot's value attribute: $slot\n";

	    croak "incompatible timeslot unit: $slot\n"
	      if $type != $self->{'slot_index'};
	}

	# Map index when target multiplier is greater than the original one.
	# For example: original = 2h, target = 4h
	# Original:  0 2 4 6 8 10 12 14 16 18 20 22 -> 12 indices
	# Target:    0   4   8    12    16    20    -> 6  indices

	my $idx = int( $index * $mult / $self->{'multiplier'} );

	my $data = $timeslots->[$idx];
	unless ( defined $data ) {
	    $data = [];

	    my $i = 0;
	    foreach my $op ( @{$self->ops()} ) {
		$data->[$i++] = $op->init_group_data();
	    }

	    $timeslots->[$idx] = $data;
	}

	my $i = 0;
	foreach my $op ( @{$self->ops()} ) {
	    my $value = $e->data_by_name( $op->name );
	    my $op_data = $data->[$i++];
	    $op->merge_group_data( $value, $op_data )
	      if ( $value );
	}
    }

    return $self;
}

# Implements Lire::Aggregator::end_aggregator_data()
sub end_aggregator_data {
    my ( $self, $timeslots ) = @_;

    # Finalize each timeslice
    # Either create empty one or call end_group_data on them
    my $last_idx;
    if ( $self->{'slot_index'} eq 'wk' ) {
	$last_idx = 52;
    } else {
	$last_idx = ( 59, 59, 23, 0, 11, 0, 6 )[$self->{'slot_index'}];
    }
    $last_idx = int( $last_idx / $self->{'multiplier'} );

    my $i = 0;
    while ( $i <= $last_idx ) {
	if ( $timeslots->[$i]) {
	    my $data = $timeslots->[$i];
	    my $j = 0;
	    foreach my $op ( @{$self->ops()} ) {
		$op->end_group_data( $data->[$j++] );
	    }
	} else {
	    # Create empty set
	    my $data =[];
	    my $j = 0;
	    foreach my $op ( @{$self->ops()} ) {
		$data->[$j] = $op->init_group_data();
		$op->end_group_data( $data->[$j++] );
	    }

	    $timeslots->[$i] = $data;
	}
	$i++;
    }

    return $self;
}

# Implements Lire::Aggregator::create_group_entries()
sub create_group_entries {
    my ( $self, $group, $timeslots ) = @_;

    for ( my $i=0; $i < @$timeslots; $i++ ) {
        my $row = { $self->name() => $i * $self->{'multiplier'} };
	my $entry = $self->create_entry( $group, $row );

	my $j = 0;
	foreach my $op ( @{$self->ops()} ) {
	    $op->add_entry_value( $entry, $timeslots->[$i][$j++] );
	}
    }

    return;
}

# keep perl happy
1;

__END__

=head1 SEE ALSO

 Lire::ReportSpec(3pm), Lire::Group(3pm), Lire::ReportOperator(3pm),
 Lire::Timegroup(3pm)

=head1 AUTHORS

  Francis J. Lacoste <flacoste@logreport.org>
  Wolfgang Sourdeau <Wolfgang.Sourdeau@Contre.COM>

=head1 VERSION

$Id: Timeslot.pm,v 1.27 2006/07/23 13:16:30 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