Patrons Syntaxiques : traitement sur Cordial en pur Perl

Ci-dessous le script BaO3.pl.
Téléchargement du programme.
Téléchargement des résultats. patron NOM PREP NOM TXT

#! usr/bin/perl

###################################################
# BUT DU PROGRAMME :
# - extraire des patrons morphosyntaxiques d'un fichier étiqueté avec Cordial.
# - appel du programme : perl -w BaO3.pl "SORTIE_Surface.cnr" "patrons.txt"
###################################################

#variables globales pour tout le programme:
my @LITOKEN=();
my @LILEMME=();
my @LIETIQUETTE=();

#Lecture et stockage du fichier contenant les patrons à extraire en mémoire.
open(PATRON,"$ARGV[1]");
my @LISTEPATRON=;
close(PATRON);

open(CORDIAL,"$ARGV[0]"); #éventuellement régler des soucis d'encodage ?
while (my $ligne = ){
	$ligne =~ s/\r\n//;
	#$ligne = chomp $ligne;
	if ($ligne =~ /^(\d+\t[^\t]+)\t([^\t]+)\t([^\t]+)$/){
		my ($token,$lemme,$etiquette) = ($1,$2,$3);
		if ($etiquette !~ /PCTF/){
			push(@LITOKEN,$token);
			push(@LILEMME,$lemme);
			push(@LIETIQUETTE,$etiquette);
		}
		else {
			&compare(\@LITOKEN,\@LIETIQUETTE); #création d'une référence vers une liste (pour en faire un scalaire)
			@LITOKEN=();
			@LIETIQUETTE=();
		}
	}
}

#------------------------------------------------------------------------------------------------------------
sub compare{
	my ($first,$second) = @_; # recréation de l'objet liste 
	my @LITOKEN = @$first;
	my @LIETIQUETTE=@$second;
	#print "Liste des tokens :@LITOKEN\n";
	#print "Liste de tags : @LIETIQUETTE \n";
	foreach my $patron(@LISTEPATRON){
		chomp $patron;
		#print "$patron\n";
		#print "Tapez sur une touche pour continuer...";
		#my $rep=;
		my $texte_des_pos=join(" ",@LIETIQUETTE);
		while ($texte_des_pos=~/$patron/g){
			my $contextebefore=$`;
			print "CB=$contextebefore\n";
			my $compteurblanc=0;
			while ($contextebefore=~/ /g){
				$compteurblanc++;
				#print "$compteurblanc\n";
			}
			my @MONPATRONENCOURS= split(/ /,$patron);
			my $longueurpatron=$#MONPATRONENCOURS;
			my $bornesup = $compteurblanc + $longueurpatron;
			print "@LITOKEN[$compteurblanc..$bornesup]\n";
		}
	}
}