Et c'est ici que ça se passe.
Un petit exemple :
Pur geek je vous disais :-p
use Archive::Zip;
my ($file) = @ARGV;
my $zip = Archive::Zip->new();
unless ( $zip->read( $file ) == AZ_OK ) {
die 'read error';
}
my $content = $zip->contents('content.xml');
$content =~ s/<[^\<\>]*>/\n/g;
$content =~ s/\n+/\n/g;
print $content;
1 # Si je veux vérifier qu'une chaîne matche plusieurs regex, j'aurais tendance à faire naïvement :
2 if ($s =~ /toto/ && $s =~ /titi/ && ... )
3
4 # Bon, trouvant ça assez laid, je ferais plutôt
5 foreach my $qw qw/toto tata titi/{
6 warn "la chaîne ne matche pas $qw" and last unless ($s =~ /$qw/ );
7 }
8
9 # L'intérêt principal étant que j'ai une vrai liste de conditions.
10 # Le problème est que ça marche bien si je veux savoir si ma chaîne ne remplie pas cette liste de conditions .
11 # Or je veux savoir si elle la remplie.
12
13 # Bien sûr on peut faire ça avec une variable booléenne mais c'est encore plus laid que le if initial
14 #
15 my $bool = 1; # vrai
16 foreach qw/toto tata titi/{
17 $bool = 0 and last unless ($s =~ /$qw/ );
18 }
19
20 # lom me proposa alors d'utiliser map de façon assez originale
21 print !grep (/0/, map { $s =~ /$_/?1:0} qw/toto tata titi/ ) ? "OK" : "NOK";
22
23 # ou encore
24 map { return 0 unless($s =~ /$_/) } qw/toto tata titi/;
25 return 1;
26
27 # Il me proposa également de reformer mon if à la volée puis de l'évaluer
28 eval '$s=~/' . join ('/ && $s=~/', qw /toto tata titi/) . '/';
29
30
31 # Finalement si j'ai pris beaucoup de plaisir à regarder et à imaginer diverses solutions rigolotes
32 # je ne sacrifierai pas la lisibilité.
33 sub est_ce_bien_vrai($@) {
34 my ($s, @qw) = @_;
35 foreach (@qw) {return 0 unless ($s =~ /$_/ );}
36 return 1;
37 }
38
39