#C:\Perl\bin\perl5.8.8.exe -w
use strict;
use warnings;
use locale;
use CGI::Carp qw(fatalsToBrowser);
#---------------------------------------------
read(STDIN, my $donnees, $ENV{'CONTENT_LENGTH'});
my @champs_formulaire = split(/&/, $donnees);
my ($champ, $nom, $valeur);
my %formulaire;
foreach $champ (@champs_formulaire)
{
(my $nom, my $valeur) = split(/=/, $champ);
$valeur =~ tr/+/ /;
$valeur =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$valeur =~ s/</</g;
$valeur =~ s/>/>/g;
$formulaire{$nom} = $valeur;
}
my $patron=$formulaire{patron};
my @pat=split(/ /, $patron);
#---------------------------------------------
if (!open(FILEIN,"<tag_fr.xml")) { die "Pb a l'ouverture du fichier 'tag_fr.xml'"};
print "Content-type: text/html\n\n";
print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">', "\n";
print "<html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\"/></head>\n";
print "<body bgcolor=\"#EEEEE\">";
print "<table border=\"0\" rules=\"rows\" style=\"margin-left:10px\">";
print "<tr><th> n° </th><th> Forme </th><th> Occurences </th></tr>\n";
#---------------------------------------------
my @lignes=<FILEIN>;
close(FILEIN);
my %prevlines=();
while (@lignes)
{
my $ligne=shift(@lignes);
chomp $ligne;
my $sequence="";
my $longueur=0;
if ($ligne=~/<element><data type=\"type\">$pat[0](.*)<\/data><data type=\"lemma\">([^<]+)<\/data><data type=\"string\">([^<]+)<\/data><\/element>/)
{
my $forme=$3;
$sequence.=$forme;
$longueur=1;
my $nextligne=$lignes[0];
if ($nextligne=~/<element><data type="type">$pat[1]<\/data><data type=\"lemma\">([^<]+)<\/data><data type=\"string\">([^<]+)<\/data><\/element>/)
{
my $forme1=$2;
$sequence.=" ".$forme1;
$longueur=2;
my $nextnextligne=$lignes[1];
if ($#at > 1)
{
if ($nextnextligne=~/<element><data type=\"type\">$pat[2]<\/data><data type=\"lemma\">([^<]+)<\/data><data type=\"string\">([^<]+)<\/data><\/element>/)
{
my $forme2=$2;
$sequence.=" ".$forme2;
$longueur=3;
}
}
}
}
if ($longueur==($#at+1))
{
if (not exists ($prevlines{$sequence}))
{
print "<tr><td><a href=\"http://127.0.0.1/cgi-bin/contexte.pl?$sequence\" target=\"contextes\">$sequence</a></td></tr>\n";
$prevlines{$sequence}++;
}
}
}
#---------------------------------------------
close(FILEIN);
print "</table></div></body></html>";