package DTA::Controller::Book::Common;
use Moose;
use namespace::autoclean;

BEGIN {extends 'Catalyst::Controller'; }

use utf8;
use LWP::UserAgent;

=head1 NAME

DTA::Controller::Book::Common - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=head2 download_normxml

=cut

sub download_normxml :Private {
    my ( $self, $c, $book ) = @_;
    $c->forward( 'download_splicedxml', [ $book, 'spliced2orig+reg.xsl' ] );
}

=head2 download_lemmaxml

=cut

sub download_lemmaxml :Private {
    my ( $self, $c, $book ) = @_;
    $c->forward( 'download_splicedxml', [ $book, 'spliced2orig+reg_lemma.xsl' ] );
}

=head2 download_unicruftxml

=cut

sub download_unicruftxml :Private {
    my ( $self, $c, $book ) = @_;
    $c->forward( 'download_splicedxml', [ $book, 'spliced2orig+reg_unicruft.xsl' ] );
}

=head2 download_splicedxml

=cut

sub download_splicedxml :Private {
    my ( $self, $c, $book, $template ) = @_;
    my $splice_xml = sprintf '%s/xml_splice/%s.TEI-P5.spliced.xml', $c->config->{dstar_dta_extra}, $book->dirname;
 
    if ( -e $splice_xml ) {
        my $xml = join '' => `/usr/bin/xsltproc "/home/wiegand/mysource/git/DTAQ/root/xslt/$template" "$splice_xml"`;
        utf8::decode( $xml );
        for ( $xml ) {
            s/ſ/s/g;
            s/ xmlns=""//g;
            s{.*<TEI[^>]*>}{<?xml version="1.0" encoding="UTF-8"?>\n<?oxygen RNGSchema="https://www.tei-c.org/release/xml/tei/custom/schema/relaxng/tei_all.rng" type="xml"?>\n<TEI xmlns="http://www.tei-c.org/ns/1.0">\n}s;
        }
        $c->res->content_type( 'application/xml; charset=utf-8' );
        $c->res->body( $xml );
    }
}

=head2 download_lingxml

=cut

sub download_lingxml :Private {
    my ( $self, $c, $book ) = @_;
    my $ling_xml;

    foreach my $subcorpus ( qw(dtae dtak) ) {
        $ling_xml = sprintf '%s/xml_ling/%s.TEI-P5.ling.xml', $c->config->{"dstar_".$subcorpus."_extra"}, $book->dirname;
        last if -e $ling_xml;
    }

    if ( -e $ling_xml ) {
        open( my $fh, '<:utf8', $ling_xml ) or die $!;
        my $xml;
        {
            local $/;
            $xml = <$fh>;
        }
        close $fh;

        # remove all schema attributions, since the xmlling feature
        # has not yet shipped to the TEI
        for ( $xml ) {
            s/<\?xml-model.*?\?>//gs;
            s/<\?oxygen\s.*?\?>//gs;
        }
        $c->res->content_type( 'application/xml; charset=utf-8' );
        $c->res->body( $xml );
    }
}

=head2 download_xml

=cut

sub download_xml :Private {
    my ( $self, $c, $book ) = @_;

    open( my $fh, '<:utf8', sprintf( "%s/%s.TEI-P5.xml", $c->config->{fullxmlrepwithoutc}, $book->dirname ) ) or die $!;
    my $rawxml;
    {
        local $/;
        $rawxml = <$fh>;
    }
    close $fh or die $!;

    my $valid     = -z sprintf( "%s/%s/result_schema",     '/home/wiegand/dta-validation', $book->dirname );
    my $valid_dta = -z sprintf( "%s/%s/result_schema_dta", '/home/wiegand/dta-validation', $book->dirname );
    my $valid_tei = -z sprintf( "%s/%s/result_schema_tei", '/home/wiegand/dta-validation', $book->dirname );

    my $schema_ox_pat = qr/<\?oxygen\s+RNGSchema="([^"]+)"\s+type="xml"\?>/;
    my $schema_xm_pat = qr/<\?xml-model[^>]+?href="([^"]+)"[^>]+?>/;
    my $schema_pat = qr/$schema_ox_pat|$schema_xm_pat/;

    if ( $book->type eq 'MAN' ) {
        $rawxml =~ s{$schema_pat}{<?xml-model href="http://www.deutschestextarchiv.de/basisformat_ms.rng" type="application/xml" schematypens="http://relaxng.org/ns/structure/1.0"?>}
    }
    else {
        if ( !$valid && !$valid_dta && $valid_tei ) {
            #$rawxml =~ s{((?:RNGSchema="|xml-model href="))([^"]+)(")}{$1http://www.tei-c.org/release/xml/tei/custom/schema/relaxng/tei_all.rng$3};
            s{$schema_pat}{<?xml-model href="http://www.tei-c.org/release/xml/tei/custom/schema/relaxng/tei_all.rng" type="application/xml" schematypens="http://relaxng.org/ns/structure/1.0"?>}
        }
        elsif ( !$valid && $valid_dta ) {
            #$rawxml =~ s{((?:RNGSchema="|xml-model href="))([^"]+)(")}{$1http://www.deutschestextarchiv.de/basisformat.rng$3};
            s{$schema_pat}{<?xml-model href="http://www.deutschestextarchiv.de/basisformat.rng" type="application/xml" schematypens="http://relaxng.org/ns/structure/1.0"?>}
        }
    }

    for ( $rawxml ) {
        s{([^\x{01}-\x{ff}])}{sprintf "&#x%04X;", ord($1)}eg;

        # remove all XML comments
        s{<!--.*?-->}{}sg;
    }

    my $filename = sprintf '%s.TEI-P5.xml', $book->dirname;
    $c->res->body( $rawxml );
    $c->res->content_type( 'application/xml; charset=utf-8' );
    $c->res->headers->header( "Content-Disposition" => "attachment; filename=$filename" );
}

=head2 download_tcf

=cut

sub download_tcf :Private {
    my ( $self, $c, $book ) = @_;

    $c->detach('/error_404') unless $book;

    my $ua = LWP::UserAgent->new;
    $ua->timeout(10);
    my $api_url = sprintf( 'http://www.deutschestextarchiv.de/api/cmdi/%s', $book->dirname );
    my $res = $ua->get( $api_url );
    $c->detach('/error_404') unless $res->is_success;
    my $cmdi = $res->decoded_content;
    $cmdi =~ s/\Q<?xml version="1.0" encoding="UTF-8"?>\E//;

=for pod
    $res = $ua->get( $c->uri_for( '/api/tei_header', $book->dirname ) );
    my $tei = $res->decoded_content;
    $tei =~ s/\Q<?xml version="1.0" encoding="UTF-8"?>\E//;
    for ( $tei ) {
        s/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
    }
=cut

    my $filename = sprintf '%s.tcf.xml', $book->dirname;
    open( my $fh, '<:utf8', sprintf( "/home/wiegand/dta-tcf-simple/%s", $filename ) ) or $c->detach('/error_404');
    my $txt;
    {
        local $/;
        $txt = <$fh>;
    }
    close $fh;

    my $out = <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<D-Spin xmlns="http://www.dspin.de/data" version="0.4">
  <MetaData xmlns="http://www.dspin.de/data/metadata">
    <source>
      $cmdi
    </source>
  </MetaData>
  <TextCorpus xmlns="http://www.dspin.de/data/textcorpus" lang="de">
    <text>$txt</text>
  </TextCorpus>
</D-Spin>
EOT

=for pod
    my $out = <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<D-Spin xmlns="http://www.dspin.de/data" version="0.4">
  <TextCorpus xmlns="http://www.dspin.de/data/textcorpus" lang="de">
    <text>$txt</text>
    <textSource type="tei">
      $tei
    </textSource>
  </TextCorpus>
</D-Spin>
EOT
=cut

    $c->res->body( $out );
    $c->res->content_type( 'application/xml; charset=utf-8' );
    $c->res->headers->header( "Content-Disposition" => "attachment; filename=$filename" );
}

=head2 download_fulltcf

=cut

sub download_fulltcf :Private {
    my ( $self, $c, $book ) = @_;

    my $ua = LWP::UserAgent->new;
    $ua->timeout(10);
    my $api_url = sprintf( 'http://www.deutschestextarchiv.de/api/cmdi/%s', $book->dirname );
    my $res = $ua->get( $api_url );
    $c->detach('/error_404') unless $res->is_success;
    my $cmdi = $res->decoded_content;
    $cmdi =~ s/\Q<?xml version="1.0" encoding="UTF-8"?>\E//;

    my $filename = sprintf '%s.tcf.xml', $book->dirname;
    my $source;
    foreach my $subcorpus ( qw(dtae dtak) ) {
        $source = sprintf "%s/xml_tcf/%s.TEI-P5.tcf.xml", $c->config->{"dstar_".$subcorpus."_extra"}, $book->dirname;
        last if -e $source;
    }
    open( my $fh, '<:utf8', $source ) or die $!;
    my $out = do { local $/; <$fh> };
    close $fh;

    $out =~ s{<MetaData xmlns="http://www.dspin.de/data/metadata"/>}{  <MetaData xmlns="http://www.dspin.de/data/metadata">
    <source>
      $cmdi
    </source>
</MetaData>};

    $c->res->body( $out );
    $c->res->content_type( 'application/xml; charset=utf-8' );
    $c->res->headers->header( "Content-Disposition" => "attachment; filename=$filename" );
}

=head2 page_number

=cut

sub page_number :Private {
    my ( $self, $c, $id ) = @_;
    my $book = $c->stash->{book};

    my $nums = $c->model('DTADB::Page')->search(
        {
            book => $book->id_book,
        },
        {
            order_by => 'page',
        }
    );
    while( my $rs = $nums->next ) {
        $c->stash->{page_numbers}{ sprintf "%04d", $rs->page } = $rs->n;
    }
}

=head2 toc_html

=cut

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

    my $book = $c->stash->{book};
    my $dirname = $book->dirname;
    return unless -e "/home/wiegand/dta-toc/$dirname.toc";

    open( my $toc_fh, '<:utf8', "/home/wiegand/dta-toc/$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 !~ /^\s*#f[0-9]{4}:/;
        my ( $depth, $ptr, $text ) = $line =~ /^(\s*)#f(\d+):\s*(.*)$/;
        $depth = length $depth;

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

        $toc .= sprintf '<div class="dta-toc-item" style="margin-left:%dpx; display:list-item; list-style-type:circle" data-depth="%d"><a href="http://www.deutschestextarchiv.de/dtaq/book/view/%s/%d">%s</a></div>', (($depth + 1) * 20), $depth+1, $dirname, $ptr, $text;

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

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

    $c->stash->{toc_html} = $toc;
}

__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

