Code :
#!/usr/bin/perl use warnings; use strict; #les themes sous une forme plus facile a saisir: # Un hash, avec pour cle le nom du theme et valeur un array anonyme # contenant les mots a chercher pour le theme my %themes = ( "la religion" => ["dieux?", "foi", "profanes?", "prieres?", "ames?", "anges?", "croire", "eglises?", "cloches?", "ciel"], "la violence" => ["viole?s?", "souffrir", "poings?", "coups?", "drames?", "blames?", "canons?", "tirer", "fureurs?"], "la tristesse" => ["peines?", "pleure?s?", "tristes?", "larmes?", "chagrins?", "sanglots?", "drames?"], "l'amour" => ["amours?(eux)?", "aimer?(ent)?", "baisers?", "(mon|ton) autre", "coeurs?", "tendres?", "caresses?"], "la vie" => ["naitre", "mourir", "mort", "vies?", "exister?", "la fin", "en cloque", "grandir", "vivre", "temps"], "la joie" => ["sourires?", "rigoler?", "rires?", "bonheur", "joie"], "l'hiver" => ["noel", "froid", "manteau blanc", "neige"], ); # je fabrique par programme un nouveau hash, qui va avoir les memes cles (les noms de themes), # et pour valeur un array anonyme a trois elements, en premier, un compteur du nombre d'occurences # en second un compteur de lignes ou le theme apparait # et en troisieme la chaine expression reguliere correspondant au theme my %recherche; foreach my $i (keys(%themes)) { $recherche{$i} = [0, 0, make_regexp($themes{$i})]; } # le programme principal my $numero = numero_texte(); #on recupere le numero, ou bien on quitte le programme my $filename = sprintf("texte%02d.txt", $numero); open(FICHIER, "<", $filename) || die "Impossible d'ouvrir le fichier $filename"; while (<FICHIER> ) { foreach my $i (keys(%themes)) { #pour chaque expression reguliere #on cherche l'expression dans la ligne en cours du fichier if (/$recherche{$i}->[2]/i) { ++$recherche{$i}->[1]; # et on incremente le compteur de lignes ou il y a occurence while (/$recherche{$i}->[2]/gi) { ++$recherche{$i}->[0]; # et on incremente le compteur d'occurence } } } } my $found = 0; #un flag global qui va indiquer si au moins un theme a ete trouve foreach my $i (keys_by_occurences(\%themes)) { #on boucle sur les themes if ($recherche{$i}->[0]) { #si le compteur n'et pas à zero if ($recherche{$i}->[1] > 1) { print "Le theme de ", $i, " est present $recherche{$i}->[0] fois ", "dans $recherche{$i}->[1] lignes du fichier $filename.\n"; } else { print "Le theme de ", $i, " est present $recherche{$i}->[0] fois ", "dans 1 ligne du fichier $filename.\n"; } ++$found; } } if ($found) { print "Il n'y a pas d'autres themes reconnus dans le fichier $filename.\n"; } else { print "Il n'y a pas de themes reconnus dans le fichier $filename.\n"; } # les subroutines # recupere le numero, ou bien on quitte le programme # appel: numero_texte() # retour: le numero (si on n'a pas quitte le programme) sub numero_texte { my $numero; while (1) { # boucle infinie print STDOUT "Entrez le numero du texte a analyser (de 1 a 11): "; if (valider_entree("0*([1-9]||1[0-1])", \$numero)) { } else { print STDOUT "Le numero entre n'est pas valide.\n", "Voulez vous recommencer? "; exit unless (valider_simple ("O(ui)?" )); } } } # valide l'entree utilisateur par rapport a un pattern # et recupere la valeur validee # appel: valider_entree($pattern, \$entree) # retour: 0 si entree non validee, 1 si validee, et en ce cas # $entree contient la valeur validee sub valider_entree { $| = 1; my $reponse = <STDIN>; clean($reponse); $$entree = $reponse; return ($reponse && $reponse =~ /^ $pattern$/i ); } # valide l'entree utilisateur par rapport a un pattern # appel: valider_entree($pattern) # retour: 0 si entree non validee, 1 si validee sub valider_simple { $| = 1; my $reponse = <STDIN>; clean($reponse); return ($reponse && $reponse =~ /^ $pattern$/i ); } sub clean { } #en entree, une reference sur un array anonyme de mots, on colle des \b autour des mots, #puis des | entre, pour fabriquer l'expression reguliere. sub make_regexp { my $regexp = join '|', map {'\b'. $_. '\b'} @$liste_mot; } # en sortie, les cles de %themes ordonnées en fonction du compteur d'occurence du theme # lequel est le premier champ de recherche et en cas d'égalité du nombre d'occurences # en fonction du nombre de lignes ou il y a occurences # voir mon topic sur les astuces en perl pour en comprendre le fonctionnement sub keys_by_occurences { $b->[1] <=> $a->[1] or $b->[2] <=> $a->[2] } map [$_, $recherche{$_}-> [0], $recherche{$_}-> [1]], keys(%$array); }
|