<:
use strict;
use GDBM_File;
use Encode qw(decode encode _utf8_on);
use Time::HiRes qw(gettimeofday tv_interval);
sub alx ($) {
local $_ = shift;
s/(href="[^"]*")/\U$1/g; # acx.
s/\x{108}/Cx/g; s/\x{11c}/Gx/g;
s/\x{124}/Hx/g; s/\x{134}/Jx/g;
s/\x{15g}/Sx/g; s/\x{16c}/Ux/g;
s/\x{109}/cx/g; s/\x{11d}/gx/g;
s/\x{125}/hx/g; s/\x{135}/jx/g;
s/\x{15d}/sx/g; s/\x{16d}/ux/g;
s/(HREF="[^"]*")/\L$1/g; # acx.
return $_;
}
sub dex ($) {
local $_ = shift;
s/(href="[^"]*")/\U$1/g; # acx.
s/Cx/\x{108}/g; s/Gx/\x{11c}/g;
s/Hx/\x{124}/g; s/Jx/\x{134}/g;
s/Sx/\x{15c}/g; s/Ux/\x{16c}/g;
s/cx/\x{109}/g; s/gx/\x{11d}/g;
s/hx/\x{125}/g; s/jx/\x{135}/g;
s/sx/\x{15d}/g; s/ux/\x{16d}/g;
s/(HREF="[^"]*")/\L$1/g; # acx.
return $_;
}
my $tempo;
my $iksoj;
my $min;
BEGIN {
$tempo = [ gettimeofday ];
$header{content_type} = 'text/html; charset=UTF-8';
# Krozilo ne sendos al ni utf-8 se la charset estas us-ascii.
$iksoj = $cookie{iksoj} || $get{iksoj};
$min = $cookie{min} || $get{min};
*eoprint = $iksoj
? sub { print map alx($_), @_ }
: sub { print map dex($_), @_ };
}
my %ne_kuplu = map { $_ => undef } qw/gx gh iso br unikodon NL EO span/, "\x{11d}";
my $simplas = $ENV{HTTP_USER_AGENT} =~ /w3m|links|lynx/i;
sub i_ligiligu ($) {
my $t = shift;
return $t if $simplas;
$t =~ s [([^\s^<>()/.:,-]{2,})] {
my $w = $1;
$w !~ /\D/ || exists $ne_kuplu{$w}
? $w
: qq[$w]
}ge;
return "$t";
}
sub ligiligu ($) {
my $t = shift || $_;
return sprintf '%s',
EncodeURI(alx $t), Entity($t);
}
my @rezultoj;
if ($get{v}) {
tie my %indekso, 'GDBM_File', 'data/index.dat', GDBM_READER, 0644;
my @dosieroj = qw(data/espned.dat data/nedesp.dat);
my @d = map { open my $d, $_ or die $!; $d } @dosieroj;
_utf8_on $get{v};
my $enigo = encode 'iso-8859-3' => dex lc $get{v};
my @spekulacio;
if ($enigo =~ /[' -]/) {
push @spekulacio, grep length, split /[' -]/, $enigo;
} elsif ($enigo =~ /^..[aoeui]$|..../) {
if ($enigo =~ /(.*?)([ao])(j|n|jn)?$/) {
push @spekulacio, $1 . $2 if $3;
push @spekulacio, $1 . ($2 eq 'a' ? 'o' : 'a');
push @spekulacio, $1 . 'i';
push @spekulacio, $1 . 'e';
} elsif ($enigo =~ /(.*?)([iuoa]s|[iu])$/) {
push @spekulacio, $1 . 'i' if $2 ne 'i';
push @spekulacio, $1 . 'a';
push @spekulacio, $1 . 'e';
push @spekulacio, $1 . 'o';
} elsif ($enigo =~ /(.*?)(en?)$/) {
push @spekulacio, $1 . 'e' if $2 ne 'e';
push @spekulacio, $1 . 'a';
push @spekulacio, $1 . 'i';
push @spekulacio, $1 . 'o';
} else {
push @spekulacio, $enigo . 'o';
push @spekulacio, $enigo . 'a';
push @spekulacio, $enigo . 'i';
push @spekulacio, $enigo . 'e';
}
}
for my $vorto ($enigo, @spekulacio) {
my @ekzaktaj;
my @similaj;
my @indekso = unpack '(CV)*', $indekso{$vorto};
while (my ($f, $b) = splice @indekso, 0, 2) {
my $d = $d[$f & 0x7F];
my $e = $f & 0x80;
seek $d, $b, 0 or die $!;
$/ = "\n";
my $linio = decode 'iso-8859-3' => readline $d;
chomp $linio;
push @{ $e ? \@ekzaktaj : \@similaj }, [ $f & 0x7F, $linio ];
}
splice @similaj, 50, @similaj - 50, [ 2 ] if @similaj > 50;
push @rezultoj,
map([ 1, $$_[0], split /[%|]/, $$_[1] ], @ekzaktaj),
map([ 0, $$_[0], split /[%|]/, $$_[1] ], @similaj);
push(@rezultoj, [ 1, 2 ]), last if @rezultoj >= 500;
}
}
my $stelo = sprintf '&#x%s;',
(qw/2605/); # 2606 272a 272d 272e 272f 2730/)[rand 7];
{
my $titolo = 'NL/' .
'EO ' .
i_ligiligu 'vortaro';
# MSIE acxas. Gxi ne konas n.
my $vorto = i_ligiligu 'Vorto';
my $enigo = '';#$get{v};
my $averto =
(exists $get{iksoj} && (
not exists $cookie{iksoj} or $get{iksoj} != $cookie{iksoj}
)) ||
(exists $get{min} && (
not exists $cookie{min} or $get{min} != $cookie{min}
))
? 'Averto: via krozilo ne akceptis la kuketon! ' .
'Via prefero ne konservitas!
'
: '';
my $min = $min ? '' : '';
# $enigo = '' if $min;
eoprint qq[
NL/EO vortaro
$min
$stelo $titolo $stelo
$averto
] =~ /^\s*(.*\n?)/gm;
}
if ($get{v}) {{
my $bar = i_ligiligu('Sercxis por "'). Entity $get{v} . '". ';
my $foo = sprintf(
"La sercxado dauxris %.3f sekundojn " .
"kaj produktis %d rezultojn",
tv_interval($tempo),
scalar grep $$_[1] != 2, @rezultoj
);
$foo =~ s/\./,/;
eoprint $bar, '', i_ligiligu $foo;
if (not @rezultoj) {
eoprint i_ligiligu
".
" .
"Adaptu la ortografion aux uzu malpli da afiksoj.";
last;
}
eoprint ':
';
for (@rezultoj) {
my ($ekzaktas, $direkto, $vorto, @signifoj) = @$_;
my $vortohtml = $direkto == 2 ? 'k.t.p.' : ligiligu $vorto;
my $signifohtml = $direkto == 2 ? 'enz.' :
join ', ', map { ligiligu $_ } @signifoj;
my $e = $ekzaktas ? ' e' : '';
my $maldekstre = (qw/eo nl eo/)[$direkto];
my $dekstre = (qw/nl eo nl/)[$direkto];
eoprint(
'',
( $simplas ? "| $e | " : () ),
"$vortohtml | ",
"$signifohtml | ",
'
'
);
}
eoprint '
';
}}
{
my $viaj_preferoj = i_ligiligu 'Viaj preferoj';
my $ikse = $iksoj ? '> iksoj' : sprintf
qq[iksoj],
EncodeURI $ENV{REQUEST_URI};
my $unikodo = !$iksoj ? '> unikodo' : sprintf
qq[unikodo],
EncodeURI $ENV{REQUEST_URI};
my $minimuma = $min ? '> minimala' : sprintf
qq[minimuma],
EncodeURI $ENV{REQUEST_URI};
my $normala = !$min ? '> normala' : sprintf
qq[normala],
EncodeURI $ENV{REQUEST_URI};
eoprint
"$viaj_preferoj:
" .
"
$unikodo " .
"$ikse
" .
"
$normala " .
"$minimuma
" .
"
" .
i_ligiligu("(La minimuma stilo funkcias nur en CSS-eblaj "
. "grafikaj kroziloj.)
").
"
Malbela ',
'kodo ',
i_ligiligu 'programita far ',
'Juerd Waalboer.
',
# 'Gikuloj, vidu 2rfc :)',
'';
}