1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
| use Modern::Perl;
use Data::Dumper;
use Cwd;
use Cwd qw/ abs_path /;
my $dir1 = getcwd();
my $fichierAComparer;
opendir (REP, $dir1) or die("Impossible d'ouvrir le repertoir $dir1\n$!");
while (my $ligne = readdir REP){
funcopendir($ligne);
}
sub funcopendir{
my ($dir) = @_;
while (my $ligne = readdir REP){
print $ligne;
<>;
if ($ligne =~ /[a-zA-Z0-9_]\.xem/i){
my $abs_path = abs_path($ligne);
my $FichierDepart = "$abs_path";
$abs_path =~ s/in/out/;
my $FichierModifie = "$abs_path";
open( my $FhDepart, '<', $FichierDepart ) or die("Impossible d'ouvrir le fichier $ligne\n$!");
open( my $FhModifie, '>', $FichierModifie ) or die("Impossible d'ouvrir le fichier $FichierModifie\n$!");
while (my $ligne2 = <$FhDepart>){
if($ligne2 =~ /VBCode/i){
$fichierAComparer = enleverPartieQuotable($ligne2,"Inherits","Auto-Generated","Protected Sub CleanupUserCode","Sub");
$ligne2 = substitution($ligne2, "Inherits", "Auto-Generated", "Friend", sub {"\' Friend"});
$ligne2 = substitution($ligne2, "Protected Sub CleanupUserCode", "Sub", qr/((\w+\s*=))/, sub {"' $1"});
print $FhModifie $ligne2;
}
else{
print $FhModifie $ligne2;
}
}
close ($FhModifie);
close ($FhDepart);
print "Copie de $ligne succes";
}
elsif ($ligne =~ /\w\.\w/){
print "$ligne"." Mauvais format de fichier.\n";
}
else{
my $abs_path1 = abs_path($ligne);
opendir (REP1, $abs_path1) or die ("Impossible d'ouvrir le repertoir $ligne\n$!");
while (my $ligne3 = readdir REP1){
funcopendir($ligne3);
}
}
}
}
#Fonction qui permet de remplacer tel valeur à tel endroit.
sub substitution {
my ($ligneAModifier, $limite1 ,$limite2 , $motARemplacer, $motDeRemplacement) = @_;
my ( $val1, $val2) = split(/$limite1/i, $ligneAModifier , 2);
my ( $val3, $val4) = split(/$limite2/i, $val2, 2);
recuperation($val3);
my @tabval3 = split((/
/), $val3);
foreach my $item (@tabval3){
if (my ($first_match) = $item =~ /([a-zA-Z_]+[0-9]+)+/g){
if ($fichierAComparer =~ /$first_match/){
}
else{
$item =~ s/$motARemplacer/$motDeRemplacement->()/ge;
}
}
else{
}
}
$val3 = join(("
"), @tabval3);
return $val1."$limite1".$val3."$limite2".$val4;
}
#Permet de creer une variable avec la copie du fichier sans les zone sur lequelle on va travailler.
sub enleverPartieQuotable{
my ($text, $limite11, $limite22, $limite33, $limite44) = @_;
my ($val1, $val2) = split(/$limite11/i, $text, 2);
my ($val3, $val4) = split(/$limite22/i, $val2, 2);
my ($val5, $val6) = split(/$limite33/i, $val4, 2);
my ($val7, $val8) = split(/$limite44/i, $val6, 2);
$text = "$val1$val5$val8";
return $text;
}
<>; |
Partager