#!/usr/bin/perl
use strict;
#use warnings;

use utf8;
use POSIX qw.locale_h.;

use OpenDict;
use OpenDict::WebUtils;
use DBI;

setlocale(LC_CTYPE,   "pt_PT.utf8");
setlocale(LC_COLLATE, "pt_PT.utf8");
use locale;
use XML::DT;
use CGI qw.:standard.;

my $pathinfo = $ENV{PATH_INFO};
our $ROOT     = $ENV{DOCUMENT_ROOT};

if ($pathinfo) {
    for ($pathinfo) {
        s!^\/!!;
        s!/.*$!!;
    }
}

binmode(STDOUT, ":utf8");
xml_search($pathinfo);

sub go404 {
    print header(-status => '404 Not Found');
    exit;
}


sub xml_search {
    my $pathinfo = shift;

    Encode::_utf8_on($pathinfo);

    my $list = 0;

    my $dict = OpenDict->connect( db => "$ROOT/xml.db");
    if (param("prefix") || param("suffix")) {
        my $query = '%';
        $query = param("prefix").$query if param("prefix");
        $query = $query.param("suffix") if param("suffix");

        my $sth =
          $dict->dbh->prepare(sprintf('SELECT word FROM entry WHERE word LIKE "%s" ORDER BY normalized',
                                      $query));
        $sth->execute;
        my @row;
        my $i = 0;
        print header(-type => "application/json",
                     -charset => "utf-8");
        my $str =  "{ \"list\" : [\n";
        my $previous = 0;
        while ($i < 10 && (@row = $sth->fetchrow_array)) {
            $i++;
            $str .= "," if $previous;
            $previous = 1;
            $str .= "\"$row[0]\"";
        }
        $str .=  "]}\n";
        print _prefixa($str);
    }
    elsif (param("like")) {
        my $combinacoes = $dict->generateNearMisses(param("like"), 1);
        print header(-type => "application/json",
                     -charset => "utf-8");
        my $str = "{ \"list\" : [\n";
        my $previous = 0;
        for my $word (sort {$a <=> $b} @$combinacoes) {
            $str .= "," if $previous;
            $previous = 1;
            $str .="\"$word\"";
        }
        $str .= "]}\n";
        print _prefixa($str);
    }
    elsif ($pathinfo) {
        OpenDict::WebUtils::log_query($ROOT, $pathinfo);
        my $sth = $dict->dbh->prepare("SELECT xml FROM entry WHERE word = ?");
        $sth->execute($pathinfo);
        my @row;
        my @xmls;
        while (@row = $sth->fetchrow_array) {
            push @xmls, $row[0]
        }
        if (@xmls) {
            print header(-type => "application/json",
                         -charset => "utf-8");
            my $str = "<dic>\n";
            if ($#xmls) {
                $str .= "<superEntry>\n";
                $str .= join("\n", @xmls);
                $str .= "</superEntry>\n";
            }
            else {
                $str .= $xmls[0];
            }
            $str .= "</dic>\n";
            print _prefixa(_to_json($str));
        }
        else {
            go404;
        }
    }
    else {
        go404;
    }


}


sub _to_json {
    my $xml = shift;
    my %handler=(
                 -pcdata => sub {
                     for ($c) { s/^[\n\s]+//; s/[\n\s]+$//; s/\n/\\n/g } $c;
                 },
                 dic => sub {
                     $c =~ s/\]sensesense\[/,\n/g;
                     $c =~ s/sense\[/"sense" : [/g;
                     $c =~ s/\]sense/],/g;
                     $c =~ s/,[\n ]+([\]}])/$1/g;
                     $c =~ s/,[\n ]*$//g;
                     $c
                 },
                 superEntry => sub {
                     "{\"$q\" : [ $c ]}"
                 },
                 form => sub {
                     "\"$q\" : {\n$c\n},"
                 },
                 entry => sub {
                     my $attr;
                     $attr = join(",\n", map { " \"\@$_\" : \"$v{$_}\""} keys %v).",\n" if %v;
                     "{\"$q\" : {\n$attr$c\n}},"
                 },
                 orth => sub { "\"orth\" : \"$c\"" },
                 sense => sub {
                     my $attr;
                     $attr = join(",\n", map { " \"\@$_\" : \"$v{$_}\""} keys %v).",\n" if %v;
                     "sense[{$attr$c}]sense"
                 },
                 gramGrp => sub {
                     "\"$q\" : \"$c\",\n"
                 },
                 def => sub {
                     "\"$q\" : \"$c\",\n"
                 },
                 usg => sub {
                     my $attr = join(",\n", map { " \"\@$_\" : \"$v{$_}\""} keys %v).",\n";
                     "\"usg\" : {\n$attr \"#text\" : \"$c\"\n},"
                 },
                 etym => sub {
                     my $attr = join(",\n", map { " \"\@$_\" : \"$v{$_}\""} keys %v).",\n";
                     "\"etym\" : {\n$attr \"#text\" : \"$c\"\n},"
                 },
                );
    return dtstring($xml,%handler);
}

sub _prefixa {
    my $s = shift;
    if (param("jsonp")) {
        return param("jsonp")."($s)"
    } elsif (param("callback")) {
        return param("callback")."($s)"
    } else {
        return $s;
    }
}