Problème perl

RTYSA 3:FEA
RIDSA 8:Fea_6773

SCPCP27:EDI0A4;SeSD;OBJ;SUBDFISC_id
CM1CC 0:
CM2CC 0:
REFCC 0:
ATCSN01:1
ATPCP22:EDI0A4;SeSD;ATT;TEX_id
ATVST 1:z
QACSN 1:0

Il faut commencer par rechercher la chaine de caractère "ATVST 1:z", la supprimer puis supprimer celle qui est au dessus (ATPCP22:EDI0A4;SeSD;ATT;TEX_id) et enfin replacer le 1 de "ATCSN01:1" par 0.
Ceci fait il faut remonter de 6 lignes, récuperer l'identifiant "Fea_6773" qui se trouve toujours apres "RIDSA 8:"
ça, c'est la premiere étape. la deuxieme c'est de rechercher depuis le début du fichier (car ce qu'on cherche se trouve forcément avant le bloc qu'on vient de traiter) l'identifiant qu'on a récupéré (ici:"Fea_6773") à la fin de la chaine "FTPCP28:EDI0A4;SeSPA_S1;FEA;Fea_6773" et de supprimer tout le bloc fea qui suit à savoir pour cet exemple: de la ligne:RTYSA 3:FEA(ligne 9119) à QACSN 1:0 (ligne 9153).

Lorsque ceci est fait on recommence tant que la chaine:"ATVST 1:z" existe dans le fichier.

#!/usr/bin/perl
use strict;use warnings;

open LIRE,"EDI0A4S1.VEC"
    or die "E/S : $!\n";

my($atvst,$tex_id,$atcsn,$ftpcp);

$atvst='ATVST 1:z';
$tex_id='ATPCP22:EDI0A4;SeSD;ATT;TEX_id';
$atcsn='ATCSN01:1';
$ftpcp='FTPCP28:EDI0A4;SeSPA_S1;FEA;';

undef $/;
my $fic=<LIRE>;

$fic =~s/$atcsn\n$tex_id\n$atvst/ATCSN01:0=====\n/sg;

my @fea = $fic =~ /\n^RIDSA 8:(Fea_.*?)\n^.*?\n^.*?\n^.*?\n^.*?\n^.*?\n^ATCSN01:0===/mg;
print $fic; # ATVST 1:z + ligne au dessus supprimés et ATCSN01:1 mis à zéro
print "@fea\n"; " capture de Fea

__END__

my @fea = $fic =~ /\n^RIDSA 8:(Fea_.*?)\n(^.*?\n){5}^ATCSN01:0===/mg;

my @fea = $fic =~ /\n^RIDSA 8:(Fea_.*?)\n^.*?\n^.*?\n^.*?\n^.*?\n^.*?\n^ATCSN01:0===/mg;

foreach $i (@fea) {$fic =~s/^FTPCP28:EDI0A4;SeSPA_S1;FEA;($i)\n$atcsn\n$qacsn\n(^.*?\n)\{34\}$qacsn/^FTPCP28:EDI0A4;SeSPA_S1;FEA;($i)\n$atcsn\n$qacsn\n/g;}

my @fea = $fic =~ /\n^RIDSA 8:(Fea_.*?)\n(?:^.*?\n){5}^ATCSN01:0===/mg;

$fic =~s/^(FTPCP28:EDI0A4;SeSPA_S1;FEA;$i\n$atcsn\n$qacsn\n)(?:^.*?\n){34}$qacsn/$1/g;

#!/usr/bin/perl

use strict;use warnings;


my ($fichiers,@fichiers,$repertoire,$i,$j,$fic,$num_planche);

my $atvst='ATVST 1:z';

my $atcsn='ATCSN01:1';

my $qacsn='QACSN 1:1';

my $rtysa='RTYSA 3:FEA';

	

@fichiers = <*.VEC>;
foreach $i (@fichiers) 
	{
	
	$num_planche = $i; 				# $i contient le nom du fichier
	$num_planche=~s/EDI0(.*)S1\.VEC/$1/;		# $num_planche contient le numero de la planche

	
	open (LIRE,"$i")  || die "lecture : $!\n";
	rename("$i","$i.old") || die ("pb pour renommer les fichiers \n");
	open RESULTAT,">>$i" or die "ecriture : $!\n";
	open RAPPORT, ">>rapport.txt";

	undef $/;

	$fic=<LIRE>;



	$fic =~s/$atcsn\nATPCP22:EDI0$num_planche;SeSD;ATT;TEX_id\n$atvst/ATCSN01:0=\n/g;



	my @fea = $fic =~ /\n^RIDSA .*?:(Fea_.+?)\n(?:^.*?\n){5}^ATCSN01:0=/mg;

	foreach $i (@fea) {$fic =~s/^.*?\n$rtysa\nRIDSA .*?:(Fea_.+?)\n(?:^.*?\n){50}FTPCP.*?:EDI0$num_planche;SeSPA_S1;FEA;($i)\nATCSN01:0\nQACSN 1:0\n.*?//mg;}

	$fic =~s/ATCSN01:0=\n.*?\n/ATCSN01:0\n/g;


	print RESULTAT $fic; 

	print RAPPORT "sur la planche $num_planche, les objets z ont été supprimés sur les fea suivants:\n@fea\n"; 
	
	print "i : $i\n";
	print "numero de planche: $num_planche\n";
	print "fea reperes: @fea\n";

	}

__END__