#!/usr/bin/perl use CGI qw(:standard); use strict; use Search::Dict; use HTML::Entities; #use Fcntl qw(:flock); print header(); &myheader; my $dico= param('dico'); my $key=param('key'); my $traduction = ""; my $motsuivant; my ($traduction1,$suivant1); my ($traduction2,$suivant2); my $count; my $data_dir="/var/www/abp/www/dico/"; my $ERROR; my $mutation=0; my $savedkey= $key; my $racine; my $suivant; my $original; my $mutedletter; my %MUTATIONS = ("b" =>"p", "c'h" =>"k g", "d" =>"t", "f" =>"p", "g" =>"k", "k "=>"g", "kw" =>"gw", "p" =>"b", "t" =>"d", "v" =>"m b", "w" =>"gw", "z" =>"d t"); #&footer; #exit(0); if(!$key){ &footer; exit(0); } $key=substr($key,0,128); if(param('dico') eq "Dico" or param('dico') eq "DICO" or param('dico') eq "Dictionnaires"){ $ERROR=" oops!...Selectionner d'abord un dico..."; &footer; exit(0); } ##NETOYAGE #il n'y a pas de c en breton if ($dico eq "breton" and $key !~/c'?h/ ){ #replace les c par des k $key=~s/c/k/ig unless $key=~/circ/i; } #encode_entities($key,"\200-\377"); #no accent anymore $key=~s/^[ ]*//;# clean up leading white space $key=~s/\s+$//; # clean up trailing white space $key=~s/\-/ZZ/g; #replace les traits d'union car ils sont pas alphabetises ##WILD CARD if($key=~/(.*)[*]$/){ $key=$1; $traduction=&wildcard($key); &end; } ##PHRASES my $nombredemots=split(/ /,$key); #print "Vous avez entre $nombredemots"; if ($nombredemots >1){ $dico="francais"; #print "my key is $key"; my $traduction=&expression($key); print $traduction; if (!$traduction){ $dico="breton"; #print "my key is $key"; $traduction=&expression($key); print $traduction; } if (!$traduction){ print "sans resultat"; } &end; } ## BASIC SEARCH ($traduction, $motsuivant) = &search($key); if($traduction){ &end; } ## AUTOMATIC CORRECTIONS elsif ($dico eq "francais"){ #mots pluriels francais if($key=~/(.*)s$/i){ $key=$1; ($traduction, $motsuivant)=&search($key); &end; } if($key=~/(.*)e$/i){ $key=$1; ($traduction, $motsuivant)=&search($key); &end; } } elsif($dico eq "breton"){ if($key=~/(.*)iou$/i or $key=~/(.*)ou$/i){ print "
_ou et _iou sont des pluriels Desole, $savedkey n'est pas dans le dictionnaire, Mot suivant: $motsuivant ";
}
print <<"FOOTER";
$ERROR
FOOTER
}
sub search{
my $key=shift @_;
my $result;
my $definitions;
my $position=0;
my $right="";
my $left;
open (DICO, "< /var/www/abp/www/dico/$dico") or print "could not open dico $dico";
$position= look (*DICO, $key,1,1);
$result = $left ][ $right";
while ($left =~/^$key$/i and length($key)==length($left)){
$position=$position + 1;
$result = $left ][ $right";
}
}
} else{
$result=0;
close(DICO);
}
$result=~s/ZZ/\-/ig; #replace les traits d'union
return ($definitions,$left);
}
sub wildcard{
my $key=shift @_;
my $result;
my $position;
my $match=0;
my $data;
#print $key;
open (DICO, "<$dico") or die "could not open dico";
$position= look (*DICO, $key,0,1);
$result = $left ][ $right";
while ($left =~/^$key/i){
$position=$position + 1;
if ($position > $savedposition){ last;}
$result = $left ][ $right";
}
}
}
close(DICO);
return ($data);
}
sub count{
open (COUNT, ");
close COUNT;
$count++;
return $count;
}
";
$key=$1;
($traduction, $motsuivant)=&search($key);
&end;
}
#cas the w->v
elsif($key=~/(.*)o$/i or $key=~/(.*)v$/i){
$key=$1."W";
($traduction, $motsuivant)=&search($key);
&end;
}
elsif($key=~/(.*)z$/i){
$key=$1."ZH";
($traduction, $motsuivant)=&search($key);
&end;
}
elsif($key=~/^b|c'h|d|f|g|k|kw|p|t|v|w|z/ig){
#key can be muted
while(($mutedletter,$original) = each(%MUTATIONS)){
my ($racine1,$racine2) = &mutation($key,$mutedletter);
($traduction1,$suivant1)=search($racine1);
($traduction2,$suivant2)=search($racine2);
if($traduction1 and !$traduction2){
$motsuivant=$suivant1;
$mutation=1;
$traduction=$traduction1;
$racine=$racine1;
&end;
}
if($traduction2 and !$traduction1){
$motsuivant=$suivant2;
$traduction=$traduction2;
$racine=$racine2;
$mutation=1;
&end;
}
if($traduction2 and $traduction1){
$motsuivant="$suivant2";
$traduction=$traduction1;
$traduction.=$traduction2;
$mutation=1;
$racine ="$racine1 ou $racine2";
&end;
}
} # end of while loop
}# end of mutation
} #end of dico breton
#if we arrive here, we give up!!!!
¬hingfound($savedkey);
&end;
# do a grep?
#end of program############################################################################
sub mutation{
my($mot,$letter) = @_;
my $item;
my @racines = split(/ /,$MUTATIONS{$letter}); #cas de mutations pouvant provenir de deux lettres
my $mot1=$mot;
my $mot2=$mot;
$mot1=~s/^$letter(.*)/$racines[0]$1/i;
$mot2=~s/^$letter(.*)/$racines[1]$1/i;
return ($mot1,$mot2);
}
sub expression{
my $expression= shift @_;
my $resultat;
`grep -i -w "$key" /dico/francais> /var/www/abp/www/dico/tmp/$$.txt`;
open (RESULT, "/var/www/abp/www/dico/tmp/$$.txt");
$resultat=
";
}
#--------end of program-----------------------
sub end{
if ($mutation){
print "Note: $savedkey est probablement une mutation de $racine.";
}
$traduction=~s/ZZ/\-/ig;
print ($traduction);
$count =&count;
&footer;
exit(0);
}
sub myheader{
print <<"HEADER";
HEADER
}
sub footer{
my $menu=param('dico');
# my $count=&count;
if ($motsuivant){
$motsuivant=lc($motsuivant);
my $left2=$motsuivant;
$motsuivant=~s/ZZ/\-/ig;
$left2=~s/&/%26/g;
$left2=~s/;/%3B/g;
# print "
[Credits]
[Office de la Langue Bretonne]
[Bêtisier]
[Retour]