package Perl6::Pod::Block::table;

=pod

=head1 NAME

Perl6::Pod::Block::table  - Simple tables

=head1 SYNOPSIS

    =table
        The Shoveller   Eddie Stevens     King Arthur's singing shovel   
        Blue Raja       Geoffrey Smith    Master of cutlery              
        Mr Furious      Roy Orson         Ticking time bomb of fury      
        The Bowler      Carol Pinnsler    Haunted bowling ball           


    =for table :caption('Tales in verse')
     Year  |                Name
     ======+==========================================
     1830  | The Tale of the Priest and of His Workman Balda
     1830  | The Tale of the Female Bear 
     1831  | The Tale of Tsar Saltan
     1833  | The Tale of the Fisherman and the Fish
     1833  | The Tale of the Dead Princess
     1834  | The Tale of the Golden Cockerel

=head1 DESCRIPTION

Simple tables can be specified in Perldoc using a =table block. The table may be given an associated description or title using the :caption option. 

Each individual table cell is separately formatted, as if it were a nested =para.

Columns are separated by whitespace (by regex {2,}), vertical lines (|), or border intersections (+). Rows can be specified in one of two ways: either one row per line, with no separators; or multiple lines per row with explicit horizontal separators (whitespace, intersections (+), or horizontal lines: -, =, _) between every row. Either style can also have an explicitly separated header row at the top. 

Each individual table cell is separately formatted, as if it were a nested =para.

This means you can create tables compactly, line-by-line:

    =table
        The Shoveller   Eddie Stevens     King Arthur's singing shovel   
        Blue Raja       Geoffrey Smith    Master of cutlery              
        Mr Furious      Roy Orson         Ticking time bomb of fury      
        The Bowler      Carol Pinnsler    Haunted bowling ball           


or line-by-line with multi-line headers:

    =table
        Superhero     | Secret          | 
                      | Identity        | Superpower 
        ==============|=================+================================
        The Shoveller | Eddie Stevens   | King Arthur's singing shovel   
        Blue Raja     | Geoffrey Smith  | Master of cutlery              
        Mr Furious    | Roy Orson       | Ticking time bomb of fury      
        The Bowler    | Carol Pinnsler  | Haunted bowling ball           
=cut

use warnings;
use strict;
use Data::Dumper;
use Perl6::Pod::Utl;
use Perl6::Pod::Block;
use base 'Perl6::Pod::Block';
use constant {
    NEW_LINE           => qr/^ \s* $/xms,
    COLUMNS_SEPARATE   => qr/\s*\|\s*|[\ ]{2,}/xms,
    COLUMNS_FORMAT_ROW => qr/(\s+)?[\=\-]+[\=\-\+\n]+(\s+)?/xms,
    COLUMNS_FORMAT_ROW_SEPARATE   => qr/\s*\|\s*|\+|[\ ]{2,}/xms,
};

my $grammar = do {
    use Regexp::Grammars;
    qr{
        <grammar: Perl6::Pod::table>
    <token: col_content>( [^\n]*? )
    <token: row>
       ^ \s* <[content=col_content]>+ % <col_delims> \s*
        <require: (?{ 
                $count_cols == scalar(@{ $MATCH{content} })
                })>
   <token: col_delims>( \s+[\|\+]\s+ | \ {2,} | \t+ )
   <token: row_delims>(
        \s* \n* <[header_row_delims=([=-_]+)]>+ % (\+|\s+|\|) \s* \n 
        | <endofline=((\s*\n)+)>
        )

    <token: Table>
        <[row]>+ % <[row_delims]>
    }xms
};

sub new {
    my $class = shift;
    my $self =  $class->SUPER::new(@_);
    my $content = $self->{content}->[0];
    my $count = $self->_get_count_cols($content);
    $self->{tree} = &parse_table($content, $count);
    $self->{col_count} = $count;
    $self

}

sub parse_table {
 my $text = shift;
 our $count_cols = shift;
 my $qr = do {
  use Regexp::Grammars;
   qr {
    <extends: Perl6::Pod::table>
#           <debug:step>

    \A <Table> \Z
   }xms
 };
 if ($text =~ $qr ) {
    return $/{Table}
 } else {
    die "can't parse"
 }
}

=head2 is_header_row

Flag id header row exists

=cut

sub is_header_row {
    my $self = shift;
    exists $self->{tree}->{row_delims}->[0]->{header_row_delims}
}

sub get_rows {
    my $self = shift;
    my $rows = $self->{tree}->{row};
}


sub _get_count_cols {
    my $self      = shift;
    my $txt       = shift;
    my $row_count = 1;

    # calculate count of fields
    foreach my $line ( split /\n/, $txt ) {

        # clean begin and end of line
        $line =~ s/^\s*//;
        $line =~ s/\s*$//;
        my @columns = split( /${\( COLUMNS_SEPARATE )}/, $line );

        #try find format line
        # ---------|-----------, =====+=======
        if ( $line =~ /${\( COLUMNS_FORMAT_ROW )}/ ) {
            @columns = split( /${\( COLUMNS_FORMAT_ROW_SEPARATE )}/, $line );
            $row_count = scalar(@columns);
            $self->{NEED_NEAD}++;
            last;
        }

        #update max row_column
        $row_count =
          scalar(@columns) > $row_count ? scalar(@columns) : $row_count;
    }
    return $row_count;
}

sub _make_row {
    my $self = shift;
    my $rows = shift;
    for (@$rows) { $_ = join " ", @{ $_ || [] } }
    return { data => [@$rows], type => 'row' };

}

sub _make_head_row {
    my $self = shift;
    my $res  = $self->_make_row(@_);
    $res->{type} = 'head';
    delete $self->{NEED_NEAD};
    return $res;
}

sub to_xhtml {
    my ( $self, $to ) = @_;
    my $w  = $to->w;
    $w->raw('<table>');
    if ( my $caption = $self->get_attr->{caption}) {
        $w->raw('<caption>')->print($caption)->raw('</caption>')
    }
    my @rows = @{ $self->get_rows };
    if ( $self->is_header_row) {
       my $header = shift @rows; 
        $w->raw('<tr>');
        foreach my $h (@{ $header->{content} }) {
            $w->raw('<th>');
            $to->visit(Perl6::Pod::Utl::parse_para($h));
            $w->raw('</th>');
        }
        $w->raw('</tr>');
    }
    #render content
    foreach my $r ( @rows ) {
        $w->raw('<tr>');
        foreach my $cnt ( @{$r->{content}} ) {
          $w->raw('<td>');
          $to->visit(Perl6::Pod::Utl::parse_para($cnt));
          $w->raw('</td>');
        }
        $w->raw('</tr>');
    }
    $w->raw('</table>');
}

sub to_docbook {
    my ( $self, $to ) = @_;
    my $w  = $to->w;
    $w->raw('<table>');
    if ( my $caption = $self->get_attr->{caption}) {
        $w->raw('<title>')->print($caption)->raw('</title>')
    }
    $w->raw(qq!<tgroup align="center" cols="!.$self->{col_count}.'">');
    my @rows = @{ $self->get_rows };
    if ( $self->is_header_row) {
       my $header = shift @rows; 
        $w->raw('<thead><row>');
        foreach my $h (@{ $header->{content} }) {
            $w->raw('<entry>');
            $to->visit(Perl6::Pod::Utl::parse_para($h));
            $w->raw('</entry>');
        }
        $w->raw('</row></thead>');
    }
    #render content
     $w->raw('<tbody>');
    foreach my $r ( @rows ) {
         $w->raw('<row>');
        foreach my $cnt ( @{$r->{content}} ) {
         $w->raw('<entry>');
          $to->visit(Perl6::Pod::Utl::parse_para($cnt));
         $w->raw('</entry>');
        }
          $w->raw('</row>');
    }
    $w->raw('</tbody>');
    $w->raw('</tgroup>');
    $w->raw('</table>');

}

1;
__END__

=head1 SEE ALSO

L<http://zag.ru/perl6-pod/S26.html>,
Perldoc Pod to HTML converter: L<http://zag.ru/perl6-pod/>,
Perl6::Pod::Lib

=head1 AUTHOR

Zahatski Aliaksandr, <zag@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009-2012 by Zahatski Aliaksandr

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut