package DTA::Controller::Book::Format::HTML;
use Moose;
use namespace::autoclean;

BEGIN { extends 'Catalyst::Controller'; }

use utf8;
use File::Basename qw(basename);
use File::Temp qw(tempfile);
use LWP::UserAgent;
use Unicruft 'utf8_to_utf8_de';
use URI::Escape;

=head1 NAME

DTA::Controller::Book::Format::HTML - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=head2 index

=cut

sub index :Path :Args(1) {
    my ( $self, $c, $id ) = @_;
    my $book = $c->forward( '/book/validbook', [$id] ); # XXX
    my $dirname = $book->dirname;

    my @page_count = glob sprintf '%s/%s.xml/pages/%s.xml_*.xml', $c->config->{xmlrep}, $dirname, $dirname;
    # auch in root/book/views.tt!
    if ( @page_count > 180 and $book->dirname !~ /tetens_versuche01_1777|tetens_versuche02_1777|lambert_architectonic02_1771|hoelderlin_gedichte_1826|bruemmer/ ) {
        $c->res->content_type( 'text/plain; charset=utf-8' );
        $c->res->body( 'Momentan kann für Werke dieser Größe keine Lesefassung erstellt werden.' );
        $c->detach;
    }

    my $hyphenation = exists $c->req->params->{hyphenation} ? !!$c->req->params->{hyphenation} : 1;
    my $normalize   = exists $c->req->params->{normalize}   ? !!$c->req->params->{normalize}   : 0;
    my $fw          = exists $c->req->params->{fw}          ? !!$c->req->params->{fw}          : 1;
    my $marginals   = exists $c->req->params->{marginals}   ? !!$c->req->params->{marginals}   : 1;
    my $footnotes   = exists $c->req->params->{footnotes}   ? !!$c->req->params->{footnotes}   : 1;
    my $figures     = exists $c->req->params->{figures}     ? !!$c->req->params->{figures}     : 0;
    my $format      = exists $c->req->params->{format}      ?   $c->req->params->{format}      : 'html';

    $c->stash(
        hyphenation => $hyphenation,
        normalize   => $normalize,
        fw          => $fw,
        marginals   => $marginals,
        footnotes   => $footnotes,
        figures     => $figures,
        format      => $format,
    );

    my $ebooks_dir = $c->path_to("var/ebooks/$dirname")."";
    mkdir $ebooks_dir;

    open( my $cssfile, '<', $c->path_to('root/static/dta.css')."" ) or die $!;
    my $css;
    {
        local $/;
        $css = <$cssfile>;
    }
    close $cssfile or die $!;

    my @pages;
    my $page_cnt = 0;
    foreach my $xmlfile ( glob sprintf '%s/%s.xml/pages/%s.xml_*.xml', $c->config->{xmlrep}, $dirname, $dirname ) {
        $page_cnt++;

        ## fw
        ##last if $page_cnt == 10;

        open( my $fh, '<:utf8', $xmlfile ) or die $!;
        my $rawxml;
        {
            local $/;
            $rawxml = <$fh>;
        }
        close $fh or die $!;

        if ( !$hyphenation ) {
            $rawxml = remove_quotes( $rawxml );
        }

        if ( !$fw or $format =~ /epub|mobi/ ) {
            my ( $tempfh, $tempname ) = tempfile();
            binmode( $tempfh, ':utf8' );
            print $tempfh $rawxml;
            close $tempfh or die $!;
            $c->stash(
                xml      => $tempname,
                template => 'no-fw.xsl',
            );
            $c->forward('DTA::View::XSLT');
            unlink $tempname or die $!;
            $rawxml = $c->res->body;
            utf8::decode($rawxml);
        }

        if ( !$marginals or $format =~ /epub|mobi/ ) {
            my ( $tempfh, $tempname ) = tempfile();
            binmode( $tempfh, ':utf8' );
            print $tempfh $rawxml;
            close $tempfh or die $!;
            $c->stash(
                xml      => $tempname,
                template => 'no-marginals.xsl',
            );
            $c->forward('DTA::View::XSLT');
            unlink $tempname or die $!;
            $rawxml = $c->res->body;
            utf8::decode($rawxml);
        }

        if ( !$footnotes ) {
            my ( $tempfh, $tempname ) = tempfile();
            binmode( $tempfh, ':utf8' );
            print $tempfh $rawxml;
            close $tempfh or die $!;
            $c->stash(
                xml      => $tempname,
                template => 'no-footnotes.xsl',
            );
            $c->forward('DTA::View::XSLT');
            unlink $tempname or die $!;
            $rawxml = $c->res->body;
            utf8::decode($rawxml);
        }

        $rawxml = fixxml( $rawxml );
        utf8::decode($rawxml);

        my ( $tempfh, $tempname ) = tempfile();
        binmode( $tempfh, ':utf8' );
        print $tempfh $rawxml;
        close $tempfh or die $!;

        $c->stash->{xml} = $tempname;
        if ( !$hyphenation ) {
            $c->stash->{template} = 'html-nolb.xsl';
        }
        else {
            $c->stash->{template} = 'dtaq.xsl';
        }
        $c->forward('DTA::View::XSLT');
        unlink $tempname;
        my $html = $c->res->body;
        utf8::decode($html);

        if ( $figures ) {
            $html =~ s{<div class="phbl dta-figure" type="(\d+)">\s*\[Abbildung\]\s*</div>}{insert_figure( $dirname, $page_cnt, $1, $format, $ebooks_dir )}eg;
        }

        # clean footnote lookup
        %DTA::View::XSLT::fn_seen = ();

        # some fixes
        $html = fixhtml($html);
        if ( !$hyphenation ) {
            $html = remove_hyph( $html );
        }

        # insert soft hyphens
        $html =~ s/>([^<]+)</'>' . shy1($1) . '<'/ge;

        if ( $normalize ) {
            $html = utf8_to_utf8_de( $html );
        }
        utf8::decode( $html );
        push @pages, $html;
    }

    $c->stash(
        book     => $book,
        css      => $css,
        template => 'book/format/html.tt',
        pages    => \@pages,
    );
    $c->forward( '/book/common/page_number', [$id] );

    $c->forward('DTA::View::Plain');

    if ( $format eq 'mobi' or $format eq 'epub' ) {
        my $result = $c->res->body;

        open( my $html_fh, '>', "$ebooks_dir/$dirname.html" ) or die $!;
        binmode( $html_fh, ':utf8' );
        print $html_fh $result;
        close $html_fh;

        # fetch cover, since it must be a local file
        my $cover_file = $book->dirname . '.jpg';
        if ( !-e "$ebooks_dir/$cover_file" ) {
            my $ua = LWP::UserAgent->new;
            $ua->timeout(10);
            my $url = sprintf 'http://media.dwds.de/dta/images/%s/%s_%04d_400px.jpg', $book->dirname, $book->dirname, ($book->startseite || 1);
            my $res = $ua->get( $url );
            if ( $res->is_success ) {
                open( my $fh, '>', "$ebooks_dir/$cover_file" ) or die $!;
                print $fh $res->content;
                close $fh or die $!;
            }
        }

        if ( $format eq 'mobi' ) {
            ## ocx
            if ( -e "$ebooks_dir/$dirname.toc" ) {
                open( my $toc_fh, '<', "$ebooks_dir/$dirname.toc" ) or die $!;
                my $toc = '';

                my $last_depth = -1;
                my $level      = -1;

                my $n = 2;
                while( my $line = <$toc_fh> ) {
                    chomp $line;
                    next if $line =~ /^#/;
                    my ( $depth, $ptr, $text ) = $line =~ /^(\s*)(\d+):\s*(.*)$/;
                    $depth = length $depth;

                    if ( $depth > $last_depth ) {
                        $level++;
                    }
                    elsif ( $depth == $last_depth ) {
                        $toc .= '</navPoint>';
                    }
                    else { # $depth < $last_depth
                        for ( 0 .. $level ) {
                            $toc .= '</navPoint>';
                        }
                        $level--;
                    }

                    $toc .= sprintf <<"EOT", $n, $n, $text, $dirname, $ptr;
<navPoint class="book" id="navpoint-%d" playOrder="%d">
  <navLabel><text>%s</text></navLabel>
  <content src="%s.html#nav-%s"/>
EOT

                    $last_depth = $depth;
                    $n++;
                }
                close $toc_fh;

                for ( 0 .. $level ) {
                    $toc .= '</navPoint>';
                }

                $c->stash(
                    toc      => $toc,
                    template => 'book/format/ocx.tt',
                );
                $c->forward('DTA::View::Plain');
                my $ncx = $c->res->body;
                open( my $ncx_fh, '>', "$ebooks_dir/$dirname.ncx" ) or die $!;
                print $ncx_fh $ncx;
                close $ncx_fh or die $!;

                $c->stash( has_toc => 1 );
            }

            ## opf
            $c->stash(
                template => 'book/format/opf.tt',
                htmlfile => basename( "$dirname.html" ),
            );
            $c->forward('DTA::View::Plain');
            my $opf = $c->res->body;
            open( my $opf_fh, '>', "$ebooks_dir/$dirname.opf" ) or die $!;
            print $opf_fh $opf;
            close $opf_fh or die $!;

            my $mobi_file = $book->dirname . '.mobi';
            #my $cmd = "cd $ebooks_dir; /home/wiegand/src/kindlegen -o $mobi_file $tempname";
            my $cmd = "cd $ebooks_dir; /home/wiegand/src/kindlegen -o $mobi_file $ebooks_dir/$dirname.opf";
            my @out = `$cmd 2>&1`;
            use Data::Dumper; warn Dumper join "" => @out;

            open( my $tempfh_out, '<', "$ebooks_dir/$mobi_file" ) or die $!;
            $c->res->headers->header( "Content-Disposition" => "attachment; filename=$mobi_file" );
            $c->res->content_type( 'application/x-mobipocket-ebook' );
            $c->res->body( $tempfh_out );
        }
        elsif ( $format eq 'epub' ) {
            my $epub_file = $book->dirname . '.epub';
            my $cmd = sprintf "cd $ebooks_dir; /usr/bin/ebook-convert $dirname.html $ebooks_dir/$epub_file --cover=$ebooks_dir/$cover_file --publisher='Deutsches Textarchiv'";
            my @out = `$cmd 2>&1`;
            use Data::Dumper; warn Dumper $cmd;
            use Data::Dumper; warn Dumper join "" => @out;

            open( my $tempfh_out, '<', "$ebooks_dir/$epub_file" ) or die $!;
            $c->res->headers->header( "Content-Disposition" => "attachment; filename=$epub_file" );
            $c->res->content_type( 'application/epub+zip' );
            $c->res->body( $tempfh_out );
        }
    }
    else {
        $c->res->content_type( 'text/html; charset=utf-8' );
    }

    #my $filename = sprintf '%s.html', $book->dirname;
    #$c->res->headers->header( "Content-Disposition" => "attachment; filename=$filename" );
}

sub insert_figure {
    my ( $dirname, $page_cnt, $figno, $format, $ebooks_dir ) = @_;
    my $url = sprintf 'http://media.dwds.de/~wiegand/figures.pl?book=%s;page=%s;figno=%s;large=%d', $dirname, $page_cnt, $figno, ( $format eq 'html' ? 1 : 0 );
    my $ua = LWP::UserAgent->new;
    $ua->timeout(10);
    my $res = $ua->head( $url );
    if ( !$res->is_success ) {
        return '<div class="phbl dta-figure">[Abbildung]</div>';
    }

    if ( $format =~ /epub|mobi/ ) {
        my $img_file = sprintf '%s_%s_%s_%d.jpg', $dirname, $page_cnt, $figno, 25;
        symlink "/media/figures/$img_file", "$ebooks_dir/$img_file"; # may silently fail
        return sprintf '<div class="dta-figure" style="text-align:center"><img src="%s" style="width:90%%" /></div>', $img_file;
    }
    else {
        return sprintf '<div class="dta-figure" style="text-align:center"><img src="%s" style="max-width:80%%" /></div>', $url;
    }
}


=head2 fixxml

=cut

sub fixxml {
    my $str = shift || '';
    for ( $str ) {
        s{(</c>)\s+(<hi )}{$1$2}g;
        s{\s+<c }{<c }g;
        s{</?c\b[^>]*>}{}g;
        s/(?:\r?\n)*(<(?:supplied|corr|sic|orig)[^>]*>)(?:\r?\n)*/$1/g;
        s/(?:\r?\n)*(<\/(?:supplied|corr|sic|orig)>)(?:\r?\n)*/$1/g;
        s{(?:\r?\n)\s+(</(?:fw|head|l)>)}{$1}g;
        s{\s+(?:\r?\n)(<lb/>)}{$1}g;
        s{([^>])(?:\r?\n)}{$1}g;
        s{\s+(</(?:docAuthor|docDate|item|l|p|pubPlace|titlePart)>)}{$1}g;
        s{\s+(<lb/>)}{$1}g;

        s/(rendition=")\s*/$1/g;
        s/(?:\r?\n)*(<(?:supplied|corr|sic|orig|gap|seg)[^>]*>)(?:\r?\n)*/$1/g;
        s/(?:\r?\n)*(<\/(?:supplied|corr|sic|orig|gap|note)>)(?:\r?\n)*/$1/g;
        s{(</c></hi>)(?:\r?\n)*(<hi rendition="#(?:c|et|right)"><c )}{$1$2}g;
        s{(</hi>)(?:\r?\n)(<hi)\b}{$1$2}g;

        # figure handling
        s{(<(?:lb|head)/>)\s+(<figure)\b}{$1$2}g;
        s{(</figure>)\s+(<lb/>)}{$1$2}g;
        s{(<(?:div|pb|seg)\b[^>]*>)\s*(<figure)\b}{$1<lb/>$2}g;
        s{(<figure.*?/>)\s*(<(?:figure|fw|l|head)\b)}{$1<lb/>$2}g;
        s{(<figure.*?/>)\s*(</?(?:p|div))\b}{$1<lb/>$2}g;

        # centering formulae
        s{
            (<lb/>\s?)
            (
                (?:
                    <formula\s*/>|<formula\b[^>]*>[^<]+</formula>
                )
                (?:
                    [.;,\s]| u\. s\. w\.,?
                )?
            )
            (</(?:p|div|lg|seg|head)>)?
            (<lb/>)
        }{$1<hi rendition="#c">$2</hi>$3}gx;

        # remove page number
        s{<fw type="page number" place="top">.*?</fw>}{}s;
    }
    return $str;
}

=head2 fixhtml

=cut

sub fixhtml {
    my $str = shift || '';
    utf8::decode($str);
    for ( $str ) {
        s{ class="\s+([^"]+)"}{ class="$1"}g;
        s{ class="([^"]+)\s+"}{ class="$1"}g;

        s{(<(?:div|p)[^>]*>)\s+}{$1}g;
        s{(<br(?: ?/)?>)\s+}{$1}g;
        s{</(div|p|h[1-6])>\s*(?:<br(?: ?/)?>)?\s*<((?:div|p|h[1-6])[^>]*)>}{</$1><$2>}g;
        s{(<br(?: ?/)?>)+}{<br />}g;
        s{(</(?:div|p|table|ul)>)<br(?: ?/)?>}{$1}g;

        # fw: Warum?
        #s{(span\s+class="fn-sign">[^<]*</span>)\s*<br(?: ?/)?>\s*}{$1 }g;

        s{(<span[^>]*>)(<br(?:\s*/)?>)}{$2$1}g;
        s{(<span class="(?:g\s*|\s*g|\s*g\s*)">)(.*?)(</span>)(<[^>]+>)?([^<])}{ $1 . fix_emphasis( $2, $3, $4, $5 )  }egs;

        # remove line-break after hr
        s{(<hr\b[^>]*>)\s*<br\b[^>]*>}{$1}g;

        # move footnote sign into the first <p> of the fn
        s{(<div class="footnote">)(<span class="fn-sign">[^<]*</span>\s*)(<p class="dta-p">)}{$1$3$2}g;

        # remove unwanted <br/>s
        # s{(<div class="dta-lg">((?:[^<]++(?:<(?!/?div\b|!--)[^<]*+)*+|<!--.*?-->|<div\b[^>]*+>(?2)</div\s*>)*+))<br(?: /)?>\s*(</div>)}{$1$2}gs;

        # Hebrew: RTL
        s{(\s*)([\p{Hebrew}\s]+\p{Hebrew})}{$1.reverse($2)}eg;
    }
    utf8::encode($str);
    return $str;
}

=head2 fix_emphasis

=cut

sub fix_emphasis {
    my ( $em, $closing_span, $next_tag, $next_char ) = @_;
    no warnings 'uninitialized';
    my $ret = $em . $closing_span . $next_tag . $next_char;
    if ( $em =~ /(.*)(.)(?:<[^>]+>)?$/s && $3 ) {
        my ( $em_start, $em_last, $em_close ) = ( $1, $2, $3 );
        if ( $next_char =~ /[.,;:?!]/ ) {
            $ret = $em_start . $em_close . $closing_span . $em_last . $next_tag . $next_char;
        }
    }
    return $ret;
}

sub remove_quotes {
    my $str = shift;
    $str =~ s{(<p>)([^„]*?„[^„]*?)(.*?)(</p>)}{$1 . $2 . quotes($3) . $4}gse;
    return $str;
}

sub quotes {
    my $str = shift;
    $str =~ s{(<lb/>)\s+„}{$1}g;
    return $str;
}

sub remove_hyph {
    my $str = shift;
    utf8::decode( $str );

    $str =~ s/
        (
            (?:
                [^\s>\(]
            ){2,} # FIXME: does not catch "a-ber" etc.
        )
        #((?:<\/span>)?[-¬](?:<\/span>)?)
        (<\/span>)?([-¬])(<\/span>)?
        \n+\s*
        (
            (?:<span\s+class="(?:aq|g|g\s+et)\s*">)?
            (?:
                [^<\s()]
            )+
        )/hyph($1, $2, $3, $4, $5, '&#xad;')/gex;

    utf8::encode( $str );
    return $str;
}

##++ soft hyphens
use TeX::Hyphen;
my $hyp = TeX::Hyphen->new(
    file     => '/home/wiegand/mysource/git/DTAQ/de.hyphen.tex',
    style    => 'german',
    leftmin  => 2,
    rightmin => 2
);

sub shy1 {
    my $str = shift;
    $str =~ s{(\w+)}{shy2($1)}ge;
    return $str;
}

sub shy2 {
    my $word = shift;
    my $res = $hyp->visualize( $word );
    $res =~ s/-/&#xad;/g;
    return $res;
}
##--

# http://canoo.net/services/OnlineGrammar/Wort/Konjunktion/Gebrauch/subord.html?MenuId=Word811
sub hyph {
    my ( $ante, $span1, $sep, $span2, $post, $sh ) = @_;
    $span1 ||= '';
    $span2 ||= '';

    my $post_clean = $post;
    for ( $post_clean ) {
        s{<.*?>}{}gs;
        s{&nbsp;&nbsp;&nbsp;}{}g; # <space dim="horizontal"/>
    }

    if ( $post_clean =~ /\A(?:bzw\.|u\.|o\.|aber|oder|und\/oder|al[ſs])\z/ ) {
        return sprintf "%s%s%s%s %s", $ante, $span1, $sep, $span2, $post;
    }
    elsif ( $post_clean =~ /^[[:upper:]]/ ) {
        return sprintf "%s%s%s%s%s", $ante, $span1, $sep, $span2, $post;
    }
    elsif ( $post_clean =~ /\A(?:jedoch|beziehung[ſs]wei[ſs]e|noch|[ſs]owie|plu[ſs]|re[ſs]p|bi[ſs]|[ſs]ondern|wie)\z/ ) {
        my $cab_ua = LWP::UserAgent->new;
        $cab_ua->timeout(10);
        my $cab_res = $cab_ua->get("http://data.dwds.de:9099/query?a=default&fmt=json&pretty=1&clean=1&submit=submit&raw=1&q=" . uri_escape_utf8("$ante$post_clean") );
        $cab_res->decoded_content =~ /"tag"\s*:\s*"([^"]+)"/;
        my $cab_tag = $1;

        if ( $cab_res->decoded_content =~ /"tag"\s*:\s*"(?:XY|NN)"/ ) {
            return sprintf "%s%s%s%s%s %s", $ante, $sh, $span1, $sep, $span2, $post;
        }
        else {
            return return sprintf "%s%s%s%s%s", $ante, $sh, $span1, $span2, $post;
        }
    }
    else {
        return sprintf "%s%s%s%s%s", $ante, $sh, $span1, $span2, $post;
    }
}

__PACKAGE__->meta->make_immutable;

1;
__END__

=head1 AUTHOR

Frank Wiegand

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
