Voici mon code terminé qui fonctionne parfaitement (jusqu'à preuve du contraire) :
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
| #!/usr/local/bin/perl
use strict;
use warnings;
use List::Compare;
# chemin vers les fichiers
my $file_path1 = 'P:/Theorie/Driss/adresses_mail/New_Yeast_2011.txt';
my $file_path2 = 'P:/Theorie/Driss/adresses_mail/retour_yeast_email_format.txt';
# récupérér l'entiereté du premier fichier dans une variable $file_content1
open my($file1), '<', $file_path1
or die "Can't open $file_path1 : $!\n";
my $file_content1 = do { local $/; <$file1> };
close $file1;
# récupérér l'entiereté du second fichier dans une variable $file_content2
open my($file2), '<', $file_path2
or die "Can't open $file_path2 : $!\n";
my $file_content2 = do { local $/; <$file2> };
close $file2;
# récupération des adresses électroniques dans deux listes @mail_list1 et @mail_list2
my @mail_list1 = $file_content1 =~ m/([\w\-\.]+@[\w\-\.]+)/g;
my @mail_list2 = $file_content2 =~ m/([\w\-\.]+@[\w\-\.]+)/g;
# suppression des adresses électroniques doubles
@mail_list1 = &supprime_doublon(\@mail_list1 );
@mail_list2 = &supprime_doublon(\@mail_list2 );
# affichage du nombre d'adresses uniques pour chaque liste
print "mail_list1 : ".@mail_list1."\n";
print "mail_list2 : ".@mail_list2."\n";
# création d'une comparaison de listes avec le module List::Compare
my $lc = List::Compare->new(\@mail_list1 , \@mail_list2);
# recherche des adresses n'apparaissant que dans la première liste
my @Lonly = $lc->get_unique;
print "adresses de New Yeast 2011.xls sans celles de Retour yeast email.txt : ".@Lonly."\n";
print (join "\n", @Lonly);
print "'\n\n";
sub supprime_doublon{
my $self=shift;
my %saw;
my @result = @$self; #deréférence le tableau, donc on le récupère et le copie dans @result
#pour eviter de travailler sur le tableau d'origine et le modifier.
undef %saw;
@saw{@result} = (); #chaque case de @result est mis en clef dans %saw avec une valeur nulle. et comme un
@result = sort keys %saw; #hash n'a pas deux clefs identiques, redondances supprimées.
return(@result);
} |
... je ne dis pas qu'il est optimal au niveau temps d'exécution mais ça me suffit largement.
Envoyé par
Djibril
il y a surement un module nous permettant d'avoir le bon pattern pour la regex, il faut juste chercher sur le CPAN
Pourquoi faire simple si il y a compliqué ... heuh non, l'inverse
N'est-ce pas amplement suffisant :
my @mail_list1 = $file_content1 =~ m/([\w\-\.]+@[\w\-\.]+)/g;
nb : le sous-programme supprime_doublon, je le dois à Jedaï ... merci encore à lui, ça me sert tout le temps.
EDIT ; un grand merci à Djibril pour son sous-programme supprime_doublon
Partager