# transforme la ligne en le premier mot, le signe deux points # et le nombre de caractères du reste de la ligne s/^(\w+)(.*)/ lc($1) . ":" . length($2) /meg;
"/x" vous permet de transformer ceci:
s{<(?:[^>'"]*|".*?"|'.*?')+>}{}gs;
en:
s{ < # signe inférieur
(?: # parenthèse ouvrante ne faisant pas de référence
[^>'"] * # 0 ou plus de caract. qui ne sont ni >, ni ' ni "
| # ou
".*?" # une partie entre guillemets (reconnaissance min)
| # ou
'.*?' # une partie entre apostrophes (reconnaissance min)
) + # tout cela se produisant une ou plusieurs fois
> # signe supérieur
}{}gsx; # remplacé par rien, cad supprimé
Ce n'est pas encore aussi clair que de la prose, mais c'est très utile pour décrire le sens de chaque partie du motif.
s/\/usr\/local/\/usr\/share/g; # mauvais choix de délimiteur s#/usr/local#/usr/share#g; # meilleur
Il y a plusieurs manières d'avoir plusieurs lignes dans une chaîne. Si vous voulez l'avoir automatiquement en lisant l'entrée, vous initialiserez $/ (probablement à "" pour des paragraphes ou "undef" pour le fichier entier) ce qui vous permettra de lire plus d'une ligne à la fois.
Lire perlre vous aidera à décider lequel de "/s" et "/m" (ou les deux) vous aimeriez utiliser : "/s" permet au point de reconnaître le caractère fin de ligne, et "/m" permet au circonflexe et dollar de reconnaître tous les débuts et fins de ligne, pas seulement le début et la fin de la chaîne. Vous pouvez l'utiliser pour être sûr que vous avez bien plusieurs lignes dans votre chaine.
Par exemple, ce programme détecte les mots répétés, même s'ils sont coupés (mais pas dans plusieurs paragraphes). Pour cet exemple, nous n'avons pas besoin de "/s" car nous n'utilisons pas le point dans l'expression régulière dont on veut qu'elle enjambe les lignes. Nous n'avons pas besoin non plus de "/m" car nous ne voulons pas que le circonflexe ou le dollar fasse une reconnaissance d'un début ou d'une fin d'une nouvelle ligne. Mais il est impératif que $/ soit mis pour autre chose que l'option par défaut, ou autrement nous n'aurons pas plusieurs lignes d'un coup à se mettre sous la dent.
$/ = ''; # lis au moins un paragraphe entier,
# pas qu'une seule ligne
while ( <> ) {
while ( /\b([\w'-]+)(\s+\1)+\b/gi ) { # les mots commencent par
# des caractères alphanumériques
print "$1 est répété dans le paragraphe $.\n";
}
}
Voilà le code qui trouve les phrases commençant avec ``From '' (qui devrait être transformés par la plupart des logiciels de courrier électronique) :
$/ = ''; # lis au moins un paragraphe entier, pas qu'une seule ligne
while ( <> ) {
while ( /^From /gm ) { # /m fait que ^ reconnaisse
# tous les débuts de ligne
print "from de départ dans le paragraphe $.\n";
}
}
Voilà le code qui trouve tout ce qu'il y a entre START et END dans un paragraphe :
undef $/; # lis le fichier entier, pas seulement qu'une ligne
# ou un paragraphe
while ( <> ) {
while ( /START(.*?)END/sm ) { # /s fait que . enjambe les lignes
print "$1\n";
}
}
perl -ne 'print if /START/ .. /END/' fichier1 fichier2 ...
Si vous voulez du texte et non des lignes, vous pouvez utiliser
perl -0777 -ne 'print "$1\n" while /START(.*?)END/gs' fichier1 fichier2 ...
Mais si vous voulez des occurrences imbriquées de "START" à l'intérieur de "END", vous tombez sur le problème décrit, dans cette section, sur la reconnaissance de texte bien équilibré.
Ici un autre exemple d'utilisation de ".." :
while (<>) {
$in_header = 1 .. /^$/;
$in_body = /^$/ .. eof();
# maintenant choisissez entre eux
} continue {
reset if eof(); # fixe $.
}
En fait, vous pouvez faire ceci si vous n'avez pas à vous soucier de mettre le fichier entier en mémoire :
undef $/; @records = split /your_pattern/, <FH>;
Le module Net::Telnet (disponible chez CPAN) a la capacité d'attendre pour un motif dans le flux d'entrée, ou fait un timeout si ce motif n'apparait pas dans un temps donné.
## Crée un fichier de trois lignes. open FH, ">file"; print FH "La première ligne\nLa deuxième ligne\nLa troisième ligne\n"; close FH;
## Lui met un handle de fichier en lecture/écriture. $fh = new FileHandle "+<file";
## L'attache à un objet "stream". use Net::Telnet; $file = new Net::Telnet (-fhopen => $fh);
## Cherche la deuxième ligne et imprime la troisième.
$file->waitfor('/deuxième ligne\n/');
print $file->getline;
$_= "this is a TEsT case";
$old = 'test';
$new = 'success';
s{(\Q$old\E}
{ uc $new | (uc $1 ^ $1) .
(uc(substr $1, -1) ^ substr $1, -1) x
(length($new) - length $1)
}egi;
print;
Et la voici sous la forme d'un sous-programme, selon le modèle ci-dessus :
sub preserve_case($$) {
my ($old, $new) = @_;
my $mask = uc $old ^ $old;
uc $new | $mask .
substr($mask, -1) x (length($new) - length($old))
}
$a = "this is a TEsT case";
$a =~ s/(test)/preserve_case($1, "success")/egi;
print "$a\n";
Ceci affiche :
this is a SUcCESS case
Rien que pour montrer que les programmeurs C peuvent écrire du C dans tous les langages de programmation, si vous préférez une solution plus proche du style de C, le script suivant fait en sorte que la substitution a la même casse, lettre par lettre, que l'original (il s'avère aussi tourner environ 240 % plus lentement que la version perlienne). Si la substitution a plus de caractères que la chaîne substituée, la casse du dernier caractère est utilisée pour le reste de la substitution.
# L'original est de Nathan Torkington, mis en forme par Jeffrey Friedl
#
sub preserve_case($$)
{
my ($old, $new) = @_;
my ($state) = 0; # 0 = no change; 1 = lc; 2 = uc
my ($i, $oldlen, $newlen, $c) = (0, length($old), length($new));
my ($len) = $oldlen < $newlenE<nbsp>? $oldlenE<nbsp>: $newlen;
for ($i = 0; $i < $len; $i++) {
if ($c = substr($old, $i, 1), $c =~ /[\W\d_]/) {
$state = 0;
} elsif (lc $c eq $c) {
substr($new, $i, 1) = lc(substr($new, $i, 1));
$state = 1;
} else {
substr($new, $i, 1) = uc(substr($new, $i, 1));
$state = 2;
}
}
# on se retrouve avec ce qui reste de new
# (quand new est plus grand que old)
if ($newlen > $oldlen) {
if ($state == 1) {
substr($new, $oldlen) = lc(substr($new, $oldlen));
} elsif ($state == 2) {
substr($new, $oldlen) = uc(substr($new, $oldlen));
}
}
return $new;
}
$string = "to die?"; $lhs = "die?"; $rhs = "sleep, no more";
$string =~ s/\Q$lhs/$rhs/; # $string est maintenant "to sleep no more"
Sans le \Q, l'expression rationnelle aurait faussement aussi reconnu ``di''.
Utiliser "/o" est peu pertinent à moins que le remplacement de variable ne soit utilisé dans le motif, et si cela est, le moteur d'expression régulière ne prendra pas en compte les modifications de la variable ultérieures à la toute première évaluation.
"/o" est souvent utilisé pour gagner en efficacité en ne faisant pas les évaluations nécessaires quand vous savez que cela ne pose pas de problème (car vous savez que les variables ne changeront pas), ou plus rarement, quand vous ne voulez pas que l'expression rationnelle remarque qu'elles changent.
Par exemple, voici un programme ``paragrep'' :
$/ = ''; # mode paragraphe
$pat = shift;
while (<>) {
print if /$pat/o;
}
perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c
marchera dans beaucoup de cas mais pas tous. Vous voyez, c'est un peu simplet pour certains types de programmes C, en particulier, ceux où des chaines protégées sont des commentaires. Pour cela, vous avez besoin de quelque chose de ce genre, créé par Jeffrey Friedl, modifié ultérieurement par Fred Curtis :
$/ = undef;
$_ = <>;
s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs;
print;
Cela pourrait, évidemment, être écrit plus lisiblement avec le modificateur "/x" en ajoutant des espaces et des commentaires. Le voici étendu, une courtoisie de Fred Curtis.
s{
/\* ## Début d'un commentaire /* ... */
[^*]*\*+ ## Non-* suivie par 1 ou plusieurs *
(
[^/*][^*]*\*+
)* ## 0 ou plusieurs choses ne commençant pas par /
## mais finissent par '*'
/ ## Fin d'un commentaire /* ... */
| ## OU diverses choses qui ne sont pas des commentairesE<nbsp>:
(
" ## Début d'une chaîne " ... "
(
\\. ## Caractère échappé
| ## OU
[^"\\] ## Non "\
)*
" ## Fin d'une chaîne " ... "
| ## OU
' ## Début d'une chaîne ' ... '
(
\\. ## Caractère échappé
| ## OU
[^'\\] ## Non '\
)*
' ## Fin d'une chaîne ' ... '
| ## OU
. ## Tout autre caractère
[^/"'\\]* ## Caractères ne débutant pas un commentaire,
## une chaîne ou un échappement
)
}{$2}gxs;
Une légère modification retire aussi les commentaires C++ :
s#/\*[^*]*\*+([^/*][^*]*\*+)*/|//[^\n]*|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#$2#gs;
Une sous-routine élaborée (pour du 7-bit ASCII seulement) pour extraire de simples caractères se correspondant et peut-être imbriqués, comme "`" et "'", "{" et "}", ou "(" et ")" peut être trouvée à http://www.perl.com/CPAN/authors/id/TOMC/scripts/pull_quotes.gz .
Le module C::Scan module du CPAN contient de telles sous routines pour des usages internes, mais elles ne sont pas documentées.
Un exemple:
$s1 = $s2 = "J'ai très très froid";
$s1 =~ s/tr.*s //; # J'ai froid
$s2 =~ s/tr.*?s //; # J'ai très froid
Notez que la seconde substitution arrête la reconnaissance dès qu'un ``s '' est rencontré. Le quantificateur "*?" dit effectivement au moteur des expressions régulières de trouver une reconnaissance aussi vite que possible et de passer le contrôle à la suite, comme de se refiler une patate chaude.
while (<>) {
foreach $word ( split ) {
# faire quelque chose avec $word ici
}
}
Notez que ce ne sont pas vraiment des mots dans le sens français ; ce sont juste des suites de caractères différents de l'espace.
Pour travailler avec seulement des séquences alphanumériques, vous pourriez envisager
while (<>) {
foreach $word (m/(\w+)/g) {
# faire quelque chose avec $word ici
}
}
while (<>) {
while ( /(\b[^\W_\d][\w'-]+\b)/g ) { # on rate "`mouton'"
$seen{$1}++;
}
}
while ( ($word, $count) = each %seen ) {
print "$count $word\n";
}
Si vous voulez faire la même chose avec les lignes, vous n'avez pas besoin d'une expression rationnelle :
while (<>) {
$seen{$_}++;
}
while ( ($line, $count) = each %seen ) {
print "$count $line";
}
Si vous voulez que le résultat soit trié, regardez la section sur les hachages.
# manière lente mais évidente
@popstates = qw(CO ON MI WI MN);
while (defined($line = <>)) {
for $state (@popstates) {
if ($line =~ /\b$state\b/i) {
print $line;
last;
}
}
}
C'est parce que Perl doit recompiler tous ces motifs pour chacune des lignes du fichier. À partir des versions 5.005, il existe une bien meilleure approche, utilisant le nouvel opérateur "qr//" :
# utilise le magnifique et tout neuf opérateur qr//, avec même le
# drapeau /i
use 5.005;
@popstates = qw(CO ON MI WI MN);
@poppats = map { qr/\b$_\b/i } @popstates;
while (defined($line = <>)) {
for $patobj (@poppats) {
print $line if $line =~ /$patobj/;
}
}
Voici des exemples d'utilisation incorrecte de "\b", avec les corrections :
"deux mots" =~ /(\w+)\b(\w+)/; # MAUVAIS "deux mots" =~ /(\w+)\s+(\w+)/; # bon
" =matchless= text" =~ /\b=(\w+)=\b/; # MAUVAIS " =matchless= text" =~ /=(\w+)=/; # bon
Quoiqu'ils peuvent ne pas faire ce que vous pensez qu'ils font, "\b" et "\B" peuvent être bien utiles. Pour un exemple d'utilisation correcte de "\b", regardez l'exemple de reconnaissance de mots dupliqués sur plusieurs lignes.
Un exemple d'utilisation de "\B" est le motif "\Best\B". Il trouvera les occurrences de ``est'' seulement à l'intérieur des mots, comme ``geste'', mais pas ``test'' ou ``estime''.
Par exemple, supposez que vous ayez une ligne de texte quotée dans un courrier standard avec la notation Usenet (c.-à-d., commençant par des ">"), et que vous vouliez changer chaque caractère de début ">" en ":". Vous pouvez ainsi faire :
s/^(>+)/':' x length($1)/gem;
Ou, en utilisant "\G", plus simple (et plus rapide) :
s/\G>/:/g;
Une utilisation plus sophistiquée peut entraîner un analyseur lexicographique. L'exemple suivant, à la lex, est de Jeffrey Friedl. Il ne marche pas avec la 5.003 à cause d'un bug dans cette version, mais est ok à partir de la 5.004. (Notez l'utilisation de "/c", qui, lorsqu'une reconnaissance avec "/g" échoue, empêche de remettre la position de recherche au début de la chaîne).
while (<>) {
chomp;
PARSER: {
m/ \G( \d+\b )/gcx && do { print "nombre: $1\n"; redo; };
m/ \G( \w+ )/gcx && do { print "mot: $1\n"; redo; };
m/ \G( \s+ )/gcx && do { print "espace: $1\n"; redo; };
m/ \G( [^\w\d]+ )/gcx && do { print "autre: $1\n"; redo; };
}
}
Bien sûr, cela pourrait avoir été écrit ainsi
while (<>) {
chomp;
PARSER: {
if ( /\G( \d+\b )/gcx {
print "nombre: $1\n";
redo PARSER;
}
if ( /\G( \w+ )/gcx {
print "mot: $1\n";
redo PARSER;
}
if ( /\G( \s+ )/gcx {
print "espace: $1\n";
redo PARSER;
}
if ( /\G( [^\w\d]+ )/gcx {
print "autre: $1\n";
redo PARSER;
}
}
}
Mais vous perdez l'alignement vertical des expressions régulières.
Supposons que vous ayez un codage de ces mystérieux Martiens où les paires de lettre majuscules ASCII codent une lettre simple martienne (i.e. les 2 octets ``CV'' donne une simple lettre martienne, ainsi que ``SG'', ``VS'', ``XX'', etc.). D'autres octets représentent de simples caractères comme l'ASCII.
Ainsi, la chaîne martienne ``Je suis CVSGXX!'' utilise 15 octets pour coder les 12 caractères 'J', 'e', ' ', 's', 'u', 'i', 's', ' ', 'CV', 'SG', 'XX', '!'.
Maintenant, vous voulez chercher le simple caractère "/GX/". Perl ne connaît rien au martien, donc il trouvera les 2 octets ``GX'' dans la chaîne ``Je suis CVSGXX!'', alors que ce carctère n'y est pas: il semble y être car ``SG'' est à côté de ``XX'', mais il n'y a pas de réel ``GX''. C'est un grand problème.
Voici quelques manières, toutes pénibles, de traiter cela :
$martian =~ s/([A-Z][A-Z])/ $1 /g; # assurer que les octets ``martiens''
# ne soient plus contigüs
print "GX trouvé!\n" if $martian =~ /GX/;
Ou ainsi :
@chars = $martian =~ m/([A-Z][A-Z]|[^A-Z])/g;
# c'est conceptuellemnt similaire à: @chars = $text =~ m/(.)/g;
#
foreach $char (@chars) {
print "GX trouvé!\n", last if $char eq 'GX';
}
Ou encore ainsi :
while ($martian =~ m/\G([A-Z][A-Z]|.)/gs) { # \G probablement inutile
print "GX trouvé!\n", last if $1 eq 'GX';
}
Ou encore ainsi :
die "désolé, Perl ne supporte pas (encore) le Martien )-:\n";
Il y a plusieurs double- (et multi-) octets codages couramment utilisés en ce moment. Plusieurs versions de ceux-ci ont des caractères de 1-, 2-, 3- et 4-octets, tous mélangés.
chomp($pattern = <STDIN>);
if ($line =~ /$pattern/) { }
Ou, puisque vous n'avez aucune garantie que votre utilisateur a entré une expression rationnelle valide, piégez l'exception de cette façon :
if (eval { $line =~ /$pattern/ }) { }
Mais si vous voulez seulement chercher une chaîne et non pas un motif, alors vous devriez soit utiliser la fonction index(), qui est faite pour cela, soit, s'il est impossible de vous convaincre de ne pas utiliser une expression rationnelle pour autre chose qu'un motif, assurez-vous au moins d'utiliser "\Q"..."\E", documenté dans perlre.
$pattern = <STDIN>;
open (FILE, $input) or die "Couldn't open input $input: $!; aborting";
while (<FILE>) {
print if /\Q$pattern\E/;
}
close FILE;
Lorsque ce travail est inclus comme un élément de la distribution standard de Perl, ou comme une partie de sa documentation complète sous forme imprimée ou autrement, il ne peut être distribué que dans les limites fixées par la Perl's Artistic License. Toute distribution de ce fichier ou de ses dérivés hors de cet ensemble nécessite un accord particulier avec le titulaire des droits.
Indépendemment de sa distribution, tous les exemples de code de ce fichier sont ici placés dans le domaine public. Vous êtes autorisés et encouragés à utiliser ce code dans vos programmes que ce soit pour votre plaisir ou pour un profit. Un simple commentaire dans le code précisant l'origine serait de bonne courtoisie mais n'est pas indispensable.