Comment tester la validité d'une adresse électronique ?

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);
}

my @mail_list1 = $file_content1 =~ m/([\w\-\.]+@[\w\-\.]+)/g;