package Lire::Report::TableInfo;

use strict;

use base qw/ Lire::Report::GroupInfo /;

use Lire::Config::Index;
use Lire::Config::VariableIndex;

use Carp;

=pod

=head1 NAME

Lire::Report::TableInfo - Object that holds all the GroupInfo and ColumnInfo for one subreport

=head1 SYNOPSIS

    my $info = $subreport->table_info;
    my $col_info = $info->colum_info( "request_total" );

=head1 DESCRIPTION

The Lire::Report::TableInfo object holds the ColumnInfo and GroupInfo
objects for one subreport..

=head1 CONSTRUCTOR

=head2 new()

Creates a new Lire::Report::TableInfo object.

=cut

sub new {
    my $self = bless( {'name'       => "table",
                       'children'   => [],
                       'row_idx'    => 0,
                       'parent'     => undef},
                      $_[0] );

    $self->index( 0 );

    return $self;
}

=pod

=head2 column_info_by_name( $name )

Returns the Lire::Report::ColumnInfo object that has the name $name.

Contrary to the method in Lire::Report::GroupInfo, this one will
throw an exception if there is no column named $name.

=cut

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

    my $col = $self->SUPER::column_info_by_name( $name );
    croak "There is no column named $name"
      unless $col;

    return $col;
}

=pod

=head2 column_info_by_col_start( $idx )

Returns the Lire::Report::ColumnInfo object that is starts at column
index $idx.

Contrary to the method in Lire::Report::GroupInfo, this one will throw
an exception if this column is out of bounds.

=cut

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

    my $col = $self->SUPER::column_info_by_col_start( $idx );
    croak "There is no column index $idx"
      unless $col;

    return $col;
}

=pod

=head2 group_info( $name )

Returns the Lire::Report::GroupInfo object that has the name $name.

Contrary to the method in Lire::Report::GroupInfo, this one will
throw an exception if there is no column named $name.

=cut

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

    # Cache the result of the base lookup
    unless ( exists $self->{'group_info'}{$name} ) {
        $self->{'group_info'}{$name} = $self->SUPER::group_info( $name );
    }

    croak "There is no group named $name"
      unless $self->{'group_info'}{$name};

    return $self->{'group_info'}{$name};
}

=pod

=head2 ncols()

Returns the number of columns there is in this table.

=cut

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

    my @cols = $self->column_infos();
    return scalar @cols;
}

=pod

=head2 column_infos()

Returns an array containing all the columns of the table. Each element
is a Lire::Report::ColumnInfo object.

=cut

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

    my @cols = $self->column_children();
    my @groups = $self->group_children();
    while ( @groups ) {
        my $g = shift @groups;
        push @cols, $g->column_children();
        push @groups, $g->group_children();
    }

    return sort { $a->col_start() <=> $b->col_start() } @cols;
}

=pod

=head2 groups()

Returns an array containing all the groups of the table. Each element
is a Lire::Report::GroupInfo object.

=cut

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

    my @groups = ( $self );
    my @children = ( $self );
    while ( @children ) {
        my $g = shift @children;
        push @groups, $g->group_children();
        push @children, $g->group_children();
    }

    return @groups;
}

=pod

=head2 columns_width()

Returns an array where each element represents the suggested columns'
width in characters.

=cut

sub columns_width {
    return map { $_->col_width() } $_[0]->columns();
}

=pod

=head2 header_rows() 

Returns an array reference containing one array reference for each rows
in the header. Each row contains the ColumnInfo that should appear
on the header line. The first row contains all the numerical columns and
the categorical columns appear based on their nesting. The indices of the
column is always equals to its column's start.

=cut

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

    my $rows = [];

    my @groups = $self->groups();
    my @group_row;
    my $ncols = $self->ncols();
    while ( @group_row = grep { $_->row_idx() == ( $#$rows + 1 ) } @groups ) {
        # Grab the ColumInfo in that row
        my @cols = ();
        foreach my $g ( @group_row ) {
            push @cols, grep { $_->class() eq 'categorical' } $g->column_children();
            # Special case for the first row, all value columns go there
            push @cols, grep { $_->class eq 'numerical' } $self->column_infos()
              unless @$rows;
        }

        my $row = [ (undef) x $ncols ];
        foreach my $col ( @cols  ) {
            $row->[ $col->col_start() ] = $col;
        }
        push @$rows, $row;
    }

    return $rows;
}

=pod

=head2 set_variables_indices()

Registers this TableInfo's variables using Lire::Config::VariableIndex.

=cut

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

    Lire::Config::Index->set_index( 'variables',
                                    new Lire::Config::VariableIndex( $self, 'both' ) );
    Lire::Config::Index->set_index( 'categorical_variables',
                                    new Lire::Config::VariableIndex( $self, 'categorical' ) );
    Lire::Config::Index->set_index( 'numerical_variables',
                                    new Lire::Config::VariableIndex( $self, 'numerical' ) );

    return;
}

=pod

=head2 reset_variable_indices() 

Removes the variables indices. This can be called to undo the effect
of set_variables_indices().

=cut

sub reset_variables_indices {
    my $self = $_[0];
    Lire::Config::Index->set_index( 'variables', undef );
    Lire::Config::Index->set_index( 'categorical_variables', undef );
    Lire::Config::Index->set_index( 'numerical_variables', undef );
    return;
}

# ------------------------------------------------------------------------
# Method compute_columns_width()
#
# Try to determine the width of all the columns
sub compute_columns_width {
    my $self = $_[0];

    $self->assign_columns_width;
    $self->correct_spanning_column_width( $self );

    return;
}

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

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

    print $fh $pfx, qq{<lire:table-info>\n};
    foreach my $i ( @{$self->{'children'}} ) {
        $i->write_report( $fh, $indent + 1 );
    }
    print $fh $pfx, "</lire:table-info>\n";

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

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

=head1 VERSION

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

=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. 

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut