#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>";