package Lire::AsciiDlf::Timegroup;

use strict;

use vars qw/ $VERSION @ISA $WEEK_FMT %MONTHS /;

use Lire::Config;
use Lire::Timegroup;
use Lire::AsciiDlf::NestableAggregator;
use Lire::DataTypes qw/ :time /;
use Lire::Report::Entry;

use POSIX qw/ strftime /;
use Time::Local;
use Time::Timezone;

use Carp;

BEGIN {
    ($VERSION)	= '$Revision: 1.25 $' =~ m!Revision: ([.\d]+)!;
    @ISA = qw/ Lire::Timegroup Lire::AsciiDlf::NestableAggregator/;

    # We don't want to use the %B strftime because of possible
    # charsets conflicts with locale settings
    my $i = 0;
    %MONTHS = map { $i++ => $_ } qw/ January February March
				     April   May      June
				     July    August   September
				     October November December /;

    if ($Lire::Config::LR_WEEK_STARTS_ON eq 'mon') {
	$WEEK_FMT = '%W';
    } else {
	$WEEK_FMT = '%U';
    }
}

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

    $self->{field_idx} =
      $self->{report_spec}->schema->field( $self->field )->pos();

    my $period = $self->period;
    if ( $period =~ /^\$/ ) {
	$period = substr $period, 1;
	$period = $self->{report_spec}->param( $period )->value;
    }

    $self->{period_sec} = duration2sec( $period );

    # The way to determine the index in the timeslices is different
    # for weekly, monthly and yearly period
    if ( monthly_duration( $period ) ) {
	$self->{use_month} = 1;
    } elsif (weekly_duration( $period ) ) {
	$self->{use_week} = 1;
    } elsif ( yearly_duration( $period ) ) {
	$self->{use_year} = 1;
    } else {
	$self->{use_sec} = 1;
    }

    # Calculate the start of the period
    my $time = $dlf_info->start_time;
    if ( $self->{use_year} ) {
	$self->{year_start} = (localtime $time)[5];
    } elsif ( $self->{use_month} ) {
	my ($month,$year) = (localtime $time)[4,5];
	$self->{month_start}  = $month;
	$self->{year_start}   = $year;
    } elsif ( $self->{use_week} ) {
	# Week 0 contains all the days before the first monday or sunday
	# of the year. It should be tallied with the last week of the
	# previous year.
	my $week_start = strftime( $WEEK_FMT, localtime $time );
	my $year_start = (localtime $time)[5];
	my $year_end   = (localtime $dlf_info->end_time)[5];
	$self->{year_start} = $year_start;
	$self->{week_start} = $week_start;
	$self->{year_wk1_date} = [ find_week1_start_date( $year_start ) ];
	my $first_year_wk_cnt = last_week_no( $year_start ) - $week_start + 1;
	$first_year_wk_cnt++ if $week_start == 0;
	$self->{year_wk_idx_offset} = [ 0 ];
	# Fill starting date of week 1 for other years
	for ( my $year = $year_start + 1; $year < $year_end; $year++ ) {
	    my $idx = $year - $year_start;
	    $self->{year_wk1_date}[$idx] = find_week1_start_date( $year );
	    if ( $idx == 1 ) {
		$self->{year_wk_idx_offset}[$idx] = $first_year_wk_cnt;
	    } else {
		$self->{year_wk_idx_offset}[$idx] =
		  last_week_no( $year-1) + $self->{year_wk_idx_offset}[$idx-1];
	    }
	}
    } else {
	# The start of the period is offset by the timezone offset.
	# We need only do this once, because UTC doesn't have a standard
	# vs. daylight saving issue. This means that all subsequent period
	# will have the proper localtime value.
	$self->{tz_offset} = tz_local_offset( $time );
	$self->{start} = int( $time / $self->{period_sec})
	  * $self->{period_sec};

	# FIXME: Can somebody explain to me why is this working.
	# This was found heuristically and I'm not sure I
	# understand why this works. -- FJL
	$self->{start} -= $self->{tz_offset}
	  if abs($self->{tz_offset}) < $self->{period_sec};
    }

    # FIXME: Backward compatibily hack. This should be done
    # in the stylesheets
    if ( $self->{use_year} ) {
	$self->{time_fmt} = '%Y';
    } elsif ( $self->{use_week} ) {
	$self->{time_fmt} = "Week $WEEK_FMT";
    } elsif ( $self->{period_sec} >= 86400 ) { # 1d
	$self->{time_fmt} = '%Y-%m-%d';
    } elsif ( $self->{period_sec} >= 60 ) {
	$self->{time_fmt} = '           %H:%M';
    } else {
	$self->{time_fmt} = '           %H:%M:%S';
    }

    $self->SUPER::init_report( $dlf_info );

    $self;
}

sub last_week_no {
    my ($year) = @_;
    return strftime( $WEEK_FMT, (0,0,0,31,11,$year) )+0;
}

sub find_week1_start_date {
    my ($year) = @_;

    my ($time, $week_no);
    my $date = 1;
    do {
	$time = timelocal( 0, 0, 0, $date, 0, $year );
	$week_no = strftime( $WEEK_FMT, localtime($time) )+0;
	$date++;
    } while ( $week_no != 1 );

    return $time;
}

sub init_group_data {
    return [];
}

sub update_group_data {
    my ( $self, $dlf, $timeslices ) = @_;

    my $time = $dlf->[$self->{field_idx}];

    my $idx;
    if ( $self->{use_sec} ) {
	$idx = int( ($time - $self->{start}) / $self->{period_sec});
    } elsif ( $self->{use_month} ) {
	my ($month,$year) = (localtime $time)[4,5];

	if ( $year > $self->{year_start}) {
	    $idx = ($year - $self->{year_start}) * 12 + $month;
	} else {
	    $idx = $month - $self->{month_start};
	}
    } elsif ( $self->{use_week} ) {
	my $year = (localtime $time)[5];
	my $week = strftime( $WEEK_FMT, localtime $time );

	my $year_idx = $year - $self->{year_start};
	$idx = $week + $self->{year_wk_idx_offset}[$year_idx] - $self->{week_start};
    } else {
	my $year = (localtime $time)[5];
	$idx = $year - $self->{year_start};
    }

    # Negative time index, means that the $info object didn't report
    # correct start_time.
    die "found negative time slice index ($idx). ",
      "Something is seriously broken!\n"
	if $idx < 0;

    my $data = $timeslices->[$idx];
    unless ( defined $data ) {
	my $start;
	if ( $self->{use_sec} ) {
	    $start = $idx * $self->{period_sec} + $self->{start};
	} elsif ( $self->{use_month} ) {
	    $start = timelocal( 0, 0, 0, 1, (localtime $time)[4,5] );
	} elsif ( $self->{use_week} ) {
	    my $year = (localtime $time)[5];
	    my $year_idx = $year - $self->{year_start};
	    my $week1 = $self->{year_wk1_date}[$year_idx];
	    my $week  = strftime( $WEEK_FMT, localtime $time ) + 0;
	    $start = $week1 + 86400 * 7 * ($week - 1 );
	} else {
	    $start = timelocal( 0, 0, 0, 1, 0, (localtime $time)[5] );
	}
	$data = [ $start ];

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

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

    my $i = 1;
    foreach my $op ( @{$self->ops} ) {
	$op->update_group_data( $dlf, $data->[$i++] );
    }

    $self;
}

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

    # Finalize each timeslice
    # Either create empty one or call end_group_data on them
    my $last_idx = $#$timeslices;
    my $i = 0;
    while ( $i <= $last_idx) {
	if ( $timeslices->[$i]) {
	    my $data = $timeslices->[$i];
	    my $j = 1;
	    foreach my $op ( @{$self->ops} ) {
		$op->end_group_data( $data->[$j++] );
	    }
	} else {
	    # Create empty set
	    my $start;
	    if ( $self->{use_sec} ) {
		$start = $i * $self->{period_sec} + $self->{start};
	    } elsif ($self->{use_month} ) {
		my $year_off  = int( ($self->{month_start} + $i) / 12);
		my $month     = ($self->{month_start} + $i) % 12;
		$start = timelocal( 0, 0, 0, 1, $month,
				    $self->{year_start} + $year_off );
	    } elsif ( $self->{use_week} ) {
		$start = $self->{year_wk1_date}[0] +
		  ($self->{week_start} + $i - 1) * 86400 * 7;
	    } else {
		$start = timelocal( 0, 0, 0, 1, 0, $self->{year_start} + $i );
	    }
	    my $data = [ $start ];

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

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

    $self;
}

sub create_entries {
    my ( $self, $group, $timeslices ) = @_;

    $timeslices ||= $self->{data};

    my $last_day = 0;
    foreach my $tslice ( @$timeslices ) {
	my $entry = new Lire::Report::Entry;

	# FIXME: Special backward-compatibility hack.
	# This should be done in the stylesheet.
	if ( $self->{use_month}) {
	    my $month = (localtime $tslice->[0] )[4];
	    $entry->add_name( $MONTHS{$month}, $tslice->[0], 
			      $self->{period_sec} );
	} else {
	    my $fmt = $self->{time_fmt};
	    if ( $self->{period_sec} < 86400 ) { # 1d
		# Make sure that date change are indicated
		if ( $tslice->[0] >= $last_day + 86400 ) {
		    $fmt = '%Y-%m-%d %H:%M';
		    $last_day = $tslice->[0] - ($tslice->[0] % 86400)
		      - $self->{tz_offset};
		}
	    }
	    $entry->add_name( strftime( $fmt, localtime $tslice->[0] ),
			      $tslice->[0], $self->{period_sec} );
	}

	my $i = 1;
	foreach my $op ( @{$self->ops} ) {
	    $op->add_entry_value( $entry, $tslice->[$i++] );
	}
	$group->add_entry( $entry );
    }

    $self;
}


# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::AsciiDlf::Timegroup -

=head1 SYNOPSIS


=head1 DESCRIPTION

=head1 VERSION

$Id: Timegroup.pm,v 1.25 2002/06/18 14:36:34 flacoste Exp $

=head1 COPYRIGHT

Copyright (C) 2001 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 or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut
