package DTA::Controller::Cabview;
use Moose;
use namespace::autoclean;

BEGIN {extends 'Catalyst::Controller'; }

use File::Basename qw(basename);
use File::Temp qw(tempfile);

=head1 NAME

DTA::Controller::Cabview - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=head2 index

=cut

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    my @files = map { basename $_ } glob sprintf "%s/*", $c->path_to( 'var/cabview/' );
    $c->stash(
        files => \@files,
    );
}

=head2 view

=cut

sub view :Local {
    my ( $self, $c, $file ) = @_;
    $file =~ tr{/}{}d; # poor man's sanitation

    $c->forward( 'dta_html', [$file] );
    $c->forward( 'cab_html', [$file] );

    $c->stash(
        template => 'cabview/view.tt',
    );
}

=head2 dta_html

=cut

sub dta_html :Private {
    my ( $self, $c, $file ) = @_;

    open( my $fh, '<', sprintf '%s/%s', $c->path_to( 'var/cabview' ), $file ) or die $!;
    my $rawxml;
    {
        local $/;
        $rawxml = <$fh>;
    }
    close $fh;

    $rawxml =~ s{(</c>)\s+(<hi )}{$1$2}g;
    $rawxml =~ s/\s+<c /<c /g;
    $rawxml =~ s/(rendition=")\s*/$1/g;
    $rawxml =~ s/\R*(<(?:supplied|corr|sic|orig)[^>]*>)\R*/$1/g;
    $rawxml =~ s/\R*(<\/(?:supplied|corr|sic|orig)>)\R*/$1/g;
    $rawxml =~ s{(</c></hi>)\R*(<hi rendition="#(?:c|et|right)"><c )}{$1$2}g;

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

    my ( $tempfh, $tempname ) = tempfile();
    print $tempfh $rawxml;
    close $tempfh;

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

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

    # some fixes
    $html = fixhtml($html);
    utf8::decode( $html );

    #utf8::decode($html);
    $c->stash->{dta_html} = $html;
    $c->res->body(undef);
}

=head2 cab_html

=cut

sub cab_html :Private {
    my ( $self, $c, $file ) = @_;

    our $cab_url     = 'http://data.dwds.de:9099/query';
    our $cab_timeout = 10;

    my $cab_client = DTA::CAB::Client::HTTP->new(
        serverURL   => $cab_url,
        timeout     => $cab_timeout,
        mode        => 'xpost',
        format      => 'tei',
        testConnect =>  0,
    ) or die("$0: could not create CAB client");

    my ($xmlbuf);
    my $infile = sprintf '%s/%s', $c->path_to( 'var/cabview' ), $file;
    {
        local $/ = undef;
        open( my $in, '<', $infile ) or die("$0: open failed for '$infile': $!");
        $xmlbuf = <$in>;
        close $in or die $!;
    }

    my $rsp = $cab_client->analyzeDataRef('caberr', \$xmlbuf, {clean=>1})
        or die("$0: CAB client choked on '$infile': $!");

    die("$0: CAB server choked on '$infile': ", $rsp->as_string)
        if (!$rsp->is_success);

    my $cabxml = $rsp->content;

    my ( $tempfh, $tempname ) = tempfile();
    print $tempfh $cabxml;
    close $tempfh;

    $c->stash->{xml}      = $tempname;
    $c->stash->{template} = 'dta-cab.xsl';
    $c->stash->{pos}      = $c->req->params->{pos} || 0;
    $c->forward('DTA::View::XSLT');
    unlink $tempname;
    my $html = $c->res->body;
    $c->res->body( undef );

    # some fixes
    $html = fixhtml( $html );
    utf8::decode( $html );

    $c->stash( cab_html => $html );
}

sub fixhtml {
    my $str = shift || '';
    utf8::decode($str);
    for ( $str ) {
        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;
        s{(span\s+class="up">[^<]*</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;
    }
    utf8::encode($str);
    return $str;
}

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;
}

__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
