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

use utf8;

BEGIN {extends 'Catalyst::Controller'; }

use HTML::TagCloud;

=head1 NAME

DTA::Controller::Book::Stat - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=head2 auto

=cut

sub auto :Local {
    my ( $self, $c ) = @_;
    return 1;
}

=head2 lemmata

=cut

sub lemmata :Local {
    my ( $self, $c, $id ) = @_;
    $c->forward( 'list', ['lemmata', $id] );
}

=head2 types

=cut

sub types :Local {
    my ( $self, $c, $id, $sort ) = @_;
    $c->forward( 'list', ['types', $id] );
}

=head2 list

=cut

sub list :Private {
    my ( $self, $c, $what, $id ) = @_;
    my $book = $c->forward( '/book/validbook', [$id] );

    my $file;
    foreach my $subcorpus ( qw(dtae dtak) ) {
        $file = sprintf '%s/corpus-csv.d/%s.TEI-P5.csv.1g', $c->config->{"dstar_".$subcorpus."_extra"}, $book->dirname;
        last if -e $file;
    }

    open( my $fh, '<:utf8', $file ) or die $!;

    my %list;
    while( my $line = <$fh> ) {
        chomp($line);
        my ( $freq, $orig, $rw, $cab, $pos, $lemma ) = split /\t/, $line;
        next if $pos =~ /^\$/;
        next if $orig eq '[Formel]';
        if ( $c->req->params->{nn_only} ) {
            #next unless $lemma =~ /^[[:upper:]]/;
            next unless $pos eq 'NN';
        }
        if ( $what eq 'lemmata' ) {
            $list{$lemma} += $freq;
        }
        else { # types
            $list{$rw} += $freq;
        }
    }
    $c->stash->{list} = \%list;

    $c->stash->{what} = $what;
    $c->forward( 'cloud', [$what] );
}

=head2 cloud

=cut

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

    my %list = %{$c->stash->{list}};

    my $cloud = HTML::TagCloud->new;

    my $search_pat = $what eq 'lemmata' ? '%24l%3D' : '%40';

    while( my ($k, $v) = each %list ) {
        next unless $v > 2;
        my $url = sprintf 'http://www.deutschestextarchiv.de/search/ddc/search?q=%s%s+%%23has_field%%5Bbasename%%2C%%27%s%%27%%5D',
                  $search_pat, ddc_escape($k), $c->stash->{book}->dirname;
        $cloud->add(translit($k), $url, $v);
    }

    $c->stash(
        template => 'web/book/stat/cloud.tt',
        cloud    => $cloud->html_and_css(500),
    );
}

sub translit {
    my $str = shift || '';
    for ( $str ) {
        s/\x{a75b}/r/g
    }
    return $str;
}

sub ddc_escape {
    my $str = shift || '';
    for ( $str ) {
        s/\\/\\\\/g;
        s/'/\\'/g;
        s/&/\\%26/g;
    }
    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
