blob: d6fc6c5f969c873da07e7c165d5b2e590c1c4e26 [file] [log] [blame]
#!/usr/bin/env perl
our $VERSION = '0.93';
use IDS::DeReKoVecs::Read;
use Mojolicious::Lite;
use Mojo::JSON qw(decode_json encode_json to_json);
use base 'Mojolicious::Plugin';
use Encode qw(decode encode);
use Getopt::Std;
#use Mojo::Server::Daemon;
use Cwd;
my $mojo_config = $ENV{MOJO_CONFIG} // '../derekovecs-server.conf';
plugin Config => {file => $mojo_config};
my $DEFAULT_VECS = app->config->{w2v}->{vecs} // "../models/dereko-2021-i.vecs";
my $KORAP_URL = app->config->{w2v}->{korap_url} // "https://korap.ids-mannheim.de";
my $DEFAULT_NET_NAME = "";
if ($DEFAULT_VECS=~ /\.vecs/) {
$DEFAULT_NET_NAME = $DEFAULT_VECS;
$DEFAULT_NET_NAME =~ s/\.vecs/.net/;
}
my $DEFAULT_NET = app->config->{w2v}->{net} // $DEFAULT_NET_NAME;
my $DOWNTIME_CALENDAR_URL = app->config->{downtime_calendar_url} // '';
app->static->paths->[0] = getcwd;
plugin 'Piwik';
plugin "RemoteAddr";
plugin 'Util::RandomString' => {
piwik_rand_id => {
alphabet => '0123456789abcdef',
length => 16
}
};
plugin 'Log::Access';
plugin "RequestBase";
#plugin 'AutoReload';
plugin Localize => {
dict => {
_ => sub { $_->locale },
},
resources => ['../derekovecs-server.dict']
};
our $opt_i = 0; # latin1-input?
our $opt_l = undef;
our $opt_m;
our $opt_M;
our $opt_n = $DEFAULT_NET;
our $opt_d;
our $opt_D;
our $opt_G;
our $mergedEnd=0;
our %cache;
our %cccache; # classic collocator cache
our %spcache; # similar profile cache
our $opt_p = 5676;
our $opt_C;
my %marked;
my $title="";
my $training_args="";
getopts('d:D:Gil:p:m:n:M:C') or usage();
sub usage() {
print STDERR <<EOF;
non-server mode usage: MOJO_CONFIG=`pwd`/example.conf $0 [-h] [-d <file>]
-h : this (help) message
-d file : dump binary vecs as ascii text to <file>
server-mode invocation:
MOJO_CONFIG=`pwd`/example.conf morbo $0
EOF
exit;
}
if($opt_M) {
open my $handle, '<:encoding(UTF-8)', $opt_M
or die "Can't open '$opt_M' for reading: $!";
while(<$handle>) {
foreach my $mw (split /\s+/) {
$marked{$mw}=1
}
}
close($handle);
}
my $vecs_name = (@ARGV > 0 && -r $ARGV[0] ? $ARGV[0] : $DEFAULT_VECS);
init_net($vecs_name, $opt_n, ($opt_i? 1 : 0), 1);
if(open(FILE, "$vecs_name.args")) {
$training_args = <FILE>;
}
close(FILE);
$title = fname2corpusname($vecs_name);
my $have_sprofiles = load_sprofiles($vecs_name);
if (app->config->{w2v}->{merge}) {
$opt_m = app->config->{w2v}->{merge};
}
if($opt_m) {
$mergedEnd = mergeVectors($opt_m);
$title = "<span class=\"merged\">" . $title . "</span> vs. " . fname2corpusname($opt_m);
}
if($opt_d) { # -d: dump vecs and exit
dump_vecs($opt_d);
exit;
}
if($opt_D) { # -D: dump vecs for numpy and exit
dump_for_numpy($opt_D);
exit;
}
#my $daemon = Mojo::Server::Daemon->new(
# app => app,
# listen => ['http://'.($opt_l ? $opt_l : '*').":$opt_p"]
#);
if($opt_G) {
print "Filtering garbage\n";
filter_garbage();
print "Finished filtering garbage\n";
}
get '*/js/*' => sub {
my $c = shift;
my $url = $c->req->url;
$url =~ s@/derekovecs/@/@g;
$c->app->log->info("GET: " . $url);
$c->reply->static($url);
} => 'js';
get '*/css/*' => sub {
my $c = shift;
my $url = $c->req->url;
$url =~ s@/derekovecs/@/@g;
$c->app->log->info("GET: " . $url);
$c->reply->static($url);
} => 'css';
sub fname2corpusname {
($_) = @_;
s@.*/@@;
s@\.en@-en@;
s@\..*@@;
return $_;
}
sub getWord {
($_) = @_;
if ($_ =~ /^\d+/) {
return $_;
} else {
return getWordNumber($_);
}
}
post '/derekovecs/getVecsByRanks' => sub {
my $self = shift;
my $vec = getVecs($self->req->json);
$self->render(json => $vec);
};
any '*/getCollocationAssociation' => sub {
my $self = shift;
$self->render(data => getCollocationAssociation($self, getWord($self->param("w") ? $self->param("w") : $self->req->json), getWord($self->param("c"))), format=>'json');
} => 'getCollocationAssociation';
any '/getCollocationAssociation' => sub {
my $self = shift;
$self->render(data => getCollocationAssociation($self, getWord($self->param("w") ? $self->param("w") : $self->req->json), getWord($self->param("c"))), format=>'json');
} => 'getCollocationAssociation1';
any '*/getClassicCollocators' => sub {
my $self = shift;
$self->render(data => getClassicCollocatorsCached($self, getWord($self->param("w") ? $self->param("w") : $self->req->json)), format=>'json');
} => 'getClassicCollocators1';
any '/getClassicCollocators' => sub {
my $self = shift;
$self->render(data => getClassicCollocatorsCached($self, getWord($self->param("w") ? $self->param("w") : $self->req->json)), format=>'json');
} => 'getClassicCollocators';
any '/getBiggestVocabDistances' => sub {
my $self = shift;
$self->render(data => getBiggestMergedDifferences(), format=>'json');
} => 'getBiggestVocabDistances1';
any '*/getBiggestVocabDistances' => sub {
my $self = shift;
$self->render(data => getBiggestMergedDifferences(), format=>'json');
} => 'getBiggestVocabDistances';
any '*/getPosWiseW2VCollocators' => sub {
my $self = shift;
$self->render(data => getPosWiseW2VCollocatorsAsTsv($self->param("w"),
($self->param("max")? $self->param("max") : 200),
($self->param("cutoff")? $self->param("cutoff") :750000),
($self->param("threshold")? $self->param("threshold") : 0.2)),
format=>'tsv');
};
any '/getPosWiseW2VCollocators' => sub {
my $self = shift;
$self->render(data => getPosWiseW2VCollocatorsAsTsv($self->param("w"),
($self->param("max")? $self->param("max") : 200),
($self->param("cutoff")? $self->param("cutoff") : 750000),
($self->param("threshold")? $self->param("threshold") : 0.2)),
format=>'tsv');
};
any '*/getSimilarProfiles' => sub {
my $self = shift;
$self->render(data => getSimilarProfilesCached($self, getWord($self->param("w") ? $self->param("w") : $self->req->json)), format=>'json');
};
any '/getSimilarProfiles' => sub {
my $self = shift;
$self->render(data => getSimilarProfilesCached($self, getWord($self->param("w") ? $self->param("w") : $self->req->json)), format=>'json');
};
any '*/getWord' => sub {
my $self = shift;
my $w = $self->param("w");
my $rank = getWord($w);
my $status = 200;
if ($rank <= 0) {
$rank = -1;
$status = 404;
}
$self->render(data => encode_json({word => $w, frequencyRank => $rank}), format => 'json', status => $status);
};
any '/getWord' => sub {
my $self = shift;
my $w = $self->param("w");
my $rank = getWord($w);
my $status = 200;
if ($rank <= 0) {
$rank = -1;
$status = 404;
}
$self->render(data => encode_json({word => $w, frequencyRank => $rank}), format => 'json', status => $status);
};
any '/getSimilarity' => sub {
my $self = shift;
my $w1 = $self->param("w1");
my $w2 = $self->param("w2");
$self->render(data => cos_similarity_as_json($w1, $w2), format=>'json');
};
any '*/getSimilarity' => sub {
my $self = shift;
my $w1 = $self->param("w1");
my $w2 = $self->param("w2");
$self->render(data => cos_similarity_as_json($w1, $w2), format=>'json');
};
any '*/getDowntimeCalendar' => sub {
my $self = shift;
my $calendar = getDowntimeCalendar($DOWNTIME_CALENDAR_URL);
$self->render(data => $calendar, format=>'text');
};
any '/getDowntimeCalendar' => sub {
my $self = shift;
my $calendar = getDowntimeCalendar($DOWNTIME_CALENDAR_URL);
$self->render(data => $calendar, format=>'text');
};
any '/getVocabSize' => sub {
my $self = shift;
$self->render(data => getVocabSize(), format=>'json');
};
any '*/getVocabSize' => sub {
my $self = shift;
$self->render(data => getVocabSize(), format=>'json');
};
any '/getVersion' => sub {
my $self = shift;
$self->render(data => to_json($VERSION), format=>'json');
};
any '*/getVersion' => sub {
my $self = shift;
$self->render(data => to_json($VERSION), format=>'json');
};
any '/getModelName' => sub {
my $self = shift;
$self->render(data => to_json($title), format=>'json');
};
any '*/getModelName' => sub {
my $self = shift;
$self->render(data => to_json($title), format=>'json');
};
get '*/img/*' => sub {
my $c = shift;
my $url = $c->req->url;
$url =~ s@/derekovecs@@g;
$c->app->log->info("GET: " . $url);
$c->reply->static($url);
};
get '/' => sub {
my $c = shift;
$c->app->log->info("get: ".$c->req->url->to_abs);
my $word=$c->param('word');
my $no_nbs=$c->param('n') || ($opt_m? 50 : 100);
my $no_iterations=$c->param('N') || 2000;
my $perplexity=$c->param('perplexity') || 20;
my $epsilon=$c->param('epsilon') || 5;
my $som=$c->param('som') || 0;
my $searchBaseVocabFirst=$c->param('sbf') || 0;
my $sort=$c->param('sort') || 0;
my $csv=$c->param('csv') || 0;
my $json=$c->param('json') || 0;
my $cutoff=$c->param('cutoff') || 500000;
my $dedupe=$c->param('dedupe') || 0;
my $nosp=$c->param('nosp') || 0;
my $res;
my @lists;
my @collocations;
if(defined($word) && $word !~ /^\s*$/) {
$c->inactivity_timeout(300);
$word =~ s/\s+/ /g;
if($opt_m && $word !~ /\|/) {
$word .= "|$word";
}
for my $w (split(' *\| *', $word)) {
if($opt_m) {
if($searchBaseVocabFirst) {
$searchBaseVocabFirst=0;
} else {
$searchBaseVocabFirst=1;
}
}
if ($cache{$w.$cutoff.$no_nbs.$sort.$dedupe,$searchBaseVocabFirst}) {
$c->app->log->info("Getting $w results from cache");
$res = $cache{$w.$cutoff.$no_nbs.$sort.$dedupe.$searchBaseVocabFirst}
} else {
$c->app->log->info('Looking for neighbours of '.$w);
if($opt_i) {
$res = get_neighbours(encode("iso-8859-1", $w), $no_nbs, $sort, $searchBaseVocabFirst, $cutoff, $dedupe, $nosp);
} else {
$res = get_neighbours($w, $no_nbs, $sort, $searchBaseVocabFirst, $cutoff, $dedupe, $nosp);
}
$cache{$w.$cutoff.$no_nbs.$sort.$dedupe} = $res;
}
push(@lists, $res->{paradigmatic});
}
}
$word =~ s/ *\| */ | /g;
if($json) {
return $c->render(json => {word => $word, list => \@lists, collocators=>$res->{syntagmatic}});
} elsif($csv) {
my $csv_data="";
for (my $i=0; $i <= $no_nbs; $i++) {
$csv_data .= $res->{paradigmatic}->[$i]->{word} . ", ";
}
for (my $i=0; $i < $no_nbs; $i++) {
$csv_data .= $res->{syntagmatic}->[$i]->{word} . ", ";
}
chop $csv_data;
chop $csv_data;
$csv_data .= "\n";
return $c->render(text=>$csv_data);
} else {
my $distantWords="";
if(!defined($word) || $word !~ /^\s*$/) {
$distantWords = getBiggestMergedDifferences();
}
$c->render(
template => "index",
title => $title,
word => $word,
distantWords => $distantWords,
cutoff => $cutoff,
no_nbs => $no_nbs,
no_iterations => $no_iterations,
epsilon => $epsilon,
perplexity => $perplexity,
show_som => $som,
searchBaseVocabFirst => $searchBaseVocabFirst,
sort => $sort,
training_args => $training_args,
mergedEnd => $mergedEnd,
haveSProfiles => $have_sprofiles,
dedupe => $dedupe,
marked => \%marked,
lists => \@lists,
collocators => $res->{syntagmatic},
version => $VERSION,
korap_url => $KORAP_URL,
);
}
} => "paradigmaticAndSyntagmaticNbs";
helper(bitvec2window => sub {
my ($self, $n) = @_;
my $str = unpack("B32", pack("N", $n));
$str =~ s/^\d{22}//;
$str =~ s/^(\d{5})/$1x/;
$str =~ s/0/ยท/g;
$str =~ s/1/+/g;
return $str;
});
if(app->config->{Piwik} && app->config->{Piwik}->{url}) {
hook(
after_render => sub {
my $c = shift;
# Only track valid routes
my $route = $c->current_route or return;
# This won't forward personalized information
my $hash = {
action_url => $c->req->url->to_abs,
action_name => $route,
ua => $c->req->headers->user_agent,
urlref => '',
send_image => 0,
dnt => 0,
cip => $c->remote_addr,
lang => $c->req->headers->accept_language,
uid => $c->random_string('piwik_rand_id')
};
# $c->app->log->info("PIWIK: counting " . $hash->{action_url} . "\nremote:" . $c->remote_addr);
# $c->app->log->info("PIWIK: tag " . $c->piwik_tag);
# Send track
$c->piwik->api_p(Track => $hash)->wait;
# $c->app->log->info("PIWIK: counted.");
}
);
}
app->renderer->paths([app->home->rel_file('../templates')]);
app->start;
#$daemon->run;
# app->start;
# exit;