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

BEGIN {extends 'Catalyst::Controller'; }

use utf8;
use File::Basename qw( basename );
use List::Util qw( first );
use HTML::Parser;
use YAML qw(LoadFile);

=head1 NAME

DTA::Controller::Web::Doku - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

Achtung: die URL /doku/basisformat wird vom Apache 'abgezweigt'

=head1 METHODS

=head2 auto

=cut

sub auto :Private {
    my ( $self, $c ) = @_;
    if ( $c->req->uri !~ /clarin_kupro/ ) {
        $c->stash->{ content_class } = 'help-content';
    }
    return 1;
}

my @topics = (
    [ 'test'   => 'Test', 1 ],
    [ 'metadaten' => 'DTA – Metadaten', 1 ],

    [ 'index'  => 'DTA – Hilfe und Dokumentation' ],
    [ einstieg => 'Einstieg' ],
    [ ueberblick => 'Projektüberblick' ],

    [ nutzungsbedingungen => 'Nutzungsbedingungen' ],
    [ impressum           => 'Impressum' ],

    [ referenzkorpus => 'DTA – Das größte historische Referenzkorpus in deutscher Sprache' ],
    [ leitlinien     => 'DTA-Leitlinien' ],
    [ textauswahl    => 'Die DTA-Textauswahl' ],

    [ team           => 'Das DTA-Team' ],
    [ kooperationen  => 'Kooperationen' ],
    [ publikationen  => 'Publikationen' ],
    [ patenschaft    => 'DTA-Patenschaft' ],
    [ workflow       => 'Der Digitalisierungsworkflow im DTA' ],
    [ software       => 'Software im Deutschen Textarchiv' ],

    [ richtlinien => 'DTA-Richtlinien zur Texterfassung' ],

    [ basisformat                              => 'DTA-Basisformat – DTABf' ],
    [ basisformat_einleitung                   => 'DTA-Basisformat – Einführung und erste Schritte' ],
    [ basisformat_anleitung                    => 'DTA-Basisformat – Anleitung zur Benutzung' ],
    [ basisformat_konventionen                 => 'DTA-Basisformat – Konventionen' ],
    [ basisformat_dokumentstruktur             => 'DTA-Basisformat – Grundstruktur jedes TEI-Dokuments' ],
    [ basisformat_en                           => 'DTA ›base format‹ (DTABf)' ],
    [ basisformat_header                       => 'DTA-Basisformat – Header' ],
    [ basisformat_texterschliessung_formal     => 'DTA-Basisformat – Formale Erschließung des Volltextes' ],
    [ basisformat_texterschliessung_inhaltlich => 'DTA-Basisformat – Inhaltliche Erschließung des Volltextes' ],

    [ basisformat_zeitungen                    => 'DTA-Basisformat – Auszeichnung von Zeitungen' ],
    [ basisformat_manuskripte                  => 'DTA-Basisformat – Auszeichnung von Manuskripten' ],
    [ formulae                                 => 'Formeltranskriptionen' ],
    [ cmdi                                     => 'CMDI' ],

    [ dtaq           => 'DTAQ' ],
    [ korrekturfibel => 'Korrekturfibel' ],

    [ 'suche-hilfe'  => 'Hilfe für die Suche in der DTA-Dokumentation' ],

    [ dtae                 => 'DTAE' ],
    [ 'dtae-workflow'      => 'DTAE – Workflow' ],
    [ 'dtae-transcription' => 'DTAE – Transkription und Annotation mit oXygen oder Word' ],
    [ 'dtae-metadaten'     => 'DTAE – Metadaten' ],
    [ 'dtae-upload'        => 'DTAE – Upload' ],

    [ 'textquellen'        => 'Textquellen' ],

    [ 'veranstaltungen'    => 'Veranstaltungen' ],
    [ 'workshop2013'       => 'Workshop 2013' ],
    [ 'dtaworkshop2013'    => 'Workshop April 2013' ],
    [ 'dtaworkshop3'       => 'Workshop Oktober 2013' ],
    [ 'dtaworkshop4'       => 'Workshop Juli 2014' ],
    [ 'DTAClarinDConf2014' => '2. DTA-/CLARIN-D-Konferenz und CLARIN-D-Workshop November 2014' ],

    [ 'pos' => 'Part of Speech – Legende' ],

    [ 'DDC-suche_hilfe' => 'DDC – Suchhilfe', 1 ],

    [ 'clarin_kupro_index'           => 'CLARIN-D Kurationsprojekt', 1 ],
    [ 'clarin_kupro_texte'           => 'CLARIN-D Kurationsprojekt Texte', 1 ],
    [ 'clarin_kupro_dokumentation'   => 'CLARIN-D Kurationsprojekt Dokumentation', 1 ],
    [ 'clarin_kupro_publikationen'   => 'CLARIN-D Kurationsprojekt Publikationen', 1 ],
    [ 'clarin_kupro_projektgruppe'   => 'CLARIN-D Kurationsprojekt Projektgruppe', 1 ],
    [ 'clarin_kupro_texte_editionen' => 'CLARIN-D Kurationsprojekt Texte Editionen', 1 ],

    [ 'test' => 'test', 1 ],

);

=head2 OLD LINKS

Achtung: die URL /doku/basisformat wird vom Apache 'abgezweigt'

=cut

sub basisformat :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( '//www.deutschestextarchiv.de/doku/basisformat', 301 );
}

sub basisformat_text :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/basisformat'), 301 );
}

sub richtlinien_neu :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/richtlinien'), 301 );
}

sub basisformat_einfuehrung :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/basisformat'), 301 );
}

sub basisformat_anleitung :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/basisformat_einleitung#anleitungBenutzung'), 301 );
}

sub basisformat_dokumentstruktur :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/basisformat_einleitung#grundstrukturDocs'), 301 );
}

sub basisformat_konventionen :Local {
    my ( $self, $c ) = @_;
    $c->res->redirect( $c->uri_for('/doku/basisformat_einleitung#erlaeuterungenDoku'), 301 );
}

=head2 index

=cut

sub index :Path :Args(0) {
    my ( $self, $c ) = @_;
    $c->stash(
        topic      => 'DTA – Hilfe und Dokumentation',
        template   => "help/dtadoc/index.html",
        docfoot    => 1,
        page_title => 'Hilfe',
        mtime      => scalar localtime( (stat sprintf( "%s/index.html", $c->config->{helprep} ))[9] ),
    );
}

=head2 CLARIN-D Kurationsprojekt

=cut

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

    my @exclude = qw(
        sanders_sprachschatz01_1873
        gruithuisen_mondbewohner_1824
        ludwig_haasen_1794
        humboldt_soemmering01_1791
        humboldt_soemmering02_1795
        gehler_woerterbuch01_1798
        gehler_woerterbuch02_1798
        gehler_woerterbuch03_1798
        gehler_woerterbuch04_1798
        gehler_woerterbuch05_1799
        gehler_woerterbuch06_1801
        goethe_reineke_1794Kern
        nn_dracole_1488
        nn_dracole_1485
        parthey_goethe_1819
        sandrart_iconologia_1680
        schauberg_freimaurerei03_1863
        scriver_schaefflein_1672
        silesius_wandersmann_1675
    );

    my @zeno = qw(
        aston_emancipation_1846
        fouque_falkensteins01_1810
        fouque_falkensteins02_1810
    );
    @zeno = ( @zeno, map { $_ = basename $_; s/\..*$//; $_ } glob '/home/wiegand/dta-xml/zeno/*.xml' );

    my @misc = qw(
        aston_leben_1847
        bach_bwv214_1733
        bacmeister_predigt_1614
        boettiger_predigt_1652
        bucer_dialogus_1521
        caselius_leichpredigt_1649
        crescentiis_figuren_1493
        d_untreue_1763
        erbkam_tagebuch01_1842
        erbkam_tagebuch02_1843
        erbkam_tagebuch03_1844
        geier_schuetz_1672
        gutzkow_patkul_1842
        hausen_predigt_1710
        lange_predigt_1643
        lewald_adele_1864
        mesmer_magnetismus_1781
        mohr_stillenacht_1816
        nn_abriss_1702
        nn_charaktere01_1848
        nn_charaktere02_1848
        nn_kobald_1691
        nn_konzert_1890
        nn_marcipan_1632
        nn_medaille_1779
        nn_nachtmord_1693
        nn_raupen_1799
        nn_reisepass_1750
        nn_spz_1813
        nn_wundermensch_1689
        nzz_hexe_1782
        parthey_jugenderinnerungen01_1871
        parthey_jugenderinnerungen02_1871
        pfeiffer_frauenfahrt01_1850
        pfeiffer_frauenfahrt02_1850
        pfeiffer_frauenfahrt03_1850
        sandrart_academie0101_1675
        sandrart_academie0102_1675
        sandrart_academie0103_1675
        sandrart_academie0201_1679
        sandrart_academie0202_1679
        sandrart_academie0203_1679
        schauberg_freimaurerei01_1861
        schauberg_freimaurerei02_1861
        schele_predigt_1670
        schiller_erziehung01_1795
        schiller_erziehung02_1795
        schiller_erziehung03_1795
        schnyerer_wunder_1619
        simmel_soziologie_1908
        widmayer_abc_1892
        zeller_chronik01_1700
    );

    my @echo = map { $_ = basename $_; s/\..*$//; $_ } glob '/home/wiegand/dta-xml/dtae/maxplanck/*.xml';

    my %other = map { $_ => 1 } @zeno, @misc;
    my %exclude = map { $_ => 1 } @exclude;
    my @tg    = grep { !exists $other{$_} and !exists $exclude{$_} } map { $_ = basename $_; s/\..*$//; $_ } glob '/home/wiegand/dta-xml/dtae/misc/*.xml';
    push @tg, 'lindnerin_kochbuch_1780';
    ## -----------

    my %groups = (
        gutenbergorg => {
            name => 'Gutenberg.org',
            cond => { source => 'gutenberg_org' },
        },
        gutenbergde => {
            name => 'Gutenberg-DE',
            cond => { source => 'gutenberg_de' },
        },
        sbb_funeralschriften => {
            name => 'SBB Funeralschriften',
            cond => { source => 'sbb_funeralschriften' },
        },
        echo => {
            name => 'ECHO - MPIWG',
            cond => { 'me.dirname' => { -in => \@echo } },
        },
        wikisource => {
            name => 'Wikisource',
            cond => { source => 'wikisource' },
        },
        wdb => {
            name => 'Wolfenbütteler Digitale Bibliothek',
            cond => { source => 'hab' },
        },
        zeno => {
            name => 'zeno.org / Textgrid',
            cond => { 'me.dirname' => { -in => \@zeno } },
        },
        tg => {
            name => 'Thematische Sammlungen',
            cond => { 'me.dirname' => { -in => \@tg } },
        },
        gwb => {
            name => 'Goethe-Wörterbuch',
            cond => { source => 'gwb' },
        },
        briefjeanpaul => {
            name => 'Briefedition Jean Paul',
            cond => { source => 'briefjeanpaul' },
        },
        misc => {
            name => 'Sonstige',
            cond => { 'me.dirname' => { -in => \@misc } },
        },
    );

    my %stat;
    foreach my $g ( keys %groups ) {
        my $name = $groups{$g}{name};
        my $rs = $c->model('DTADB::Book')->search(
            $groups{$g}->{cond},
            {
                join     => [ 'source' ],
                cache    => 1,
            },
        );
        while( my $row = $rs->next ) {
            my $dirname = $row->dirname;
            my ( $tokens, $characters, $pages );
            my $fh;
            eval {
                open( $fh, '<', sprintf('/home/wiegand/dta-fullxml-without-c/%s.TEI-P5.xml', $dirname) ) or die $!;
                1;
            };
            next if $@;
            while( my $line = <$fh> ) {
                if ( $line =~ /<measure type="tokens">(\d+)/ ) {
                    $tokens = $1;
                }
                if ( $line =~ /<measure type="characters">(\d+)/ ) {
                    $characters = $1;
                }
                if ( $line =~ /<measure type="images">(\d+)/ ) {
                    $pages = $1;
                }
                if ( $tokens && $characters && $pages ) {
                    $stat{$name}{tokens}     += $tokens;
                    $stat{$name}{characters} += $characters;
                    $stat{$name}{pages}      += $pages;
                    $c->stash->{clarin_kupro_total}{tokens}     += $tokens;
                    $c->stash->{clarin_kupro_total}{characters} += $characters;
                    $c->stash->{clarin_kupro_total}{pages}      += $pages;
                    close $fh;
                    last;
                }
            }
            $stat{$name}{works}++;
            $c->stash->{clarin_kupro_total}{works}++;
        }
    }
    $c->stash->{clarin_kupro_stat}   = \%stat;
    $c->stash->{clarin_kupro_groups} = \%groups;
}

=head2 clarin_kupro_liste

=cut

sub clarin_kupro_liste :Local {
    my ( $self, $c ) = @_;

    $c->forward( 'clarin_kupro_prepare' );
    my %groups = %{ $c->stash->{clarin_kupro_groups} };

    my $rs;
    my $g = $c->req->params->{g};

    if ( exists $groups{$g} ) {
        $rs = $c->model('DTADB::Book')->search(
            $groups{$g}->{cond},
            {
                prefetch => [ 'source', 'textpages' ],
                order_by => 'autor1_lastname, title, band_zaehlung, year',
                cache    => 1,
            },
        );
    }
    elsif ( $g =~ /^(1[5-9])$/ ) {
        my $year = $1 - 1;
        my @condition = map { $groups{$_}->{cond} } keys %groups;
        $rs = $c->model('DTADB::Book')->search(
            {
                -or => [ @condition ],
                'me.dta_pub_date' => { -like => "$year%" },
            },
            {
                prefetch => [ 'source', 'textpages' ],
                order_by => 'autor1_lastname, title, band_zaehlung, year',
                cache    => 1,
            },
        );
    }
    elsif ( $g =~ /^(Gebrauchsliteratur|Belletristik|Wissenschaft)$/i ) {
        my $genre = $1;
        my @condition = map { $groups{$_}->{cond} } keys %groups;
        $rs = $c->model('DTADB::Book')->search(
            {
                -or => [ @condition ],
                'me.dwds_kategorie1' => ucfirst($genre),
            },
            {
                prefetch => [ 'source', 'textpages' ],
                order_by => 'autor1_lastname, title, band_zaehlung, year',
                cache    => 1,
            },
        );
    }
    else {
        my @condition = map { $groups{$_}->{cond} } keys %groups;
        $rs = $c->model('DTADB::Book')->search(
            {
                -or => [ @condition ],
            },
            {
                prefetch => [ 'source', 'textpages' ],
                order_by => 'autor1_lastname, title, band_zaehlung, year',
                cache    => 1,
            },
        );
    }

    $c->stash(
        topic      => 'clarin_kupro_liste',
        template   => "help/dtadoc/clarin_kupro_liste.html",
        docfoot    => 1,
        page_title => 'CLARIN-D Kurationsprojekt Texte',
        mtime      => scalar localtime( (stat '/home/wiegand/mysource/git/DTAQ/root/help/dtadoc/clarin_kupro_liste.html')[9] ),
        g          => $g,
        list       => [ $rs->all ],
    );
}

=head2 clip

=cut

sub clip : Local {
    my ( $self, $c, $id ) = @_;
    use Data::Dumper; warn Dumper $id;
    my $clip = $c->model('DTADB::Clip')->find( $id );
    $c->detach( '/default' ) unless $clip;

    my $bibl = $c->model('DTADB::Book')->search(
        {
            'me.dirname' => $clip->dirname,
        },
        {
        }
    )->first;

    $c->stash(
        clip     => $clip,
        bibl     => $bibl->dta_bibl_angabe,
        hl_xml   => \&DTA::Controller::DTA::DocTool::hl_xml,
        template => 'help/clip.tt',
        view     => 'Plain',
    );
}

=head2 imgprev

=cut

=for pod

    fw: Deprecated as of 2020-08-25

sub imgprev :Local {
    my ( $self, $c, $name ) = @_;
    $c->forward( '/dtaq/doctool/imgprev', [ $name ] );
}

=cut

=head2 klassifikation

=cut

sub klassifikation2 :Local {
    my ( $self, $c ) = @_;

    open( my $fh, '<:utf8', '/home/wiegand/src/dtadoc/categories_ext.yml' )
        or die $!;
    my $text;
    {
        local $/;
        $text = <$fh>;
    }
    close $fh;

    my ( $forms, $issues, $sils, $removes ) = YAML::Load( $text );

    while( my ($k, $v) = each %$issues ) {
        $forms->{$k} = $v;
    }
    while( my ($k, $v) = each %$sils ) {
        $forms->{$k} = $v;
    }

    while( my ($k, $v) = each %$forms ) {
        next unless $v->{unterbegriffe};
        next unless ref $v->{unterbegriffe} eq 'HASH';
        while( my ($ku, $vu) = each %{$v->{unterbegriffe}} ) {
            $forms->{$ku} = $vu;
            $vu->{oberbegriff} = $k;
        }
    }

    $c->stash(
        forms    => $forms,
        issues   => $issues,
        sils     => $sils,
        removes  => $removes,
        content_class => 'web',
        template => 'help/klassifikation2.tt',
    );
}

=head2 basisformat_changes

=cut

sub basisformat_changes :Local {
    my ( $self, $c ) = @_;

    $c->stash->{xml} = "/home/wiegand/src/dtadoc/basisformat_aenderungen.xml";
    $c->stash->{template} = 'dtabf-changes.xsl';
    $c->forward('DTA::View::XSLT');
    my $html = $c->res->body;
    utf8::decode($html);
    $c->res->body(undef);

    $c->stash(
        template => 'help/bf_changes.tt',
        change_html => $html,
    );
}

=head2 basisformat_table

=cut

sub basisformat_table :Local {
    my ( $self, $c ) = @_;
    $c->stash(
        yaml  => 'basisformat-tabelle.yml',
        title => 'Overview (elements within <text>)',
    );
    $c->detach( 'table_text' );
}

=head2 basisformat_table_special

=cut

sub basisformat_table_special :Local {
    my ( $self, $c ) = @_;
    $c->stash(
        yaml  => 'basisformat-tabelle-special.yml',
        title => 'DTABf for special kinds of text',
    );
    $c->detach( 'table_text' );
}

=head2 basisformat_table_header

=cut

sub basisformat_table_header :Local {
    my ( $self, $c ) = @_;
    $c->stash(
        yaml  => 'basisformat-header-tabelle.yml',
        title => 'Overview (elements within <teiHeader>)',
    );
    $c->detach( 'table_text' );
}

=head2 table_text

=cut

sub table_text :Private {
    my ( $self, $c ) = @_;
    my ( $elements, $universal, $levels, $categories, $preface ) = LoadFile( sprintf "%s/%s", '/home/wiegand/src/dtadoc', $c->stash->{yaml} );

    my %valid_lang = map { $_ => 1 } qw(de en);
    my $lang = $c->req->params->{lang} || 'de';
    $lang = 'de' if !exists $valid_lang{ $lang };

    my $enc = sub {
        my ( $str, $html ) = @_;
        utf8::decode( $str );
        unless ( $html ) {
            for ( $str ) {
                s/&/&amp;/g;
                s/</&lt;/g;
                s/>/&gt;/g;
                s{&lt;(\w+)&gt;}{<a href='http://www.tei-c.org/release/doc/tei-p5-doc/en/html/ref-$1.html'><code>$1</code></a>}g;
            }
        }
        return $str;
    };

    $c->stash(
        template   => 'help/table-text.tt',
        content_class => 'web',
        lang       => $lang,
        trans      => \&trans,
        elements   => $elements,
        universal  => $universal,
        levels     => $levels,
        categories => $categories,
        preface    => $preface,
        enc        => \&$enc,
        mtime      => scalar localtime( (stat sprintf( "%s/%s", '/home/wiegand/src/dtadoc', $c->stash->{yaml} ))[9] ),
        trans      => sub {
            my $str = shift;
            my %lexicon = (
                'DTA ‘base format’' => 'DTA-Basisformat',
                'Language' => 'Sprache',
                'document date' => 'Stand',
                'Reset filter' => 'Filter aufheben',
                'Overview (elements within <text>)' => 'Überblick (Elemente innerhalb von <text>)',
                'Overview (elements within <teiHeader>)' => 'Überblick (Elemente innerhalb von <teiHeader>)',
                'Element' => 'Element',
                'Description' => 'Beschreibung',
                'Attributes/Notes' => 'Attribute/Anmerkungen',
                'Functional Category' => 'Funktionale Kategorie',
                'Level' => 'Level',
                'Restriction levels' => 'Tagging-Level',
                'Functional categories' => 'Funktionale Kategorien',
                'Generic attributes' => 'Generische Attribute',
                'search' => 'Suche',
                'show elements within this category' => 'alle Elemente dieser Kategorie anzeigen',
                'show elements within this level' => 'alle Elemente dieses Levels anzeigen',
            );
            return $lang eq 'en' ? $enc->($str) : $enc->($lexicon{$str});
        },
    );
}

=head2 klassifikation

=cut

sub klassifikation :Local {
    my ( $self, $c ) = @_;

    my $genres = $c->model('DTADB::Book')->search(
        {
            'me.ready' => { -in => [ 1, 2, 3 ] },
            'me.genre' => { '!=' => 'Richtlinie' },
        },
        {
            select => [ qw(me.genre me.untergenre) ],
            as     => [ qw(genre untergenre) ],
            group_by => [ qw(me.genre me.untergenre) ],
        }
    );

    my %genres;
    while ( my $genre = $genres->next ) {
        push @{$genres{$genre->get_column('genre')}}, $genre->get_column('untergenre');
    }

    my $dwds1 = $c->model('DTADB::Book')->search(
        {
            'me.ready' => { -in => [ 1, 2, 3 ] },
        },
        {
            select => [ qw(me.dwds_kategorie1 me.dwds_unterkategorie1) ],
            as     => [ qw(genre untergenre) ],
            group_by => [ qw(me.dwds_kategorie1 me.dwds_unterkategorie1) ],
        }
    );

    my %dwds1;
    while ( my $genre = $dwds1->next ) {
        push @{$dwds1{$genre->get_column('genre')}}, $genre->get_column('untergenre');
    }

    my $dwds2 = $c->model('DTADB::Book')->search(
        {
            'me.ready' => { -in => [ 1, 2, 3 ] },
        },
        {
            select => [ qw(me.dwds_kategorie2 me.dwds_unterkategorie2) ],
            as     => [ qw(genre untergenre) ],
            group_by => [ qw(me.dwds_kategorie2 me.dwds_unterkategorie2) ],
        }
    );

    my %dwds2;
    while ( my $genre = $dwds2->next ) {
        push @{$dwds2{$genre->get_column('genre')}}, $genre->get_column('untergenre');
    }

    $c->stash(
        genres   => \%genres,
        dwds1    => \%dwds1,
        dwds2    => \%dwds2,
        template => 'help/klassifikation.tt',
    );
}

=head2 doc

=cut

sub doc : LocalRegex('^([\w.-_]+)$') {
    my ( $self, $c, $topic ) = @_;
    $topic ||= $c->req->captures->[0];

    $topic = 'basisformat' if ( $topic =~ /clarin(?!_kupro)/i and $topic !~ /DTAClarinDConf2014/ );

    if ( $topic eq 'dtae' ) {
        $c->res->redirect( $c->uri_for('/dtae') );
    }
    elsif ( $topic eq 'basisformat_odd.xml' ) {
        my $file = '/home/wiegand/src/dtadoc/DTA_Schema/tei_dta_odd_phase2.xml';
        open( my $fh, '<', $file ) or die $!;
        my $xml;
        {
            local $/;
            $xml = <$fh>;
        }
        close $fh;

        $c->res->content_type( 'application/xml' );
        $c->res->body( $xml );
        $c->detach;
    }
    elsif ( $topic eq 'basisformat_rng.xml' ) {
        my $file = '/home/wiegand/src/dtadoc/DTA_Schema/tei_dta_schema_phase2.rng';
        open( my $fh, '<', $file ) or die $!;
        my $xml;
        {
            local $/;
            $xml = <$fh>;
        }
        close $fh;

        $c->res->content_type( 'application/xml' );
        $c->res->body( $xml );
        $c->detach;
    }
    elsif ( $topic eq 'tei-mm-2011_poster.pdf' ) {
        $c->res->redirect( 'http://kaskade.dwds.de/~wiegand/poster.pdf' );
        $c->detach;
    }
    elsif ( $topic =~ /clarin_kupro/ ) {
        $c->forward( 'clarin_kupro_prepare' );
    }

    my $list_entry = first { $_->[0] eq $topic } @topics;
    $c->detach( '/default' ) unless $list_entry;

    $c->stash(
        topic      => $list_entry->[1],
        template   => "help/dtadoc/$topic.html",
        docfoot    => 1,
        page_title => $list_entry->[1],
        page_name  => $topic,
        mtime      => scalar localtime( (stat sprintf( "%s/%s.html", $c->config->{helprep}, $topic ))[9] ),
    );

    if ( $topic eq 'textauswahl' ) {
        # SELECT m.dwds_kategorie1, count(*) AS c
        #   FROM book b, metadaten m
        #  WHERE b.id_book = m.id_book
        #    AND (b.ready = 1 OR b.ready = 2)
        #    AND m.dwds_kategorie1 != ''
        #    AND m.dwds_kategorie1 IS NOT NULL
        # GROUP BY dwds_kategorie1
        my $cats = $c->model('DTADB::Book')->search(
            {
                -and => [
                    'me.dwds_kategorie1' => { '!=' => '' },
                    'me.dwds_kategorie1' => { '!=' => undef },
                    'me.ready' => [ 1, 2 ],
                ]
            },
            {
                select   => [ 'me.dwds_kategorie1', { count => 'dwds_kategorie1' } ],
                as       => [ 'dwds_kategorie1', 'count' ],
                group_by => 'me.dwds_kategorie1',
                order_by => 'me.dwds_kategorie1',
            },
        );

        # SELECT m.dwds_kategorie1, sum(p.chars)
        #   FROM book b, metadaten m, page p
        #  WHERE b.id_book = m.id_book
        #    AND p.book = b.id_book
        #    AND (b.ready = 1 OR b.ready = 2)
        #    AND m.dwds_kategorie1 != ''
        #    AND m.dwds_kategorie1 IS NOT NULL
        # GROUP BY dwds_kategorie1;
        my $cats_chars = $c->model('DTADB::Book')->search(
            {
                -and => [
                    'me.dwds_kategorie1' => { '!=' => '' },
                    'me.dwds_kategorie1' => { '!=' => undef },
                    'me.ready' => [ 1, 2 ],
                ]
            },
            {
                select   => [ 'me.dwds_kategorie1', { sum => 'textpages.chars' } ],
                as       => [ 'dwds_kategorie1', 'sum' ],
                join     => [ 'textpages' ],
                group_by => 'me.dwds_kategorie1',
            },
        );

        # SELECT m.dwds_unterkategorie1, count(*) c
        #   FROM book b, metadaten m
        #  WHERE b.id_book = m.id_book
        #    AND (b.ready = 1 OR b.ready = 2)
        #    AND m.dwds_kategorie1 = 'Wissenschaft'
        #  GROUP BY dwds_unterkategorie1
        #  ORDER BY c;
        my @sub_cats;
        foreach my $cat ( qw(Wissenschaft Belletristik Gebrauchsliteratur) ) {
            my $res = $c->model('DTADB::Book')->search(
                {
                    'me.dwds_kategorie1' => $cat,
                    'me.ready' => [ 1, 2 ],
                },
                {
                    select   => [ 'me.dwds_unterkategorie1', { count => 'dwds_unterkategorie1' } ],
                    as       => [ 'dwds_unterkategorie1', 'count' ],
                    group_by => 'me.dwds_unterkategorie1',
                },
            );
            push @sub_cats, [ $cat, [$res->all] ];
        }

        my $rv = $c->model('DTADB::Book')->search(
            {
                'me.ready' => [ 1, 2 ],
            },
            {
            }
        );
        my ( %fonts, %genres );
        while( my $row = $rv->next ) {
            my $schriftart = $row->schriftart;
            $schriftart = 'Antiqua' if $schriftart =~ /Antiqua/;
            $schriftart = 'Fraktur' if $schriftart =~ /Fraktur/;
            $fonts{ $schriftart }{ int($row->year/10) }++;
            $genres{ $row->dwds_kategorie1 || 'Sonstiges' }{ int($row->year/10) }++;
        }

        $c->stash(
            cats     => [ $cats->all ],
            cats_chars => [ $cats_chars->all ],
            sub_cats => \@sub_cats,
            fonts    => \%fonts,
            genres   => \%genres,
        );
    }
}

###############################################

my $out;
my $last_depth;
my $ul_to_close;
my $act_topic;
my $has_id;
my %id_seen = ();

=head2 docmap

=cut

sub docmap : Local {
    my ( $self, $c ) = @_;
    my $map = '';

    foreach my $topic ( @topics ) {
        next if $topic->[2];
        $act_topic = $topic->[0];
        $out = '';
        $last_depth = 0;
        $ul_to_close = 0;
        %id_seen = ();
        my $p = HTML::Parser->new(
            api_version => 3,
            start_h     => [ \&start_h, "self,tagname,attr" ],
            report_tags => [ qw(h2 h3 h4 h5 h6) ],
        );
        $p->utf8_mode( 1 );
        $p->parse_file( $c->config->{helprep} . "/" . $topic->[0] . ".html" )
            or die sprintf "%s/%s.html: %s", $c->config->{helprep}, $topic->[0], $!;
        for my $i ( 1 .. $ul_to_close ) {
            $out .= "</li>\n" . ' 'x($last_depth*2+1) . "</ul>";
            $last_depth--;
        }
        utf8::decode( $out );
        push @{ $c->stash->{topics} }, {
            topic => $topic,
            'map' => $out,
        };
    }

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

sub start_h {
    my ( $self, $tag, $attr ) = @_;
    my ( $depth ) = $tag =~ /h(\d+)/;
    if ( $depth > $last_depth ) {
        $out .= "\n" . ' 'x($depth*2-1) . "<ul>\n";
        $ul_to_close++;
    }
    else {
        $out .= "</li>\n";
        if ( $depth < $last_depth ) {
            for my $i ( $depth .. $last_depth-1 ) {
                $out .= ' 'x(($last_depth-$i+1)*2+1) . "</ul>\n";
                $out .= ' 'x(($last_depth-$i+1)*2) . "</li>\n";
                $ul_to_close--;
            }
        }
    }
    $out .= ' ' x ($depth*2) . "<li>";
    $last_depth = $depth;
    $self->handler(text => [], '@{dtext}' );
    $self->handler(start => \&text);
    if ( $attr->{id} ) {
        $has_id = $attr->{id};
    }
    $self->handler(end => \&end_h, "self,tagname,text");
}

sub text_h {
    my ( $self, $tag ) = @_;
    my $text = @{ $self->handler("text") };
}

sub end_h {
    my ( $self, $tag ) = @_;
    my ( $depth ) = $tag =~ /h(\d+)/;
    my $text = join( "", @{$self->handler("text")} );
    $out .= sprintf '<a href="doku/%s#%s">%s</a>', $act_topic, generate_id($text), $text;
    $self->handler("text", undef);
    $self->handler("start", \&start_h);
    $self->handler("end", undef);
}

sub generate_id {
    my $str = shift;
    if ( $has_id ) {
        my $ret = $has_id;
        $has_id = undef;
        return $ret;
    }
    utf8::decode($str);
    $str =~ s/.*\x{a0}\x{a0}\s*//;
    $str = lc $str;
    $str =~ tr/ /_/;
    $str =~ s/[^a-zA-Z0-9_.:-]//g;

    my $n = 0;
    {
        if ( exists $id_seen{ $str } ) {
            $str = "$str$n";
        }
        if ( exists $id_seen{ $str } ) {
            $str++;
            redo;
        }
    }
    $id_seen{ $str }++;
    return $str;
}

__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
