package Wikisource;

use utf8;
use Archive::Tar;
use Carp;
use Cwd;
use File::Basename qw(basename);
use File::Path;
use HTML::Entities;
use LWP::UserAgent::WithCache;
use MediaWiki::API;
use Mojo::DOM;
use Moose;
use Time::HiRes 'usleep';
use URI::Escape;

use warnings;
use strict;

my @meta_map = (
    [ author    => qr/AUTOR=(.*)/ ],
    [ title     => qr/TITEL=(.*)/ ],
    [ subtitle  => qr/SUBTITEL=(.*)/ ],
    [ from      => qr/HERKUNFT=(.*)/ ],
    [ editor    => qr/HERAUSGEBER=(.*)/ ],
    [ edition   => qr/AUFLAGE=(.*)/ ],
    [ publisher => qr/VERLAG=(.*)/ ],
    [ place     => qr/ERSCHEINUNGSORT=(.*)/ ],
    [ year      => qr/ERSCHEINUNGSJAHR=(.*)/ ],
);

my $wiki_base = 'http://de.wikisource.org';
my $thumb_width = '200';

my %ua_opt = (
    namespace          => 'lwp-cache',
    cache_root         => '/home/wiegand/lwp-cache',
    default_expires_in => 60 * 60 * 24, # 7 days
    agent              => 'Mozilla',
);

has 'ua'            => ( is => 'rw', isa => 'LWP::UserAgent' );
has 'mw'            => ( is => 'rw', isa => 'MediaWiki::API' );
has 'metadata'      => ( is => 'rw', isa => 'HashRef' );
has 'meta_map'      => ( is => 'rw', isa => 'ArrayRef' );
has 'image_sources' => ( is => 'rw', isa => 'ArrayRef' );
has 'index_page'    => ( is => 'rw', isa => 'Str' );
has 'page'          => ( is => 'rw', isa => 'Str' );
has 'pages'         => ( is => 'rw', isa => 'ArrayRef' );
has 'er'            => ( is => 'rw', isa => 'Str' );

=head1 METHODS

=cut

sub BUILD {
    my $self = shift;

    $self->ua( LWP::UserAgent::WithCache->new(\%ua_opt) );
    $self->meta_map( \@meta_map );
    $self->mw( MediaWiki::API->new );
    $self->mw->{config}->{api_url} = $wiki_base . '/w/api.php';
}

=head2 fetch_meta

=cut

sub fetch_meta {
    my $self = shift;

    my $page = $self->mw->get_page( { title => $self->page } );
    my $info = $page->{'*'};
    if ( !$info ) {
        use Data::Dumper; warn Dumper $info;
        die "Could not retrieve metadata for " . $self->page, "\n";
    }

    if ( $info =~ /\{\{GartenlaubenArtikel/ ) {
        die "Der Import von Gartenlaube-Artikeln ist momentan nicht moeglich.", "\n";
    }

    my %metadata;
    foreach my $field ( @meta_map ) {
        ( $metadata{$field->[0]} ) = $info =~ $field->[1];
        $metadata{$field->[0]} =~ s/(^\s*|\s*$)//g;
        $metadata{$field->[0]} = '' if $metadata{$field->[0]} eq 'off';
    }

    my ( $index_page ) = $info =~ /INDEXSEITE=(.*)/;
    if ( !$index_page ) {
        die "Dieses Werk hat keine Index-Seite.\n";
    }
    for ( $index_page ) {
        s/\s/_/g;
    }
    $self->index_page( $index_page );

    my ( $imgsrc ) = $info =~ /QUELLE=(.*)/;
    my @imgsrc = _imgsrc( $imgsrc );
    $self->image_sources( \@imgsrc );

    $self->metadata( \%metadata );
    return \%metadata;
}

=head2 get_er

=cut

sub get_er {
    my $self = shift;
    return $self->er if $self->er;

    my $ua = $self->ua;
    my $res = $ua->get( sprintf '%s/wiki/Index:%s', $wiki_base, $self->index_page );

    my ( $er ) = $res->decoded_content =~ m{Editionsrichtlinien</td>\s*<td\b[^>]*>\s*(.*?)\s*</td>}s;

    $self->er( $er );
    return $er;
}

=head2 fetch_from_index

=cut

sub fetch_from_index {
    my $self = shift;

    my $ua = $self->ua;
    my $res = $ua->get( sprintf '%s/wiki/Index:%s', $wiki_base, $self->index_page );

    my ( $snip ) = $res->decoded_content =~ m{<span class="plainlinks">.*?<td\b[^>]*>\s*<p>(.*?)</td>}s;
    if ( !$snip ) {
        carp sprintf 'Could not retrieve page list from index page %s/wiki/Index:%s.', $wiki_base, $self->index_page;
        return;
    }

    my $tar = Archive::Tar->new;
    my $safename = $self->page;
    $safename =~ s/[\/.,() ]/_/g;
    File::Path::make_path( '/home/wiegand/ws-files-html/' . $safename );
    for my $i ( glob sprintf('/home/wiegand/ws-files-html/%s/*', $safename) ) {
        unlink $i;
    }

    my @pages;
    my $i = 1;
    while( $snip =~ /<a\s+href="([^"]+)".*?>([^<]+)<\/a>/gs ) {
        my ( $link, $num ) = ( $1, $2 );

        # remove &#160; etc. from the page number
        $num = decode_entities($num);
        $num =~ s/\s//g;

        my ( $image, $thumb );

        my $uri = $wiki_base . $link;
        if ( !$ua->{cache}->get( $uri ) ) {
            print STDERR sprintf "URI %s not found in lwp-cache, sleeping 0.1 sec ...", $uri;
            usleep 100_000;
        }
        print STDERR "fetching $uri ...\n";
        my $r = $ua->get( $uri );

        ( $thumb ) = $r->content =~ /"proofreadPageThumbURL":"([^"]+)"/;
        ( $image ) = $r->content =~ /"proofreadPageURL":"([^"]+)"/;
        if ( !$thumb ) {
            $thumb = $image;
        }
        else {
            $thumb =~ s/##WIDTH##/$thumb_width/;
            $thumb = 'http:' . $thumb;
        }
        $image = 'http:' . $image;

        open( FH, '>', sprintf('/home/wiegand/ws-files-html/%s/%04d.html', $safename, $i) ) or die $!;
        print FH $r->content;
        close FH;

        push @pages, {
            link   => $wiki_base . $link,
            alnum  => $i,
            num    => $num,
            thumb  => $thumb,
            image  => $image,
        };
        $i++;
    }
    $self->pages( \@pages );

    my $oldcwd = cwd();
    chdir "/home/wiegand/ws-files-html/$safename/";
    $tar->add_files( glob "*.html" );
    $tar->write( "/home/wiegand/ws-files-html/$safename/html.tar.gz", COMPRESS_GZIP );
    chdir $oldcwd;
    $self->image_tar;
    $self->gentei;
}

=head2 fetch_from_page

=cut

sub fetch_from_page {
    my $self = shift;

    my $link = sprintf '%s/wiki/%s', $wiki_base, $self->page;
    my $ua = $self->ua;
    my $res = $ua->get( $link );
    if ( !$res->is_success ) {
        die "Could not fetch $link\n";
    }
    my $safename = $self->page;
    $safename =~ s/[\/.,() ]/_/g;

    File::Path::make_path( '/home/wiegand/ws-files-html/' . $safename );
    for my $i ( glob sprintf('/home/wiegand/ws-files-html/%s/*', $safename) ) {
        unlink $i;
    }

    open( my $fh, '>', sprintf('/home/wiegand/ws-files-html/%s/full.html', $safename) )
        or die $!;
    print $fh $res->content;
    close $fh or die $!;

    my $tar = Archive::Tar->new;
    my $oldcwd = cwd();
    chdir "/home/wiegand/ws-files-html/$safename/";
    $tar->add_files( 'full.html' );
    $tar->write( "/home/wiegand/ws-files-html/$safename/html.tar.gz", COMPRESS_GZIP );
    chdir $oldcwd;

    $self->pages([
        link => $link,
    ]);
    $self->gentei;
}

sub image_tar {
    my $self = shift;

    my $ua = $self->ua;
    my $tar = Archive::Tar->new;

    my $safename = $self->page;
    $safename =~ s/[\/.,() ]/_/g;
    File::Path::mkpath( '/home/wiegand/ws-files/' . $safename );

    if ( !-e "/home/wiegand/ws-files/$safename/images.tar.gz" ) {
        foreach my $page ( @{$self->pages} ) {
            print STDERR "fetching " . $page->{image} . " ...\n";
            my $res = $ua->get( $page->{image} );

            my ( $ext ) = $page->{image} =~ /\.([^.]+)$/;
            my $image_file = sprintf "/home/wiegand/ws-files/%s/%04d.%s", $safename, $page->{alnum}, $ext;

            open( my $fh, '>', $image_file ) or die $!;
            print $fh $res->content;
            close $fh;
        }
        my $oldcwd = cwd();
        chdir "/home/wiegand/ws-files/$safename/";
        $tar->add_files( glob "*.png *.jpg *.gif *.jpeg" );
        $tar->write( "/home/wiegand/ws-files/$safename/images.tar.gz", COMPRESS_GZIP );
        chdir $oldcwd;
    }
}

sub gentei {
    my $self = shift;

    my $safename = $self->page;
    $safename =~ s/[\/.,() ]/_/g;

    my @out;
    foreach my $file ( glob "/home/wiegand/ws-files-html/$safename/*.html" ) {
        open( my $flh, '<:utf8', $file ) or die "$!, file: $file";
        my $in;
        {
            local $/;
            $in = <$flh>;
        }
        close $flh;

        my $html;
        eval {
            for my $i ( 1 .. 10 ) {
                $html = Mojo::DOM->new( $in )->find('table')->[$i]->find('tr td')->[0]->content_xml;
                last if $html =~ /class="PageNumber"/;
            }
            1;
        };
        my $xml = convert( $html, $in );
        push @out, $xml;
    }

    my $out = <<"EOT";
<?xml version="1.0" encoding="UTF-8"?>
<?xml-model href="http://www.deutschestextarchiv.de/basisformat.rng" type="application/xml" schematypens="http://relaxng.org/ns/structure/1.0"?>
<TEI xmlns="http://www.tei-c.org/ns/1.0">
  <teiHeader>
    <fileDesc>
      <titleStmt>
        <title type="main">...</title>
      </titleStmt>
      <publicationStmt>
        <p>Publication Information</p>
      </publicationStmt>
      <sourceDesc>
        <p>aus Wikisource, der freien Quellensammlung</p>
      </sourceDesc>
    </fileDesc>
  </teiHeader>
  <text>
    <body>
EOT

    my $i = 1;
    for( @out ) {
        $out .= sprintf '<pb facs="#f%04d"/> %s ', $i, $_;
        $i++;
    }

    $out .= '</body></text></TEI>';
    open( my $fh, '>:utf8', "/home/wiegand/ws-files-html/$safename/tei.xml" ) or die $!;
    print $fh $out;
    close $fh;
}

sub convert {
    my ( $s, $content ) = @_;

    # references
    my $ref_dom = Mojo::DOM->new( $content )->find('ol[class="references"]')->[0];
    if ( $ref_dom ) {
        my %references;
        for my $li ( $ref_dom->find( 'li[id^="cite_note"]' )->each ) {
            my $ref_a = $li->find( 'a[href^="#cite_ref"]' )->[0]{href};
            $references{ $ref_a } = $li->content_xml;
        }

        while( my ( $key, $value ) = each %references ) {
            $key = substr( $key, 1 );
            my $sup;
            eval { $sup = Mojo::DOM->new( $s )->find( "sup[id=\"$key\"]" )->[0]->to_xml; 1 };
            if ( $@ ) {
                print STDERR "could not parse references\n";
                return;
            }
            my $ref_text = Mojo::DOM->new( $value )->find( '.reference-text' )->[0]->content_xml;

            $ref_text = sprintf '<note place="foot" n="*)">%s</note>', $ref_text;
            $s =~ s/\Q$sup\E/$ref_text/;
        }

        my $ref_html = $ref_dom->to_xml;
        $s =~ s/\Q$ref_html\E//;
    }

    # poems
    $s =~ s{<div\b[^>]*class="ws-noexport"[^>]*>.*?</div>\s*}{}gs;
    Mojo::DOM->new( $s )->find( 'div[class="poem"]' )->each( sub {
        my $poem_dom = shift;
        my $poem_html_before = $poem_dom->to_xml;
        my $poem_html_after = $poem_dom->content_xml;
        for ( $poem_html_after ) {
            #s{<br />\s*<p><br />}{\n<p>}gs;
            s{<p>(.*?)</p>}{$1}gs;
            # stanzas
            s{<br\s*/>\s*<br\s*/>}{<br />\n</lg>\n<lg>}g;
            #s{(.*</lg>)<lg>}{$1}s;

            # verses
            s{^<span style="padding-left:\d+px; text-align:left;">\s+</span>}{ }gm;
            s{^(?!</?(?:p|div|span|lg)\b)(\S)}{<l>$1}gm;
            s{<l>\s+}{<l rendition="#et">}g;
            s{^\s+}{<l rendition="#et">}gm;
            s{\s*$}{}gm;
            s{(?<!>)$}{<br />}mg;
            s{<br\s*/>}{</l><lb/>}g;
            s{^([^<])}{<l>$1}gm;
        }
        $s =~ s{\Q$poem_html_before\E}{<lg type="poem"><lg>\n$poem_html_after\n</lg></lg>}s;

        # cleanup
        for ( $s ) {
            s{<lg></l><lb/>}{<lg>}g;
            s{<l></l><lb/>}{}g;
            s{(<l rendition="#et">)\s*<l>}{$1}g;
        }
    } );

    for ( $s ) {
        # page numbering
        my $n = 1;
        if ( /<span class="PageNumber"/ ) {
            s{<span class="PageNumber".*?(\d+)\.jpg">([^<]+)</a></b>]</span>}{sprintf '<pb facs="#f%04d" n="%s"/>', $n++, $2}egs;
        }
        else {
            s{<span><span class="pagenum" id="([^"]+)" title="[^"]+"></span></span>}{sprintf '<pb facs="#f%04d" n="%s"/>', $n++, $1}egs;
        }

        # horizontal rules
        s{<hr\b[^>]*>}{<milestone unit="section" rendition="#hr"/><lb/>}g;

        # tables
        s{<table\b[^>]*>(.*?)</table>}{<table>$1</table>}gs;
        s{<tr[^>]*>(.*?)</tr>}{<row>$1</row>}gs;
        s{<td\b([^>]*)>(.*?)</td>}{ _cell( $1, $2 ) }gse;

        # hi
        s{<i>(.*?)</i>}{<hi rendition="#g">$1</hi>}gs;
        s{<tt>(.*?)</tt>}{<hi rendition="#aq">$1</hi>}gs;
        s{<b>(.*?)</b>}{<hi rendition="#b">$1</hi>}gsi;
        s{<span style="font-variant:small-caps;">([^<]+)</span>}{<hi rendition="#k">$1</hi>}gs;

        # blocks
        s{<div style="text-align:center"><big>(.*?)</big></div>}{<head>$1</head><lb/>}g;
        s{<div style="margin-left:auto; margin-right:auto; text-align:center; font-size:110%; letter-spacing:0.0em;">(.*?)</div>}{<head>$1</head><lb/>}gs;
        s{<div style="text-align:center; font-size:\d+%; line-height:\d+pt">(.*?)</div>}{<head>$1</head><lb/>}gs;

        s{<div style="text-align:\s*center;?">(.*?)</div>}{<p rendition="#c">$1</p>}gs;
        s{<div style="text-align:\s*right;?">(.*?)</div>}{<p rendition="#right">$1</p>}gs;
        s{<div align="right">(.*?)</div>}{<p rendition="#right">$1</p>}gs;

        # images
        s{<div class="center">\s*<div class="tnone thumbcaption"[^>]*><a\b[^>]*><img.*?src="([^"]+)"[^>]*></a>(.*?)</div>\s*</div>}{<lb/><figure facs="http:$1">$2</figure><lb/>}gs;
        s{<div\b[^>]*>(?:<a\b[^>]*>)?<img\b[^>]*src="([^"]*)"[^>]*>(?:</a>)</div>}{<lb/><figure facs="http:$1"/><lb/>}gs;

        # fractions
        s{<span\b[^>]*>(\d+)</span>/<span\b[^>]*>(\d+)</span>}{ _frac($1,$2) }ges;

        # clean up
        s{<p><br /></p>}{}g;
        s{<p><br />\s*}{<p>}g;
        s{<div\b[^>]*>\s*</div>}{}g;
        s{<span\b[^>]*>\s*</span>}{}g;
        s{<a\b[^>]*>(.*?)</a>}{$1}gs;
        s{(<pb\b[^>]*>)\s*<lb/>}{$1\n}gs;
        s{(<p\b[^>]*>)\s*(<pb\b[^>]*>)}{$2$1}gs;
        s{(<p rendition="#right">.*?</p>)\s*(</lg>)}{$2\n$1}gs;
        s{<center>\s*(<milestone.*?<lb/>)</center>}{$1}gs;
        s{</?big>}{}g;
        s{<l\b[^>]*>(<p\b[^>]*>(?:.*?)</p>)(?:</l>)?(?:<lb/>)?}{$1}g;

        s{(<l\b[^>]*>(?:.*))(?!</l><lb/>)$}{$1</l><lb/>}gm;
        s{(</l><lb/>)</l><lb/>}{$1}g;

        # due to figures in cells
        s{(<cell>)\s*<lb/>}{$1}g;
        s{<lb/>\s*(</cell>)}{$1}g;

        s{<br\s*/>}{<lb/>}g;
        s{</p>}{</p><lb/>}g;

        # empty lines
        s{\R\s*\R}{\n}g;
    }
    return $s;
}

sub _cell {
    my ( $attr, $content ) = @_;

    my @new_attr;
    if ( $attr =~ /rowspan="(\d+)"/ ) {
        push @new_attr, "rows=\"$1\"";
    }
    if ( $attr =~ /colspan="(\d+)"/ ) {
        push @new_attr, "cols=\"$1\"";
    }
    if ( $attr =~ /align="right"/ ) {
        push @new_attr, 'rendition="#right"';
    }
    if ( $attr =~ /align="center"/ ) {
        push @new_attr, 'rendition="#c"';
    }

    my $ret = '<cell';
    $ret .= ' ' . join( ' ', @new_attr ) if scalar @new_attr;
    $ret .= '>' . $content . '</cell>';
    return $ret;
}

sub _frac {
    my ( $num, $denom ) = @_;
    my %unicode = (
        12 => "\x{00BD}",
        13 => "\x{2153}",
        23 => "\x{2154}",
        14 => "\x{00BC}",
        34 => "\x{00BE}",
        15 => "\x{2155}",
        25 => "\x{2156}",
        35 => "\x{2157}",
        45 => "\x{2158}",
        16 => "\x{2159}",
        56 => "\x{215A}",
        17 => "\x{2150}",
        18 => "\x{215B}",
        38 => "\x{215C}",
        58 => "\x{215D}",
        78 => "\x{215E}",
        19 => "\x{2151}",
        110 => "\x{2152}",
    );

    my $cat = $num . $denom;

    return $unicode{ $cat } if exists $unicode{ $cat };
    return sprintf '<formula notation="TeX">\frac{%s}{%s}</formula>', $num, $denom;
}

=head1 INTERNAL FUNCTIONS

=head2 _imgsrc

=cut

sub _imgsrc {
    my $str = shift || '';
    for ( $str ) {
        s[\{\{GBS\|([^}|]+)(?:\|US)?\}\}][<a href="http://books.google.com/books?id=$1">Google Books</a>]g;
        s[\{\{IA\|([^}]+)\}\}][<a href="http://www.archive.org/details/$1">Internet Archive</a>]g;
        s{\[\[:?commons:([^]]+)\|([^]]+)\]\]}{<a href="http://commons.wikimedia.org/wiki/$1">$2</a>}g;
        s{\[([^[]\S+)\s*([^]]+)]}{<a href="$1">$2</a>}g;
    }
    my @list;
    push @list, $1 while $str =~ /(<a href.*?<\/a>)/sg;
    return @list;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;
