package Lire::Report::GroupInfo;

use strict;

use Carp;
use POSIX qw/ ceil /;

use Lire::DataTypes qw/ check_xml_name /;
use Lire::Report::ColumnInfo;
use Lire::Utils qw/ check_param check_object_param /;

=pod

=head1 NAME

Lire::Report::GroupInfo - Object that groups columns created by the same aggregator. .

=head1 SYNOPSIS

    my $info = $subreport->group_info( 0 );
    print "Group's name: ", $info->name(),   "\n";
    print "Group's columns starts at: ", $info->index(), "\n";

=head1 DESCRIPTION

The Lire::Report::GroupInfo object holds the ColumnInfo objects that
were created by the same aggregator.


=head1 CONSTRUCTOR

=head2 new( $name )

You create a new Lire::Report::GroupInfo object by calling the
create_group_info() method on one Lire::Report::TableInfo object or
another Lire::Report::GroupInfo object.

=cut

sub new {
    my ( $class, $parent, $name ) = @_;

    check_param( $name, 'name', \&check_xml_name,
                 "name isn't a valid XML name" );
    check_object_param( $parent, 'parent', 'Lire::Report::GroupInfo' );

    return bless( { 'name'      => $name,
                    'children'  => [],
                    'parent'    => $parent },
                  $class );
}

=pod

=head1 OBJECT METHODS

=pod

=head2 name()

Returns the name of this group. This name can be used to find the
aggregator (from the report specification) that is responsible for the
data held in this group.

=cut

sub name {
    return $_[0]{'name'};
}


=pod

=head2  row_idx()

Returns the row index in which this group's categorical column's
labels should be displayed in the table header.

=cut

sub row_idx {
    $_[0]{'row_idx'} = $_[1] if @_ == 2;

    return $_[0]{'row_idx'};
}

=pod

=head2 max_row_idx()

=cut 

sub max_row_idx {
    my $self = $_[0];

    my $max = $self->{'row_idx'};

    foreach my $group ( $self->group_children() ) {
        my $idx = $group->max_row_idx();
        $max = $idx if ( $idx > $max );
    }

    return $max;
}

=pod

=head2 parent_group_info()

Returns the GroupInfo which contains this GroupInfo. This will be
undef for the top-level TableInfo object.

=cut

sub parent_group_info {
    return $_[0]{'parent'};
}

=pod

=head2 index()

Returns the column's index in the table at which the columns of this
group starts. This will be undef until the group info object is added
to a Lire::Subreport or another Lire::Group object.

=cut

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

    if ( @_ == 2 ) {
        croak ( "can't modify starting column index once children were added" )
          if $self->children;

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

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

=pod

=head2 children()

Returns as an array, the Lire::Report::ColumnInfo and
Lire::Report::GroupInfo objects contained in this group.

=cut

sub children {
    return @{$_[0]{'children'}};
}

=pod

=head2 info_by_index( $idx )

Returns the ColumnInfo or GroupInfo that is at index $idx among this
GroupInfo children.

=cut

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

    croak( "info index out of bounds" )
      if $idx > $#{$self->{'children'}};

    return $self->{'children'}[$idx];
}

=pod

=head2 group_children

Returns as an array, only the Lire::Report::GroupInfo contained in this
GroupInfo.

=cut

sub group_children {
    return grep { $_->isa( 'Lire::Report::GroupInfo' ) } $_[0]->children;
}

=pod

=head2 column_children

Returns as an array, only the Lire::Report::ColumnInfo contained in this
GroupInfo.

=cut

sub column_children {
    return grep { $_->isa( 'Lire::Report::ColumnInfo' ) } $_[0]->children();
}

=pod

=head2 categorical_names() 

Returns the categorical columns' names as an array ref.

=cut

sub categorical_names {
    my $self = $_[0];

    my @names = ();
    foreach my $col ( $self->column_children() ) {
        push @names, $col->name()
          if $col->class() eq 'categorical';
    }

    return \@names;
}

=pod

=head2 create_column_info( $name, $class, $type, [$label]])

Creates a new Lire::Report::ColumnInfo object as a child of this
GroupInfo. The column info attributes are initialized based on $name,
$class, $type and $label.

This will set the index of the ColumnInfo object.

Returns the created ColumnInfo object.

=cut

sub create_column_info {
    my ( $self, $name, $class, $type, $label ) = @_;

    my $info = new Lire::Report::ColumnInfo( $self, $name, $class,
                                             $type, $label );
    my $index = $self->next_column_index();
    $info->index( $index );

    push @{$self->{'children'}}, $info;

    return $info;
}

=pod

=head2 create_group_info( $name )

Create a Lire::Report::GroupInfo which as a child of this group. This
will also set the starting column index on the GroupInfo object. The
$name parameter should contain the name of the report specification
aggregator that is responsible for the content of this group.

Returns the created GroupInfo object.

=cut

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

    check_param( $name, 'name', \&check_xml_name,
                 "name isn't a valid XML name" );

    my $info = new Lire::Report::GroupInfo( $self, $name );

    my $index = $self->next_column_index();
    $info->index( $index );
    $info->row_idx( $self->row_idx + 1 );
    push @{$self->{'children'}}, $info;

    return $info;
}

#------------------------------------------------------------------------
# Methods next_column_index()
#
# Returns the next column's index that should be used when a ColumnInfo or
# GroupInfo object is added.
sub next_column_index {
    my $self = $_[0];

    croak ( "next_column_index: starting column index wasn't set" )
      unless defined $self->{'index'};

    return $self->index()
      unless ( @{$self->{'children'}} );

    my $last = $self->{'children'}[$#{$self->{'children'}}];

    return ( UNIVERSAL::isa( $last, "Lire::Report::GroupInfo" )
             ? $last->next_column_index()
             : $last->index() + 1 );
}

=pod

=head2 column_info_by_name( $name )

Returns the Lire::Report::ColumnInfo object that has the name $name. This
method searches in the current group as well as in its subgroups.

Returns undef if the column isn't found.

=cut

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

    # Look first into our immediate children
    my ( $col ) = grep { $_->name() eq $name } $self->column_children();

    return $col if $col;

    # Look into subgroups
    foreach my $g ( $self->group_children() ) {
        my $c = $g->column_info_by_name( $name );
        return $c if $c;
    }

    return;
}

=pod

=head2 column_info_by_col_start( $col_idx )

Returns the Lire::Report::ColumnInfo object that starts in column index
$col_idx. This method searches in the current group as well as in its
subgroups.

Returns undef if the column isn't found in the current group.

=cut

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

    # Look first into our immediate children
    my ( $col ) = grep { $_->col_start == $idx } $self->column_children();

    return $col if $col;

    # Look into subgroups
    foreach my $g ( $self->group_children() ) {
        $col = $g->column_info_by_col_start( $idx );
        return $col if $col;
    }

    return;
}

=pod

=head2 group_info( $name )

Returns the Lire::Report::GroupInfo object that has the name $name.
This will be undef if it cannot be found in this group info.

=cut

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

    # Look first into our immediate children
    my ( $group ) = grep { $_->name() eq $name } $self->group_children();

    # Look into subgroups
    foreach my $g ( $self->group_children() ) {
        $group = $g->group_info( $name );
        return $group if $group;
    }

    return;
}

# ------------------------------------------------------------------------
# Method compute_group_layout( [$col_start])
#
# Calculates the col-start, col-end attributes of each of this
# group column-info.
#
# $col_start is the column at which the group should start assigning.
# Defaults to 0.
#
# Returns the column number that should be assigned next.
#
# The algorithm for the table layout is to assign all the categorical
# columns first. Rationale being this is that only those columns use
# spanning to show the grouping indentation. To achieve this, we also
# process the categorical columns of the first subgroup recursively.
# 
# After that, the numerical columns (and recursively the first
# subgroup's numerical columns are assigned and the other groups are
# processed in order as if they were independant subtables (possibly 
# also involving grouping
#
# For example, this XML report :
#  <entry>
#   <name>Cat1</name>
#   <name>Cat2</name>
#   <value>Num1</value>
#   <group>
#    <entry>
#     <name>G1Cat1</name>
#     <value>G1Num1</nvalue>
#    </entry>
#   </group>
#   <group>
#    <entry>
#     <name>G2Cat1</name>
#     <group>
#       <entry>
#        <name>G3Cat1</name>
#        <name>G3Cat2</name>
#        <value>G3num1</value>
#       </entry>
#     </group>
#    </entry>
#   </group>
#  </entry>
#
#  would be rendered as :
#
# +-+--------+------+-----+-------+--+--------+------+---------+
# |Cat1      |Cat2  | Num1|       |                  |         |
# +-+--------+------+     +       +--+--------+------+         |
# | |G1Cat1         |     | G1Num1|G2Cat1            |         |
# +-+--------+------+     +       +--+--------+------+         |
# |                 |     |       |  |G3Cat1  |G3Cat2|   G3Num1|
# +-+--------+------+-----+-------+--+--------+------+---------+
sub compute_group_layout {
    my ( $self, $col_start ) = @_;

    $col_start = 0
      unless defined $col_start;

    # -1 because col_start is a 0-based index
    my $cat_col_end = $col_start + $self->count_categorical_columns - 1;

    # Assign the categorical columns
    $self->assign_categorical_columns( $col_start, $cat_col_end );

    # Process the other columns
    $self->assign_numerical_columns( $cat_col_end + 1 );

    return;
}

# ------------------------------------------------------------------------
# Method assign_categorical_columns( $col_start, $cat_col_end )
#
# Calculates the col-start, col-end attributes of each for this group's
# categorical columns.
#
# $col_start is the column at which the group should start assigning
# $cat_col_end is the last column which can be used for categorical data
#
sub assign_categorical_columns {
    my ( $self, $col_start, $cat_col_end  ) = @_;

    # The categorical columns in this group to process
    my @cat_columns = grep { $_->class() eq 'categorical' }
      $self->column_children();

    # The number of available categorical columns not assigned
    my $cat_column_avail = $cat_col_end - $col_start + 1;
    die "ASSERTION FAILED: this group has ", scalar @cat_columns,
      " categorical columns but only $cat_column_avail are available"
      if $cat_column_avail < @cat_columns;

    my $col_no = $col_start;
    while ( my $col = shift @cat_columns ) {
        # + 1 since $col isn't in @cat_columns
        my $span = ceil( $cat_column_avail / (@cat_columns + 1) );
        $col->col_start( $col_no );
        die "ASSERTION FAILED: span outside of the columns assigned to categorical data"
          if $col_no + $span -1 > $cat_col_end;
        $col->col_end( $col_no + $span - 1 );
        $col_no += $span;
        $cat_column_avail -= $span;
    }

    # Assign the categorical columns of the first group
    my ($first_group) = $self->group_children();
    $first_group->assign_categorical_columns( $col_start + 1, $cat_col_end )
      if defined $first_group;

    return;
}

# ------------------------------------------------------------------------
# Method count_columns
#
# Returns the number of columns in this group and its subgroups
sub count_columns {
    my $self = $_[0];

    my $count = $self->column_children();
    foreach my $group ( $self->group_children() ) {
        $count += $group->count_columns();
    }

    return $count;
}

# ------------------------------------------------------------------------
# Method count_categorical_columns
#
# Returns the number of categorical columns present in this
# group. This includes the categorical columns of the first subgroups.
#
sub count_categorical_columns {
    my ($self) = @_;

    my $count = grep { $_->class() eq 'categorical' } $self->column_children();
    my @groups = $self->group_children();

    $count += $groups[0]->count_categorical_columns()
      if @groups;

    return $count;
}

# ------------------------------------------------------------------------
# Method assign_numerical_columns( $col_start )
#
# Assigns the numerical columns of this group
#
# $col_start is the column number at which the assignment should
# start
#
# Returns the next column number to assign.
sub assign_numerical_columns {
    my ( $self, $col_start ) = @_;

    my $col_no = $col_start;
    my $group_processed = 0;
    foreach my $child ( $self->children() ) {
        if ( $child->isa( 'Lire::Report::ColumnInfo' ) ) {
            # Already assigned
            next if $child->class() eq 'categorical';

            # Numerical column are always 1 in width
            $child->col_start( $col_no );
            $child->col_end( $col_no );

            $col_no++;
        } else {
            # This child is a GroupInfo

            if ( $group_processed ) {
                # If its not the first one, we have to assign both its
                # categorical and numerical columns.
                $col_no = $child->compute_group_layout( $col_no );
            } else {
                # If this is the first GroupInfo, we assign its numerical
                # colum.
                $col_no = $child->assign_numerical_columns( $col_no );
                $group_processed++;
            }
        }
    }

    return $col_no;
}

# ------------------------------------------------------------------------
# Method assign_columns_width()
#
# Sets the width of each column based on columns which only uses one
# cell. The width is set to the max-chars value. If the column spans
# more than one cell, its width is set to 2, since this column is used
# as indentation for grouping purpose (consult the example in
# compute_group_layout).
sub assign_columns_width {
    my $self = $_[0];

    foreach my $col ( $self->column_children() ) {
        $col->col_width( $col->col_start() == $col->col_end()
                         ? $col->max_chars()
                         : 2 );
    }

    foreach my $group ( $self->group_children() ) {
        $group->assign_columns_width();
    }

    return;
}

# ------------------------------------------------------------------------
# Method correct_spanning_column_width( $table_info)
#
# Make sure that the sum of the width spanned by spanning columns is
# enough to hold their value.
#
# $table_info is a reference to the TableInfo object which contains the
# all columns
sub correct_spanning_column_width {
    my ( $self, $table_info ) = @_;

    foreach my $col ( $self->column_children() ) {
        my $start = $col->col_start();
        my $end = $col->col_end();
        next unless $start != $end;

        # Check the width of the span
        my $width = 0;
        foreach ( my $i = $start; $i <= $end; $i++ ) {
            $width += $table_info->column_info_by_col_start( $i )->col_width();
        }

        next if $col->max_chars <= $width;

        # This column is bigger than the span, increase proportionally
        # the columns width, except the first one which is used
        # for indentation.
        # (We don't need to subtract one, since we need a column count
        # and not a column index)
        my $extra = ceil( ($col->max_chars - $width) / ( $end - $start) );

        foreach ( my $i = $start + 1; $i <= $end; $i++ ) {
            my $col = $table_info->column_info_by_col_start( $i );
            $col->col_width( $col->col_width + $extra );
        }
    }

    foreach my $group ( $self->group_children() ) {
        $group->correct_spanning_column_width( $table_info );
    }

    return;
}

#-----------------------------------------------------------------------
# Methods write_report( $fh, $index )
sub write_report {
    my ( $self, $fh, $indent ) = @_;

    $fh ||= *STDOUT;
    my $pfx = ' ' x $indent;

    print $fh $pfx, qq{<lire:group-info name="$self->{'name'}" row-idx="$self->{'row_idx'}">\n};
    foreach my $i ( $self->children() ) {
        $i->write_report( $fh, $indent + 1 );
    }
    print $fh $pfx, "</lire:group-info>\n";
}

#------------------------------------------------------------------------
# Method delete()
#
# Remove circular references
sub delete {
    my $self = $_[0];

    foreach my $c ( $self->children() ) {
        $c->delete();
    }

    %$self = ();

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

Lire::Report::Subreport(3pm) Lire::Report::ColumnInfo(3pm)

=head1 VERSION

$Id: GroupInfo.pm,v 1.22 2006/07/23 13:16:31 vanbaal Exp $

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=head1 COPYRIGHT

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