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