#!/usr/bin/perl
use utf8;
use POSIX qw(locale_h);

use warnings;
# use strict;

use OpenDict;
use OpenDict::WebUtils;
use OpenDict::Users;
use XML::DT;
use DBI;
use CGI qw/:standard !dt/;
use CGI::Session;
use CGI::Cookie;
use Template;
use Encode;

setlocale(LC_CTYPE,   "pt_PT.utf8");
setlocale(LC_COLLATE, "pt_PT.utf8");
use locale;

# This prints the CGI header, search entry et al!
our $DA       = new OpenDict::WebUtils(login => 1, query => '/search', jslogin => 1);
our $ROOT     = $DA->{root};
our $pathinfo = $DA->{pathinfo};
our $username  = $DA->{session} ? $DA->{session}->param("username") : undef;


if ($pathinfo || param("word")) {
    $pathinfo ||= param("word");
    Encode::_utf8_on($pathinfo);
    if ($pathinfo eq "random") {
        my $xml = OpenDict->connect( db => "$ROOT/xml.db");
        $pathinfo = $xml->randomWord();
        $xml->close;
    }
    search($pathinfo);
} else {
    show_main_page();
}

$DA->footer;


## Options:
#
# 1. main page & menu
sub show_main_page {
    my $news = OpenDict::WebUtils::show_news($ROOT, 2);
    $DA->TT->process('login');
    $DA->TT->process('menu', { username => $username, news => $news } );
}
#
# 2. word was searched
sub search {
    my $word = shift;

    $word = lc(trim($word));

    OpenDict::WebUtils::log_query($ROOT, $word);

    my $xml = OpenDict->connect( db => "$ROOT/xml.db",
                                 attach => {
                                            users => "$ROOT/TMP/users.db"
                                           });
    my $row;
    my $found_word = 0;
    my $found_prefix = 0;

    print "<div id=\"main\"><div class=\"text\">\n";
    print h2({-class=>'hide'}, 'Resultados');

    # Search for exact word.
    my @xmls = $xml->xml_entries($word);
    if (@xmls) {
        print hr;
        for (@xmls) {
            $xml -> _format_xml($DA, $_, $username);
        }

        if (param("debug")) {
            print div({id=>'TEI'},
                      join("\n", map{
                          s/&/&amp;/g;
                          s/>/&gt;/g;
                          s/</&lt;/g;
                          "<pre>\n$_\n</pre>"
                      } @xmls));
        }
        $found_word = 1;
    }

    # Generate near misses and print them
    my $combinacoes = $xml->generateNearMisses($word);
    if (@$combinacoes) {
        print hr,
          div({-class=>'nearmisses'},
              strong("Ser&aacute; que queria dizer... "),
              join( "&nbsp;&nbsp;".strong("&raquo; "),
                    map {
                        a({-href=>"/search/$_"}, $_);
                    } @$combinacoes));
    }

    # Search for same prefix words
    my $dbs = $xml->dbh->prepare("SELECT word,n FROM entry WHERE word LIKE ? AND word != ? ORDER BY word COLLATE perllocale LIMIT 10");
    $dbs->execute("$word%",$word);
    while ($row = $dbs->fetchrow_hashref) {
        print hr, "<div id='same_prefix'>", h2("Palavras com o mesmo prefixo") unless $found_prefix;
        $found_prefix = 1;

        my $xmlentry = $xml->xml_entry($row->{word}, $row->{n});
        $xml -> _format_xml($DA, $xmlentry, $username);
    }
    print "</div>" if $found_prefix;

    print hr,
      div({class=>"clear"},""),
        div({class=>"notfound"}, strong("[$word] Nenhuma palavra encontrada!")) unless $found_word || $found_prefix;

    print "</div></div>";
}

sub json_search {
    my $pathinfo = shift;

    my $list = 0;
    $list = 1 if param("list");

    if ($pathinfo) {
        my $dbh = DBI->connect("dbi:SQLite:dbname=$ROOT/xml.db","","");
        $dbh->{unicode} = 1;
        if ($list) {
            my $x = param("list");
            my $sth = $dbh->prepare("SELECT DISTINCT word FROM entry WHERE word LIKE \"$pathinfo%\"");
            $sth->execute;
            my @row;
            my $i = 0;
            print header(-type => "application/json",
                         -charset => "utf-8");
            my @a = ();
            while ($i < 10 && (@row = $sth->fetchrow_array)) {
                $i++;
                push @a, "\"$row[0]\"";
            }
            print "[".join(",",@a)."]\n";
        }
        else {
            my $sth = $dbh->prepare("SELECT xml FROM entry WHERE word = ?");
            $sth->execute($pathinfo);
            my @row;
            my @xmls;
            while (@row = $sth->fetchrow_array) {
                push @xmls, $row[0]
            }
            my $xml;
            if (@xmls) {
                $xml = "<dic>\n";
                if ($#xmls) {
                    $xml.= "<superEntry>\n";
                    $xml.= join("\n", @xmls);
                    $xml.= "</superEntry>\n";
                }
                else {
                    $xml.= $xmls[0];
                }
                $xml.= "</dic>\n";
                
                my %xml2json = (
                                -type => { -default => 'SEQ' },
                                dic => sub { '['.join(",",@$c).']' }, 
                                -pcdata => sub {
                                    if ($c =~ /^\s*$/) {
                                        return ""
                                    }
                                    else {
                                        $c =~ s/^\s*//;
                                        $c =~ s/\s*$//;
                                        $c =~ s/\n/\\n/g;
                                        $c =~ s/"n/\\"/g;
                                        return "\"$c\""
                                    }
                                },
                                -default => sub {
                                    if (scalar(@$c) > 1) {
                                        $c = '[' . join(",\n",@$c) . ']'
                                    } else {
                                        $c = $c->[0]
                                    }
                                    my $v;
                                    if (%v) {
                                        $v = '{';
                                        for (keys %v) {
                                            $v .= "\"$_\": \"$v{$_}\",\n"
                                        }
                                        $v .= "\"content\": $c";
                                        $v .= '}';
                                    } else {
                                        $v = $c;
                                    }
                                    return "{ \"$q\": $v }"
                                }
                               );

                print header(-type => "application/json", -charset=>"utf-8");
                print dtstring($xml, %xml2json);
            }
            else {
                print header(-status => '404 Not Found');
            }
        }
    }
    else {
        print header(-status => '404 Not Found');
    }

    return 1;
}

sub process_accept {
    my $pathinfo = shift;
    my %known = ('xml' => \&xml_search,
                 'json' => \&json_search);

    if ($pathinfo && $pathinfo =~ /(.*)\.xml$/) {
        $known{xml}->($1) and exit;
    }
    elsif ($pathinfo && $pathinfo =~ /(.*)\.json$/) {
        $known{json}->($1) and exit;
    }
    else {
        my @accepts = split /,/, $ENV{HTTP_ACCEPT};

        for my $protocol (@accepts) {
            $protocol =~ s/^\s*//;
            $protocol =~ s/\s*$//;
            exists($known{$protocol}) and $known{$protocol}->($pathinfo) and exit;
        }
    }
}


__END__