package Lire::ReportParser::HTMLWriter;

use strict;

use Carp;
use File::Basename;
use File::Copy;
use Locale::TextDomain 'lire';
use POSIX qw/ strftime /;

use Lire::Config::Build qw/ ac_path /;
use Lire::DlfSchema;
use Lire::Error qw/ file_not_readable /;
use Lire::DataTypes qw/ check_bool eval_bool /;
use Lire::ReportParser::ReportBuilder;
use Lire::ReportParser::HTMLDocBookFormatter qw/ dbk2html /;
use Lire::Utils qw/ check_param check_object_param create_file indent is_url
                    text_for_width xml_encode /;
use Lire::I18N qw/set_fh_encoding /;

=pod

=head1 NAME

Lire::ReportParser::HTMLWriter - converting lire XML reports to HTML

=head1 SYNOPSIS

  use Lire::ReportParser::HTMLWriter;

  my $writer = new Lire::ReportParser::HTMLWriter();
  $writer->write_report( $report, $outputdir, 'xhtml' => 0,
                         'one_page' => 0 );

=head1 DESCRIPTION

An object capable of formatting a Lire::Report to HTML in the
directory named $outputdir.

=cut

sub new {
    return bless {}, shift;
}

sub write_report {
    my ( $self, $report, $outputdir, %args ) = @_;

    check_object_param( $report, 'report', 'Lire::Report' );
    check_param( $outputdir, 'outputdir' );

    check_param( $args{'xhtml'}, 'xhtml', \&check_bool,
                 "'xhtml' parameter should be a BOOLEAN (1 or 0)" )
      if defined( $args{'xhtml'} );

    check_param( $args{'one_page'}, 'one_page', \&check_bool,
                 "'one_page' parameter should be a BOOLEAN (1 or 0)" )
      if defined( $args{'one_page'} );

    mkdir $outputdir or die "mkdir $outputdir failed: $!\n"
      unless -d $outputdir;
    die "can't write to $outputdir"
      unless -w $outputdir;

    $self->{'_report'} = $report;
    $self->{'_outputdir'} = $outputdir;
    $self->{'_one_page'} = ( defined $args{'one_page'}
                             ? eval_bool( $args{'one_page'} )
                             : 0 );
    $self->{'_xhtml'} = ( defined $args{'xhtml'}
                          ? eval_bool( $args{'xhtml'} ) : 1 );
    $self->{'_etag'} = $self->{'_xhtml'} ? ' />' : '>';

    $self->start_page( 'index.html' )
      if $self->{'_one_page'};
    $self->write_toc();
    my $i = 1;
    my $nsections = $report->sections();
    foreach my $section ( $report->sections() ) {
        $self->{'_next'} =  ( $i == $nsections 
                              ? $report->schemas()->[0] . ".html"
                              : "section-" . ($i + 1) . ".html" );
        $self->write_section( $section, $i );
        $i++;
    }

    $i = 0;
    my $schemas = $report->schemas();
    foreach my $schema ( @$schemas ) {
        $self->{'_next'} =  ( $i == $#{$schemas}
                              ? undef : $schemas->[$i+1] . ".html" );
        $self->write_schema( $schema );
        $i++;
    }

    $self->end_page()
      if $self->{'_one_page'};
    $self->copy_html_files();

    return;
}

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

    my $css = Lire::Config->get( 'lr_html_css' );
    my $link_infos =
      [ [ 'stylesheet', is_url( $css ) ? $css : basename( $css ), 'text/css',
          1 ],
        [ 'author', 'http://www.logreport.org/', 'The LogReport Foundation',
          1 ],
        [ 'help', 'http://logreport.org/doc/lire/', 'Lire documentation',
          1 ],
        [ 'start', 'index.html', __( 'Table Of Contents' ),
          ! $self->{'_one_page'} ],
        [ 'first', 'section-1.html', __( 'First Section' ),
          ! $self->{'_one_page'} ],
        [ 'last', "section-" . $self->{'_report'}->sections() . ".html",
          __( 'Last Section' ), ! $self->{'_one_page'} ],
        [ 'prev', $self->{'_prev'}, __( 'Previous Page' ),
          ! $self->{'_one_page'} && $self->{'_prev'} ],
        [ 'next', $self->{'_next'}, __( 'Next Page' ),
          ! $self->{'_one_page'} && $self->{'_next'}],
      ];

    my $fh = $self->{'_fh'};
    foreach my $link ( @$link_infos ) {
        my ( $rel, $href, $title, $cond ) = @$link;
        next unless $cond;
        print $fh '    <link rel="', $rel,
          '" href="', $href, '" ',
            ( $rel eq 'stylesheet' ? 'type' : 'title' ), '="', 
              $title, '"', $self->{'_etag'}, "\n";
    }

    return;
}

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

    my $report_title = $self->{'_report'}->title() || __( 'Lire Report' );
    return xml_encode( $title ? $report_title .' : '. $title : $report_title );
}

sub write_chart {
    my ( $self, $subreport, $chart_config ) = @_;

    my $fh = $self->{'_fh'};
    my $type = $chart_config->type();
    my $title = $chart_config->title();
    $title = xml_encode( $title ) if $title;
    my $file = eval { $type->write_chart( $chart_config, $subreport,
                                          'outputdir' => $self->{'_outputdir'},
                                          'format' => 'png' ) };
    if ( $@ ) {
        print $fh  ' ' x 8, '<div class="warning">', "\n", ' ' x 10,
          __x( 'An error occured while generating the chart: {error}',
               'error' => $@ ),
          ' ' x 8, "</div>\n";
    } elsif ( $file ) {
        my $base = basename( $file );
        print $fh <<CHART
        <div class="chart">
          <img src="$base" alt="$title" title="$title"$self->{'_etag'}
        </div>
CHART
    }
    return;
}

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

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

    my $info = $subreport->table_info();
    print $fh ' ' x 8, "<table>\n", ' ' x 10, "<thead>\n";
    foreach my $row ( @{ $info->header_rows() } ) {
        my $skip = 0;
        print $fh ' ' x 12, '<tr>', "\n";
        foreach my $cell ( @$row ) {
            if ( $skip > 0 ) {
                $skip--;
                next;
            }
            print $fh ' ' x 14;
            unless ( defined $cell ) {
                print $fh '<th class="empty"></th>', "\n";
                next;
            }
            if ( $cell->col_start() != $cell->col_end() ) {
                $skip = $cell->col_end() - $cell->col_start();
                print $fh '<th colspan="', $skip + 1,'">';
            } else {
                print $fh '<th>';
            }
            my $schema = $subreport->field_schema( $cell->name() );
            print $fh '<a href="',
              ( $self->{'_one_page'} ? "#schema:$schema:" : "$schema.html#" ),
              $cell->name(), '">'
                if $schema;
            print $fh xml_encode( $cell->label() );
            print $fh '</a>' if $schema;
            print $fh "</th>\n";
        }
        print $fh ' ' x 12, "</tr>\n";
    }
    print $fh  ' ' x 10, "</thead>\n";

    return;
}

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

    my $fh = $self->{'_fh'};
    print $fh ' ' x 10, "<tfoot>\n", ' ' x 12, "<tr>\n";
    my @values = grep { $_->class() eq 'numerical' } $subreport->table_info()->column_infos();
    print $fh ' ' x 14, '<td colspan="', $values[0]->col_start(), '">',
      __x( 'Total for {nrecords} records', 
           'nrecords' => $subreport->nrecords() ), "</td>\n";
    my $next = $values[0]->col_start();
    foreach my $col_info ( @values ) {
        my $curr = $col_info->col_start();
        while ( $next < $curr ) {
            print $fh ' ' x 14, '<td class="empty"></td>', "\n";
            $next++;
        }
        my $value = $subreport->get_summary_value( $col_info->name() );
        print $fh ' ' x 14, '<td class="', $col_info->type(), '">',
          $self->html_value( $value->{'content'}, 50 ), "</td>\n";
        $next = $col_info->col_start() + 1;
    }
    print $fh ' ' x 12, "</tr>\n", ' ' x 10, "</tfoot>\n";

    return;
}

sub html_value {
    my ( $self, $string, $max_width ) = @_;

    $max_width = 180
      unless defined $max_width;
    $max_width = 5 if ( $max_width < 5 );

    my $link;
    my $cropped_string = xml_encode( text_for_width( $string, $max_width ) );

    if ( $string =~ m@^[a-zA-Z]+://@ ) {
        $link = "<a href=\"$string\" class=\"link\">$cropped_string</a>";
    } elsif ( $string =~ m/([\.a-zA-Z0-9_+\#\$-]+@[\.a-zA-Z0-9_+\#\$-]+)/ ) {
        $link = "<a href=\"mailto:${1}\" class=\"link\">$cropped_string</a>";
    } else {
        $link = $cropped_string;
    }

    return $link;
}

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

    my $schema = Lire::DlfSchema::load_schema( $schema_id );
    unless ( $self->{'_one_page'} ) {
        $self->start_page( "$schema_id.html", $schema->title() );
    }

    my $fh = $self->{'_fh'};
    print $fh '    <div class="section">', "\n";
    print $fh '      <h2><a name="schema:', $schema_id,
      '">', xml_encode( $schema->title() ), "</a></h2>\n"
        if $self->{'_one_page'};
    print $fh "      <dl>\n";
    foreach my $field ( $schema->fields() ) {
        next if $field->name() =~ /^(dlf_id|dlf_source)$/;
        my $name = $self->{'_one_page'} ? "schema:$schema_id:" .
          $field->name() : $field->name();
        my $label = xml_encode( $field->label() );
        my $desc = $field->description ? dbk2html( $field->description() )
          : __( 'No description.' );
        print $fh <<TERM;
        <dt><a name="$name">$label</a></dt>
        <dd>
        $desc
        </dd>
TERM
    }
    print $fh <<SECTION;
      </dl>
    </div>
SECTION

    unless ( $self->{'_one_page'} ) {
        $self->end_page();
        $self->{'_prev'} = "$schema_id.html";
    }

    return;
}

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

    my $fh = $self->{'_fh'};
    unless ( $subreport->entries() ) {
        print $fh ' ' x 10, "<tbody>\n", ' ' x 12, "<tr>\n",
          ' ' x 14, '<td colspan="', $subreport->table_info()->ncols(), 
            '" class="empty">',
          __( 'There is no entries in this table.' ), "</td>\n",
          ' ' x 12, "</tr>\n", ' ' x 10, "</tbody>\n", ' ' x 8, "</table>\n";
        return;
    }

    print $fh ' ' x 10, "<tbody>\n";
    foreach my $row ( @{$subreport->getrows()} ) {
        my $skip = 0;
        print $fh ' ' x 12, "<tr>\n";
        foreach my $cell ( @$row ) {
            if ( $skip > 0 ) {
                $skip--;
                next;
            }
            print $fh ' ' x 14;
            unless ( defined $cell ) {
                print $fh '<td class="empty"></td>', "\n";
                next;
            }
            my $col_info = $cell->{'col_info'};
            if ( $col_info->col_start() != $col_info->col_end() ) {
                $skip = $col_info->col_end() - $col_info->col_start();
                print $fh '<td colspan="', $skip + 1, '"';
            } else {
                print $fh '<td';
            }
            print $fh ' class="', $col_info->type(), '">',
              $self->html_value( $cell->{'content'} ), "</td>\n";
        }
        print $fh ' ' x 12, "</tr>\n";
    }
    print $fh ' ' x 10, "</tbody>\n", ' ' x 8, "</table>\n";

    return;
}

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

    my $fh = $self->{'_fh'};
    my $id = $subreport->id();
    my $title = xml_encode( $subreport->title() );
    my $desc  = $subreport->description() ? dbk2html( $subreport->description() ) : '';
    print $fh <<SUBREPORT;
      <div class="subreport">
        <h3><a name="$id">$title</a></h3>
        <div class="description">
        $desc
        </div>
SUBREPORT
    if ( $subreport->is_missing() ) {
        print $fh ' ' x 8, '<div class="warning">', "\n",
          ' ' x 10, 
            __x( 'This report is missing: {reason}',
                 'reason' => xml_encode( $subreport->missing_reason() ) ), 
                   "\n", ' ' x 8, '</div>', "\n",
          ' ' x 6, "</div>\n";
        return;
    }

    foreach my $cfg ( @{$subreport->chart_configs()} ) {
        $self->write_chart( $subreport, $cfg );
    }
    $self->write_table_header( $subreport );
    $self->write_table_footer( $subreport );
    $self->write_table_entries( $subreport );

    print $fh ' ' x 6, "</div>\n";

    return;
}

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

    unless ( $self->{'_one_page'} ) {
        $self->start_page( "section-$index.html", $section->title() );
    }

    my $fh = $self->{'_fh'};
    print $fh '    <div class="section">', "\n", '      <h2>';
    print $fh '<a name="section-', $index, '">'
        if $self->{'_one_page'};
    print $fh xml_encode( $section->title() );
    print $fh '</a>'
      if $self->{'_one_page'};
    print $fh  "</h2>\n";
    print $fh '      <div class="description">', "\n", '      ',
      dbk2html( $section->description() ), "\n",
        '      </div>', "\n"
          if $section->description();

    if ( $section->subreports() ) {
        foreach my $subreport ( $section->subreports() ) {
            $self->write_subreport( $subreport );
        }
    } else {
        print $fh '      <p class="no-content">',
          __( 'No subreports were generated for this section.' ), "</p>\n";
    }

    print $fh "    </div>\n";

    unless ( $self->{'_one_page'} ) {
        $self->end_page();
        $self->{'_prev'} = "section-$index.html";
    }

    return;
}

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

    unless ( $self->{'_one_page'} ) {
        $self->{'_next'} = 'section-1.html';
        $self->start_page( 'index.html', __( 'Table Of Contents' ) );
    }

    my $fh = $self->{'_fh'};
    print $fh '    <div class="section">', "\n";
    print $fh '      <h2>', __( 'Table Of Contents' ), "</h2>\n"
      if $self->{'_one_page'};
    print $fh '      <ol class="toc">', "\n";

    my $i = 1;
    foreach my $section ( $self->{'_report'}->sections() ) {
        $self->write_section_toc( $section, $i );
        $i += 1;
    }
    foreach my $schema_id ( @{$self->{'_report'}->schemas()} ) {
        my $schema = Lire::DlfSchema::load_schema( $schema_id );
        my $href = $self->{'_one_page'} ? "#schema:" . $schema_id : $schema_id . ".html";
        $self->write_toc_link( $href, $schema->title(), 8 );
    }
    print $fh <<TOC;
      </ol>
    </div>
TOC

    unless ( $self->{'_one_page'} ) {
        $self->end_page();
        $self->{'_toc'} = 'index.html';
        $self->{'_prev'} = 'index.html';
    }

    return;
}

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

    my $href = $self->{'_one_page'} ? "#section-$idx" : "section-$idx.html";
    my $title = xml_encode( $section->title() );
    my $fh = $self->{'_fh'};
    print $fh <<SECTION;
        <li>
          <div class="toc-section">
            <a href="$href" class="link toc-entry">$title</a>
            <ol class="toc-section">
SECTION
    foreach my $subreport ( $section->subreports() ) {
        my $href = $self->{'_one_page'} ? '#' . $subreport->id() : "section-$idx.html#" . $subreport->id();
        $self->write_toc_link( $href,  $subreport->title(), 14 );
    }
    print $fh <<SECTION;
            </ol>
          </div>
        </li>
SECTION

    return;
}

sub write_toc_link {
    my ( $self, $href, $title, $indent ) = @_;

    print {$self->{'_fh'}} ' ' x $indent, '<li><a href="', $href, 
      '" class="link toc-entry">', xml_encode( $title ), '</a></li>', "\n";

    return;
}

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

    return if $self->{'_one_page'};

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


    print $fh '    <div class="navigation">', "\n";
    if ( $self->{'_toc'} ) {
        my $toc = __( 'Table Of Contents' );
        print $fh <<ETOC;
      <a href="$self->{'_toc'}" class="navigation"><img src="toc.png" alt="$toc" title="$toc" id="toc-button"$self->{'_etag'}</a>
ETOC
    }
    if ( $self->{'_prev'} ) {
        my $prev = __( 'Previous' );
        print $fh <<EPREV;
      <a href="$self->{'_prev'}" class="navigation"><img src="prev.png" alt="$prev" title="$prev" id="prev-button"$self->{'_etag'}</a>
EPREV
    }
    if ( $self->{'_next'} ) {
        my $next = __( 'Next' );
        print $fh <<ENEXT;
      <a href="$self->{'_next'}" class="navigation"><img src="next.png" alt="$next" title="$next" id="next-button"$self->{'_etag'}</a>
ENEXT
    }
    print $fh "    </div>\n";
    return;
}

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

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

    my $format = '%Y-%m-%d %H:%M:%S %Z';
    print $fh '    <div class="report-infos">', "\n";
    print $fh '      ', __x( 'Report generated on: {date}',
                             'date' => strftime( $format,
                                                 localtime( $self->{'_report'}->date() ) ) );
    print $fh "<br$self->{'_etag'}\n";

    my $period;
    if ( $self->{'_report'}->timespan_start() ) {
        $period = strftime( $format, localtime( $self->{'_report'}->timespan_start() ) )
          . ' - '
            . strftime( $format, localtime( $self->{'_report'}->timespan_end() ) );
    } else {
        $period = __( 'Unknown Period' );
    }
    print $fh '      ', __x( 'Reporting on period: {period}',
                             'period' => $period ),
                               "<br$self->{'_etag'}\n    </div>\n";
    return;
}

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

    my $logo = Lire::Config->get( 'lr_logo' );
    return unless $logo;

    my $url = Lire::Config->get( 'lr_logo_url' );

    my $fh = $self->{'_fh'};
    print $fh '    <div class="logo">', "\n", '      ';
    print $fh '<a href="', $url, '" class="logo">'
      if $url;
    my $src = is_url( $logo ) ? $logo : basename( $logo );
    print $fh '<img src="', $src, '" class="logo"', $self->{'_etag'};
    print $fh '</a>'
      if $url;
    print $fh "\n", '    </div>', "\n";

    return;
}

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

    open $self->{'_fh'}, "> $self->{'_outputdir'}/$page"
      or die "can't write to '$self->{'_outputdir'}/$page': $!\n";
    set_fh_encoding( $self->{'_fh'}, 'utf-8' );

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

    if ( $self->{'_xhtml'} ) {
        print $fh <<DTD;
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
DTD
    } else {
        print $fh <<DTD;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">
DTD
    }
    my $page_title = $self->report_title( $title );
    print $fh <<HEAD;
<html>
  <head>
    <title>$page_title</title>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8"$self->{'_etag'}
HEAD
    $self->write_links();
    print $fh <<BODY;
  </head>
  <body>
    <div class="title">
BODY
    $self->write_logo();
    $self->write_navbar();

    $title = $title ? xml_encode( $title ) : $self->report_title();
    print $fh <<TITLE;
      <h2>$title</h2>
TITLE
    $self->write_report_infos();

    print $fh "    </div>\n";

    return;
}

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

    print {$self->{'_fh'}} <<HTML;
  </body>
</html>
HTML
    $self->{'_fh'}->close();
    $self->{'_fh'} = undef;

    return;
}

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

    my $logo = Lire::Config->get( 'lr_logo' );
    copy( $logo, $self->{'_outputdir'} )
      unless is_url( $logo );

    my $css = Lire::Config->get( 'lr_html_css' );
    copy( "$css", $self->{'_outputdir'} )
      unless is_url( $css );

    unless ( $self->{'_one_page'} ) {
        my $html_dir = ac_path( 'datadir', 'PACKAGE' ) . '/html';
        foreach my $file ( qw/ toc.png prev.png next.png / ) {
            copy( "$html_dir/$file", $self->{'_outputdir'} );
        }
    }

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 AUTHORS

  Wolfgang Sourdeau <wolfgang@logreport.org>
  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

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

=head1 COPYRIGHT

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