package Lire::ReportParser::AsciiWriter;

use strict;

use base qw/ Lire::ReportParser::RowColHandler /;

use Text::Wrap qw/ wrap /;
use Lire::I18N qw/ set_fh_encoding /;
use Lire::ReportParser::AsciiDocBookFormatter qw/dbk2txt/;

sub new {
    my $self  = shift->SUPER::new( @_, 'summary_when' => 'after' );

    my %args = @_;
    $self->{'columns'} = $args{'columns'} || 74;
    $self->{'max_name_len'} = $args{'max_name_length'} || 180;
    $self->{'_fh'} = $args{'output'} || \*STDOUT;
    $self->{'_encoding'} = $args{'encoding'} || '';

    set_fh_encoding( $self->{'_fh'}, $self->{'_encoding'} )
      if $self->{'_encoding'};

    return $self;
}

sub report_start {
    my $self = shift;
    $self->SUPER::report_start( @_ );
    $self->{'print_timespan'} = 1;

    return;
}

sub print_text {
    my $self = shift;

    my $fh = $self->{'_fh'};
    print $fh @_;
}

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

    if ( $self->{'print_timespan'} ) {
        my $date = $self->current_date();
        my $timespan = $self->current_timespan();

        $self->print_text( "Report generated: ", $date->{'date'}, "\n" )
          if $date;
        if ( $timespan ) {
            $self->print_text( "Reporting on period:\n",
                               $timespan->{'timespan'}, "\n\n" );
        }

        $self->{'print_timespan'} = 0;
    }
}

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

    # Trim the title
    $title =~ s/^\s*//;
    $title =~ s/\s*$//;
    if ($self->in_element( "lire:section" ) ) {
        # Section's title
        my $len = length $title;
        if ( $len > $self->{'columns'} - 12 ) {
            local $Text::Wrap::columns = $self->{'columns'} - 12;
            $self->print_text( wrap( "    ", "    ", $title ), "\n",
                               "    ", "-" x ($self->{'columns'} - 12), "\n\n"
                             );
        } else {
            my $pad = int( ($self->{'columns'} - $len) / 2);
            $self->print_text( ' ' x $pad, $title, "\n", ' ' x $pad,
                              '-' x $len, "\n\n" );
        }
    } else {
        local $Text::Wrap::columns = $self->{'columns'} - 12;
        $self->print_text( wrap( "  ", "  ", $title ), "\n\n" );
    }
}

sub section_end {
    my $self = shift;

     $self->print_text( "  No subreports were generated for this section.\n\n" )
      if ( ! $self->current_section_subreport_count() );

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

sub subreport_start {
    my $self = shift;

    $self->SUPER::subreport_start( @_ );
    $self->{'printed_description'} = 0;
    return;
}

sub subreport_end {
    my $self = shift;

    $self->SUPER::subreport_end( @_ );
    $self->print_text( "\n" );
    return;
}

sub table_start {
    my $self = shift;

    $self->SUPER::table_start( @_ );
    $self->{'curr_headers'} = [];

    return;
}

sub table_end {
    my $self = shift;

    $self->print_text( "    No content in report.\n\n" )
      unless ( $self->current_table_entry_count() );

    $self->SUPER::table_end( @_ );

    # Reset
    delete $self->{'curr_cols_empty_fmt'};
    delete $self->{'curr_cols_print_fmt'};

    return;
}

sub table_info_end {
    my $self = shift;

    $self->SUPER::table_info_end( @_ );

    return;
}

#------------------------------------------------------------------------
# Method set_formatters()
#
# Create the formatter that will be used to print the value of each
# column.
sub set_formatters {
    my ( $self ) = @_;

    my $width = $self->compute_cols_width();
    my @cols  = $self->current_table_info()->column_infos();

    $self->{'curr_cols_empty_fmt'} = [];
    $self->{'curr_cols_print_fmt'} = [];
    $self->{'curr_sep'} = '  ';

    # Empty formatter is only a space specification
    for (my $i=0; $i<@$width; $i++) {
        $self->{'curr_cols_empty_fmt'}[$i] = ' ' x $width->[$i];
    }

    # Create a printf specification that can be used 
    # to print a value for each column or when printing an empty
    foreach my $c ( @cols ) {
        my $start = $c->col_start();
        my $end   = $c->col_end();

        my $w = 0;
        for (my $i=$start; $i<=$end; $i++) {
            $w += $width->[$i];
            # Add the sep's space
            $w++ if $i < $end;
        }

        if ( $c->class() eq 'categorical' ) {
            $self->{'curr_cols_print_fmt'}[$start] = '%-' . $w . 's';

            # Create a -- sep for this categorical column on the first row
            if ( $c->group_info()->row_idx() == 0 ) {
                $self->{'curr_sep'} .= '-' x $w . ' ';
            }
        } else {
            $self->{'curr_cols_print_fmt'}[$start] = '%' . $w . 's';

            # Value column always need generate a sep and reset the 
            # need for one (the next categorical column will generate one)
            $self->{'curr_sep'} .= '-' x $w;
            $self->{'curr_sep'} .= ' ' unless $end == @cols -1;
        }

        # Sets the col_width in the ColumnInfo object
        $c->col_width( $w );
    }
}

#------------------------------------------------------------------------
# Method compute_cols_width()
#
# Determine the width of each columns in the table. Distribute (or crop)
# the space difference between the suggested columns width and the
# width allocated for formatting (the columns parameter).
#
# The distribution is allocated based on a 1 character space inserted
# between the columns and 2 spaces indenting columns.
#
# Returns the resulting columns size as an array reference.
sub compute_cols_width {
    my ( $self ) = @_;

    my $info = $self->current_table_info();
    my @cols = $info->column_infos();
    my @width = ( 0 x @cols );
    my $sep = @cols - 1;
    my $total = 0;
    foreach my $c ( @cols ) {
        $width[ $c->col_start() ] = $c->col_width();
        $total += $c->col_width;
    }

    my $diff = $self->{'columns'} - ( $total + $sep ) - 2; # '-2' => row indent

    # Extra/missing space is added/removed to/from categorical
    # columns
    # We only select the categorical columns that have columns width 
    # of more than 10 chars
    my @cat = grep { $_->class() eq 'categorical' &&
                       $_->col_width() > 10 } @cols;
    # None! Grab all then
    @cat = grep { $_->class() eq 'categorical' } @cols unless @cat;
    if ($diff > 0 ) {
        # Allocate evenly between columns
        my $extra = int( $diff / @cat );
        foreach my $c ( @cat ) {
            $width[ $c->col_start() ] += $extra;
        }
        my $rest = $diff % @cat; # Assigned to the first column
        $width[ $cat[0]->col_start() ] += $rest;
    } else {
        $diff = abs $diff;

        my $found = 0;
        foreach my $c ( @cat ) {
            my $w = $width[ $c->col_start() ];

            # Reduce columns proportionnally: bigger columns are
            # reduced more
            my $shrink = int( $diff * ( $w / $total ));
            if ( $w - $shrink < 10 ) {
                # Prevent columns from shrinking too much
                $shrink = $w - 10;
            }
            $width[ $c->col_start() ] -= $shrink;
            $found += $shrink
        }

        $diff = $diff - $found;
        if ( $diff > 0 ) {
            # Try to shrink real hard or overflow the table at worst
            foreach my $c ( sort { $width[$b->col_start() ] <=> $width[ $a->col_start() ] } @cat ) {
                my $w = $width[ $c->col_start() ];
                my $shrink = $w - $diff > 10 ? $diff : $w - 10;
                $width[ $c->col_start() ] -= $shrink;
                $diff -= $shrink;
                last if $diff <= 0;
            }
        }
    }

    return \@width;
}

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

    my @header_row = ();
    for (my $i=0; $i<@$row; $i++) {
        my $c = $row->[$i];
        if ( $c ) {
            $header_row[$i] = { 'content'  => $c->label,
                                'col_info' => $c,
                              };
        } else {
            $header_row[$i] = undef;
        }
    }

    push @{$self->{'curr_headers'}}, \@header_row;

    return;
}


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

    if ($self->{'curr_headers'}) {
        foreach my $r ( @{$self->{'curr_headers'}}) {
            $self->print_row( $r );
        }
        $self->print_sep;
        delete $self->{'curr_headers'};
    }
    $self->print_row( $row );

    return;
}

sub handle_table_summary {
    my ( $self, $nrecords, $row ) = @_;

    return unless $nrecords && $self->current_table_entry_count();

    $row->[0] = {
                 'content'  => "Total for $nrecords records",
                 'col_info' => $self->current_table_info->column_info_by_col_start( 0 )
                };
    $self->print_sep;
    $self->print_row( $row );
    $self->print_text( "\n" );

    return;
}

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

    $self->print_text( dbk2txt( $docbook, $self->{'columns'} ) );

    return;
}

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

    $self->set_formatters()
      unless exists $self->{'curr_cols_empty_fmt'};

    $self->print_text( $self->{'curr_sep'}, "\n" );

    return;
}

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

    $self->set_formatters()
      unless exists $self->{'curr_cols_empty_fmt'};

    my @overflow = @$row;

    # Initial row indent
    $self->print_text( "  " );
    for ( my $i=0; $i< @$row; $i++ ) {
        my $c = $row->[$i];
        if ( $c ) {
            my $len = length $c->{'content'};
            my $w = $c->{'col_info'}->col_width();

            # Crop to absolute maximum
            if ( $len > $self->{'max_name_len'} ) {
                $c->{'content'} = substr $c->{'content'}, 0, $self->{'max_name_len'};
                $len = $self->{'max_name_len'};
            }

            # Check if the content is wider than the column's width
            my $value;
            if ( $len > $w ) {
                $value = substr( $c->{'content'}, 0, $w-1) . "\\";

                # Keep the cell content for an overflowing row
                $c->{'content'} = '  ' . substr $c->{'content'}, $w-1;
                $overflow[$i] = $c;
            } else {
                $value = $c->{'content'};
                $overflow[$i] = undef;
            }
            $self->print_text( sprintf( $self->{'curr_cols_print_fmt'}[$i],
                                        $value ) );

            # Skip after the column span
            $i = $c->{'col_info'}->col_end();
        } else {
            $self->print_text(  $self->{'curr_cols_empty_fmt'}[$i] );
        }
        $self->print_text( " " ) unless $i + 1 == @$row;
    }
    $self->print_text( "\n" );

    # Print overflow row if needed
    $self->print_row( \@overflow ) if grep { defined $_ } @overflow;

    return;
}

1;

__END__

=pod

=head1 NAME

Lire::ReportParser::AsciiWriter - Lire::ReportParser processor that formats the report in ASCII

=head1 SYNOPSIS

    use Lire::ReportParser::AsciiWriter;

    my $parser = new Lire::ReportParser::AsciiWriter;

    eval { $parser->parsefile( "report.xml" ) };
    print "Parse failed: $@" if $@;

=head1 DESCRIPTION

This is a Lire::ReportParser processor which will print the Lire XML
Report in ASCII on STDOUT.

Its constructor takes the following parameters:

=over 4

=item columns

The number of columsn for which the report should be formatted. Defaults
to 80.

=item max_name_length

The maximum number of characters that will be kept in name element.
Defaults to 180.

=item userlevel

In description, the maximum level of elements that will be displayed.
Defaults to C<normal> (i.e. C<advanced> elements aren't formatted.

=back

=head1 SEE ALSO

Lire::ReportParser(3pm) Lire::AsciiDocBookFormatter(3pm)

=head1 VERSION

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

=head1 COPYRIGHT

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