}
if ($linio =~ /^\s*\((.*)\).*/) { $auxtoro = $1; }
#print "auxtoro:".iksigu($auxtoro)."\n";
$rezulto[0] = malDonnomigu(iksigu($auxtoro));
# forjxetu cxion inter ()
$linio =~ s/\(.*\)//g;
if ($linio =~ /\[(.*)\][^\)]*$/ && !$originalo )
{
#print "tradukinto:".iksigu($1)."\n";
$rezulto[4] = malDonnomigu(iksigu($1));
}
#print "gxenro: ".okigu($gxenroj{$gxenro})."\n\n";
#$count++;
kreu_eron(@rezulto);
}
}
}
close DOS;
}
# print @dosieroj."\n\n";
} #enlegu.
##--------------------------------------------------------------------------------------------------------------------
##------ CXEFPROGRAMO -----------------------------------------------------------------------------------------------
## Konsentite, la loko estas freneza. Mi sxangxu tion.
# la funkcio 'okigu' ne nur eventuale okigas, sed ankaux povas nederlandigi.
print okigu("Sercxrezulto\n");
if($INPUT{'kodo'} =~ "ikse") {print ''."\n";}
else {print ''."\n";}
print "\n";
print "\n";
print okigu("Sercxrezulto
\n");
print "
\n";
print "versio:".$versio." - ".$dato."
\n";
print "Via peto:\n
";
print okigu(" auxtoro:".$INPUT{'auxtoro'}." titolo:".$INPUT{'titolo'}." tradukinto:".$INPUT{'tradukinto'}." ordo:".$INPUT{'ordo'}." koncizeco:".$INPUT{'koncizeco'}." sercxloko:".$INPUT{'sercxloko'}." kombino:".$INPUT{'kombino'}." kodo:".$INPUT{'kodo'}." \n");
print "
\n";
open LOG, '>>/var/www/log/enb.log' || die "ne eblis malfermi log-dosieron";
$now = gmtime;
print LOG $now." IP:".$ENV{'REMOTE_ADDR'}." auxtoro:".$INPUT{'auxtoro'}." titolo:".$INPUT{'titolo'}." tradukinto:".$INPUT{'tradukinto'}." ordo:".$INPUT{'ordo'}." koncizeco:".$INPUT{'koncizeco'}." sercxloko:".$INPUT{'sercxloko'}." kombino:".$INPUT{'kombino'}." kodo:".$INPUT{'kodo'}." \n";
close LOG;
#$i=1;
#while( $i < 256 ) { print $i.": ".chr($i)."\n"; $i++; }
#exit;
$count = 0; # ni nombras la numbron de trovoj
enlegu(); # tio cxi povus okazi pli frue, sed nun gxi estas en , kio faciligas sencimigado, cxar simplaj printoj facile legeblus..
#if($INPUT{'kombino'} =~ /kaje/)
#{
# $komb1 = "&&";
# $komb2 = "||";
#}
#else
#{
# $komb1 = "||";
# $komb2 = "&&";
#}
# Tja, tiu cxi konstruo por elekti la celatan ordon sendube pli elegante fareblus...
if($INPUT{'ordo'} =~ "trad")
{
printu_cxiujn_erojn_laux_tradukinto();
}
else
{
if($INPUT{'ordo'} =~ "aut")
{
printu_cxiujn_erojn_laux_auxtoro();
}
else
{
if($INPUT{'ordo'} =~ "tit")
{
printu_cxiujn_erojn_laux_titolo();
}
else
{
print "Ne jam eblas tiel sinsekvigi\n";
}
}
}
print "\n";
print "trovitas $count ero";
if ($count != 1) {print "j.\n"; } else { print ".\n"; } # ni konsideras la pluralecon...
print "
\n";
print 'respondecas Michiel <mihxil@esperanto.nu>
';
print "\n\n";
print "";
# ----------------------------------------------------------------------------------------------------
# fino de cxefprogramo
# ----------------------------------------------------------------------------------------------------
sub malDonnomigu # Don indikas familinomojn per majuskloj, tio ne estas konvena por alfabetigado.
{
$_ = " ".$_[0]." ";
s/(.*[\s])([A-ZÄÍÁÉÖÓ\-]{2,}?)([\s,].*)/$2, $1 $3/;
$_;
}
sub okigu
{
$_=$_[0];
if($INPUT{'kodo'} =~ "oke")
{
s|cx|ĉ|g; s|Cx|Ĉ|g; s|CX|Ĉ|g;
s|gx|ĝ|g; s|Gx|Ĝ|g; s|GX|Ĝ|g;
s|jx|ĵ|g; s|Jx|Ĵ|g; s|JX|Ĵ|g;
s|hx|ĥ|g; s|Hx|Ĥ|g; s|HX|Ĥ|g;
s|sx|ŝ|g; s|Sx|Ŝ|g; s|SX|Ŝ|g;
s|ux|ŭ|g; s|Ux|ŭ|g; s|UX|Ŭ|g;
}
if($INPUT{'kodo'} =~ "nederland")
{
s|gxenro|genre|g;
s|auxtoro|auteur|g;
s|titolo|titel|g;
s|tradukinto|vertaler|g;
s|jaro|jaar|g;
s|poezio|poezie|g;
s|prozo|proza|g;
s|teatrajxo|toneel|g;
s|trovloko|vindplaats|g;
s|Sercxrezulto|Zoekrezultaat|g;
}
$_;
}
sub iksigu
# se ni hazarde have latin-3-an enigon, ni devas povi reiksigi, cxar la programo interne supozas iksojn.
# krome, per cxi tiu funkcio eblas ankaux traduki "a al ä kaj sekve, se la dua argumento estas 1.
{
$_=$_[0];
s|ĉ|cx|g; s|Ĉ|CX|g;
s|ĝ|gx|g; s|Ĝ|GX|g;
s|ĵ|jx|g; s|Ĵ|JX|g;
s|ĥ|hx|g; s|Ĥ|HH|g;
s|ŝ|sx|g; s|Ŝ|SX|g;
s|ŭ|ux|g; s|Ŭ|UX|g;
if($_[1]) # traduku unue htm-e, tiam la latin-3/1-igu auxtomatos.
{
s/\\\"(.)/&$1uml;/g;
s/\\\'(.)/&$1acute;/g;
}
s|Ä|Ä|g;
s|Á|Á|g;
s|É|É|g;
s|Í|Í|g;
s|Ó|Ó|g;
s|Ö|Ö|g;
s|ä|Ä|g;
s|á|Á|g;
s|é|É|g;
s|í|Í|g;
s|ó|Ó|g;
s|ö|Ö|g;
s|ä|Ä|g;
s|á|Á|g;
s|é|É|g;
s|í|Í|g;
s|ó|Ó|g;
s|ö|Ö|g;
$_;
}
sub kreu_eron # ensxovu unu eron en al datumbazon.
{
my($auxtoro, $originala_titolo, $tradukita_titolo, $jaro, $tradukinto, $aperloko, $gxenro, $rimarkoj) = @_;
# print ">".$tradukinto."<\n";
gxustigu_spacojn($auxtoro, $tradukinto,$aperloko,$originala_titolo, $tradukita_titolo, $jaro);
if($gxenro) {gxustigu_spacojn($gxenro);}
# print ">".$tradukinto."<\n";
# kreu anoniman tabelon:
$rlEro = [$auxtoro, $originala_titolo, $tradukita_titolo, $jaro, $tradukinto, $aperloko, $gxenro, $rimarkoj];
# kreu kelkajn indeksojn:
# tiu cxi funkcio estas pli malpli sxtelita. Eble ne necesas fari indeksojn, cxar la tuta enmemora datumbazo estas nur
# unufoje uzota. Do, versxajne entempa ordigo same bone funkcius.
push (@{$auxtoro_indekso {uc($auxtoro)}}, $rlEro);
# push (@{$jaro_indekso {$jaro}}, $rlEro);
push (@{$tradukinto_indekso {uc($tradukinto)}}, $rlEro);
push (@{$tradukita_titolo_indekso {uc($tradukita_titolo)}}, $rlEro);
}
sub nomo # kiom stulta funkcio povas esti...
{
$_=$_[0];
}
sub gxustigu_spacojn
{
for (@_)
{
s/^\s*//; # forigu spacojn komenclinie
s/\s*$//; # kaj fine
s/\s+/ /; # kaj krome cxiuj estu unuopaj
}
}
sub printu_eron
{
# if(
# eval (
# "(!$INPUT{'auxtoro'} $komb2 ($rlEro->[0] =~ /$INPUT{'auxtoro'}/i )) $komb1 ".
# "(!$INPUT{'titolo'} $komb2 ($rlEro->[2]) =~ /$INPUT{'titolo'}/i )) $komb1 ".
# "(!$INPUT{'tradukinto'} $komb2 ($rlEro->[4] =~ /$INPUT{'tradukinto'}/i )) "
# )
# )
# print "komb:".$INPUT{'kombino'}."auxt:".$INPUT{'auxtoro'}."\n";
if(
(($INPUT{'kombino'} =~ /kaje/) &&
(
(!$INPUT{'auxtoro'} || ( $rlEro->[0] =~ /$INPUT{'auxtoro'}/i )) &&
(!$INPUT{'titolo'} || ( $rlEro->[2] =~ /$INPUT{'titolo'}/i )) &&
(!$INPUT{'tradukinto'} || ( $rlEro->[4] =~ /$INPUT{'tradukinto'}/i ))
)) ||
(($INPUT{'kombino'} =~ /aue/) &&
(
($INPUT{'auxtoro'} && ( $rlEro->[0] =~ /$INPUT{'auxtoro'}/i )) ||
($INPUT{'titolo'} && ( $rlEro->[2] =~ /$INPUT{'titolo'}/i )) ||
($INPUT{'tradukinto'} && ( $rlEro->[4] =~ /$INPUT{'tradukinto'}/i ))
))
)
# if(0)
{
$count++;
if($INPUT{'koncizeco'} =~ "^nurnombru")
{
return;
}
if($INPUT{'koncizeco'} =~ "^koncize")
{
print okigu($rlEro->[0]." - ".$rlEro->[2]." - ".$rlEro->[4]."\n");
}
else
{
print okigu("auxtoro: ".$rlEro->[0]."\n");
if($rlEro->[1]){print "originala titolo: ".$rlEro->[1]."\n";}
print okigu("titolo: ".$rlEro->[2]."\n");
if($rlEro->[4]) { print(okigu("tradukinto: ").$rlEro->[4]."\n"); }
if($rlEro->[3]) { print(okigu("jaro: ").$rlEro->[3]."\n");}
print okigu("trovloko: ");
@trov = trovlok($rlEro->[5]);
if($trovlokoj{$trov[0]})
{
@trov = trovlok($rlEro->[5]);
print okigu($trovlokoj{$trov[0]});
if($trov[1]){ print $trov[1]; }
if($trov[2]){ print " - ".$trov[2]; }
print "\n";
}
else
{
print $rlEro->[5]."\n";
}
if($rlEro->[6])
{
print okigu("gxenro: ");
foreach $litero (split (//, $rlEro->[6])) # traktu cxiun literon aparte.
{
print okigu($gxenroj{$litero})." ";
}
print "\n";
}
if($rlEro->[7]) {print okigu("rimarko: ".$rlEro->[7]."\n");}
print "\n";
}
}
}
# La sekvaj funkcioj ankaux estas preskaux rektaj sxteloj. Ne tro demandu kiel ili funkciu, kaj kial tiel.
sub printu_erojn_laux_auxtoro
{
my($auxtoro) = @_;
foreach $rlEro (@{$auxtoro_indekso{$auxtoro}})
{
printu_eron();
}
}
sub printu_cxiujn_erojn_laux_auxtoro
{
foreach $auxtoro (sort keys %auxtoro_indekso)
{
printu_erojn_laux_auxtoro($auxtoro);
}
}
sub printu_erojn_laux_tradukinto
{
my($tradukinto) = @_;
foreach $rlEro (@{$tradukinto_indekso{$tradukinto}})
{
printu_eron();
}
}
sub printu_cxiujn_erojn_laux_tradukinto
{
foreach $tradukinto (sort keys %tradukinto_indekso)
{
printu_erojn_laux_tradukinto($tradukinto);
}
}
sub printu_erojn_laux_titolo
{
my($titolo) = @_;
foreach $rlEro (@{$tradukita_titolo_indekso{$titolo}})
{
printu_eron();
}
}
sub printu_cxiujn_erojn_laux_titolo
{
foreach $titolo (sort keys %tradukita_titolo_indekso)
{
printu_erojn_laux_titolo($titolo);
}
}
sub getinput {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# print "buffer>".$buffer."<";
# fakte mi ne scias por kio tauxgas tion cxi.
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s//>/g;
$value =~ s!\cM!!g;
$value =~ s!\n! !g;
$INPUT{$name} = iksigu($value,1);
}
@pairs = split(/&/, $ENV{'QUERY_STRING'});
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s//>/g;
$value =~ s!\cM!!g;
$value =~ s!\n! !g;
$INPUT{$name} = iksigu($value,1);
}
}
# Local variables:
# coding: utf-8
# End: