package Lire::Merge::Rangegroup;

use strict;

use vars qw/ $VERSION @ISA /;

use Lire::Rangegroup;
use Lire::DataTypes qw/ :basic :time :misc format_numeric_type /;
use Lire::Merge::NestableAggregator;
use Lire::Report::Entry;

use constant NEGLIGIBLE_QTY => 0.000001;

use Carp;

BEGIN {
    ($VERSION)	= '$Revision: 1.4 $' =~ m!Revision: ([.\d]+)!;
    @ISA = qw/ Lire::Rangegroup Lire::Merge::NestableAggregator /;
}

# FIXME: This is near identical than Lire::AsciiDlf::Rangegroup::init_report
sub init_merge {
    my $self = shift;

    my $type = $self->{report_spec}->schema->field( $self->field )->type();
    $self->{field_type} = $type;

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

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

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

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

    my $size_scale = $self->size_scale;
    if ( $size_scale =~ /^\$/ ) {
	$size_scale = substr $size_scale, 1;
	$size_scale = $self->{report_spec}->param( $size_scale )->value;
    }
    croak "'size-scale' must be a positive number"
      if $size_scale < 0;

    $self->{min_value}  = undef;
    $self->{max_value}  = undef;
    $self->{size_scale} = $size_scale;

    # Attributes should be of same type as the field.
    if ( $type eq 'bytes' ) {
	$self->{range_start} = size2bytes( $range_start );
	$self->{range_size}  = size2bytes( $range_size );
	$self->{min_value}   = size2bytes( $min_value )
	  if defined $min_value;
	$self->{max_value}   = size2bytes( $max_value )
	  if defined $max_value;
    } elsif ($type eq 'duration' ) {
	$self->{range_start} = duration2sec( $range_start );
	$self->{range_size}  = duration2sec( $range_size );
	$self->{min_value}   = duration2sec( $min_value )
	  if defined $min_value;
	$self->{max_value}   = duration2sec( $max_value )
	  if defined $max_value;
    } else {
	croak "'range-size' attribute's value should be positive: $range_size"
	  unless $range_size >= 0;

	$self->{range_start} = $range_start;
	$self->{range_size}  = $range_size;
	$self->{min_value}   = $min_value;
	$self->{max_value}   = $max_value;
    }

    $self->SUPER::init_merge(@_);
}

# FIXME: This is identical than Lire::AsciiDlf::Rangegroup::init_group_data
sub init_group_data {
    my ( $self ) = @_;

    my $ranges = [];

    # Transform the min_value in the range_start parameter
    $self->{range_start} = $self->{min_value} - $self->{range_start}
      if ( defined $self->{min_value});

    if ( defined $self->{max_value}) {
	my $end_idx;
	if ( $self->{size_scale} == 1 ) {
	    $end_idx   = int( ($self->{max_value} - $self->{range_start}) / $self->{range_size});
	} else {
	    $end_idx = 0;
	    while (1) {
		my $end = $self->{range_start} +
		  (($self->{size_scale} ** $end_idx) * $self->{range_size});

		last if $self->{max_value} < $end;
		$end_idx++;
	    }
	}

	# Make sure that we have entry until max_value
	$ranges->[$end_idx] = undef;
    }

    $ranges;
}

sub merge_entries {
    my ( $self, $group, $ranges ) = @_;

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

    foreach my $e ( $group->entries ) {
	my @names = $e->names;
	die "invalid number of names for a rangegroup subreport: ",
	  scalar @names, "\n"
	    if @names != 1;

	# FIXME: We won't interpolate data. So for merging to succeed
	# the whole class must be contained in the new class.
	#
	# Another possible way to merge is to use the middle of the class
	# to determine where the class should be merged. This would be less
	# accurate than the current method, but merging would never fail.
	my $start  = $names[0]{value};
	my $length = $names[0]{range};

	# Clamp if necessary
	if ( defined $self->{min_value} && $start < $self->{min_value} ) {
	    die "incompatible merging parameters: ",
	      "range is splitted across min value: [$start,",
	      $start + $length, "> <> $self->{min_value}\n"
	      if $start + $length > $self->{min_value};
	    $start  = $self->{min_value};
	    $length = NEGLIGIBLE_QTY;
	}
	if ( defined $self->{max_value} && $start > $self->{max_value}) {
	    $start  = $self->{max_value};
	    $length = NEGLIGIBLE_QTY;
	}

	# Since the $start + $length isn't included in the range, we subtract
	# a negligible quantity just to make sure that it falls onto the
	# same idx
	my ($idx);
	if ( $self->{size_scale} == 1 ) {
	    $idx = int( ($start - $self->{range_start}) / $self->{range_size});
	    my $eidx = int( (($start + $length) - $self->{range_start}
			     - NEGLIGIBLE_QTY)
			    / $self->{range_size});

	    die "incompatible merge: source range is splitted across ranges:",
	      "[$start,", $start + $length, "> : start=$self->{range_start}; ",
		"size=$self->{range_size}\n"
		  if $idx != $eidx;
	} else {
	    $idx = 0;
	    while (1) {
		my $end = $self->{range_start} +
		  (($self->{size_scale} ** $idx) * $self->{range_size});

		last if ( $end > ($start + $length) - NEGLIGIBLE_QTY );

		die "incompatible merge: source range is splitted across",
		  " target ranges: [$start,", $start + $length, "> : ",
		    "end=$end\n" if $end > $start;

		$idx++;
	    }
	}

	if ( $idx < 0 ) {
	    croak "can't reorder ranges when using size-scale != 1. Please set min-value !"
	      if $self->{size_scale} != 1;

	    # We have ranges under the first index. Push the ranges to the right.
	    $self->{range_start} = $idx * $self->{range_size} + $self->{range_start};
	    @$ranges = ( (undef) x abs($idx), @$ranges );

	    $idx = 0;
	}

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

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

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

	my @values = $e->values;
	die "wrong number of values: expected ",
	  scalar @{$self->ops}, " but found ", scalar @values
	    if @values != @{$self->ops};

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

# FIXME: This is identical as Lire::AsciiDlf::Rangegroup::end_group_data
sub end_group_data {
    my ( $self, $ranges ) = @_;

    # Finalize each ranges
    # Either create empty one or call end_group_data on them
    my $last_idx = $#$ranges;
    my $i = 0;
    while ( $i <= $last_idx) {
	if ( $ranges->[$i]) {
	    my $data = $ranges->[$i];
	    my $j = 0;
	    foreach my $op ( @{$self->ops} ) {
		$op->end_group_data( $data->[$j++] );
	    }
	} else {
	    my $data = [];

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

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

    $self;
}

# FIXME: This is identical as Lire::AsciiDlf::Rangegroup::end_group_data
sub create_entries {
    my ( $self, $group, $ranges ) = @_;

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

    for ( my $i=0; $i < @$ranges; $i++ ) {
	my $range = $ranges->[$i];
	my ( $start, $end );
	if ( $self->{size_scale} == 1 ) {
	    $start = $self->{range_size} * $i	  + $self->{range_start};
	    $end   = $self->{range_size} * ($i+1) + $self->{range_start};
	} else {
	    if ( $i == 0 ) {
		$start = $self->{range_start};
	    } else {
		$start = $self->{range_start} +
		  ($self->{size_scale} ** ($i-1)) * $self->{range_size};
	    }
	    $end   = $self->{range_start} +
	      ($self->{size_scale} ** $i) * $self->{range_size};
	}

	my $entry = new Lire::Report::Entry;

	my $length = $end - $start;

	my $content = '[' . format_numeric_type( $start, $self->{field_type}) .
	  "-" . format_numeric_type( $end, $self->{field_type} ) . ">";
	$entry->add_name( $content, $start, $length );

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

	$group->add_entry( $entry );
    }

    $self;
}


# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::Merge::Rangegroup -

=head1 SYNOPSIS


=head1 DESCRIPTION

=head1 VERSION

$Id: Rangegroup.pm,v 1.4 2002/06/18 14:40:44 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
