Discussion :

[ptonnerre]

Bonjour,

à des fins de purges, j'utilise un fichier de configuration contenant des motifs d'expressions régulières.

Le motif suivant me permet de sélectionner tous les fichiers de /tmp sauf ceux commençant par oracle et se terminant par tmp ou lck :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

/tmp;^(?!oracle.+(tmp|lck)$)

A l'aide d'une expression régulière, je dois maintenant sélectionner tous les fichiers sauf ceux matchant un des trois motifs suivants : les fichiers commençant par CVU et se terminant par oracle, ceux commençant parOraInstall et se terminant par PM et enfin, ceux commençant vindexing

Je n'y arrive pas et tourne un peu en rond

Merci pour votre aide

[Lolo78]

Bonjour,

fais-le avec plusieurs regex successives, c'est bien plus simple (et bien plus clair). Par exemple, en supposant que ta liste de fichier d'origine figure dans @input files (pas testé):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
my @selected = grep { not (/^CVU.*?oracle$/ } grep { not /^OraInstall.*?PM$/ } grep { not /^vindexing/ } @input files;

Ou bien dans une boucle for:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
for (@input files) {
    next if /^CVU.*?oracle$/;
    next if /^OraInstall.*?PM$/ 
    next if /^vindexing/ ;
    # maintenant faire quelque chose avec $_
}

Ou bien:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
for (@input files) {
    next if /^CVU/ and /oracle$/;
    next if /^OraInstall/ and /PM$/ 
    next if /^vindexing/ ;
    # maintenant faire quelque chose avec $_
}

On peut aussi combiner les trois regex avec des opérateurs booléens:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
my @selected = grep { not (/^CVU.*?oracle$/ or /^OraInstall.*?PM$/ or /^vindexing/) } @input files;

Ou bien, si tu veux vraiment une seule regex, tu peux essayer d'utiliser une alternative dans la regex:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
my @selected = grep { not /^CVU.*?oracle$|OraInstall.*?PM$|^vindexing/ }  @input files;

Je n'ai pas testé, il y a peut-être une faute de frappe ou une erreur ici ou là, mais je pense que tu vois l'idée. Des regex distinctes, c'est plus simple à écrire et, surtout, plus simple à relire et à comprendre. Et, dans beaucoup de cas, c'est même plus rapide (en particulier si tu filtres d'abord le cas le plus fréquent).

[ptonnerre]

Bonjour Laurent,

merci pour ces éléments de réponse.

Ce programme de purges centralisées est en production depuis début 2016 et s'appuie sur le fichier de configuration cité pour faire son job sur des serveurs distants (Aix, Linux, Windows).
Un champ de ce fichier contient l'expression régulière à utiliser (cf ^(?!oracle.+(tmp|lck)$) )
Je ne peux pas modifier ce programme pour le moment d'où mon besoin d'écrire une expression régulière unique me permettant d'exclure 2 ou n motifs de fichiers

L'expression régulière utilisée pour définir la liste des fichiers est utilisée par ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
sub init_purge_list {
    my ( $mnt, $host, $pattern, $age, $flag_regex, $flag_recur ) = @_;

    my $err = 0;
    my $d = $mnt . '/' . $host;

    $pattern = qr/$pattern/ if $flag_regex;

    my $rule = File::Find::Rule->new;
    $rule->or($rule->new
                   ->directory
                   ->name(qr/lost\+found|controle/)
                   ->prune
                   ->discard,
              $rule->new);
    $rule->file;
    $rule->maxdepth('1') if $flag_recur eq '0';
    $rule->name($pattern);   # <=== utilisation de la regex

    $rule->exec( sub { -M $_ > $age } );

    my @files = $rule->in( $d );

    return ( $err, \@files, scalar @files );
}

[dmganges]

Bonjour,

As-tu testé la dernière proposition de Lolo78 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

/^CVU.*?oracle$|OraInstall.*?PM$|^vindexing/

Je l'ai testée vite fait avec les moyens du bord, elle semble fonctionner parfaitement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
#!/usr/bin/perl 
use warnings; 
use strict; 
 
my $PatternFic = '^CVU.*?oracle$|OraInstall.*?PM$|^vindexing';
my $repertoire = 'E:/_DEV/Developpez/ptonnerre/Fic'; 
foreach my $fichier ( lister_fichiers( $repertoire, 1 ) ) { 
  print "Fichier : $fichier\n"; 
} 
 
#====================================================== 
# Nombre d'arguments : 1 ou 2 
# Argument(s)        : un répertoire et valeur 0 ou 1 
# Retourne           : Tableau de fichier (@fichiers)
# ORIGINE = https://perl.developpez.com/faq/perl/?page=Fichiers-et-repertoires#Comment-lister-les-fichiers-d-un-repertoire
#====================================================== 
sub lister_fichiers { 
  my ( $repertoire, $recursivite ) = @_; 
 
  require Cwd; 
  require File::Spec; 
 
  my $cwd = Cwd::getcwd(); 
 
  # Recherche dans les sous-répertoires ou non 
  if ( ( not defined $recursivite ) || ( $recursivite != 1 ) ) { $recursivite = 0; } 
 
  # Verification répertoire 
  if ( not defined $repertoire ) { die "Aucun repertoire de specifie\n"; } 
 
  # Ouverture d'un répertoire 
  opendir my $fh_rep, $repertoire or die "impossible d'ouvrir le répertoire $repertoire\n"; 
 
  # Liste fichiers et répertoire sauf (. et ..) 
  my @fic_rep = grep { !/^\.\.?$/ } readdir $fh_rep; 
 
  # Fermeture du répertoire 
  closedir $fh_rep or die "Impossible de fermer le répertoire $repertoire\n"; 
 
  chdir $repertoire; 
  $repertoire = Cwd::getcwd(); 
 
  # On récupère tous les fichiers 
  my @fichiers; 
  foreach my $nom (@fic_rep) { 
    my $notre_fichier = File::Spec->catfile( $repertoire, $nom );
 
    if ( -f "$repertoire/$nom") {
			my ($Fic, $Ext) = split (/\./,$nom);
		#	next if ($Fic =~ /$PatternFic/ );
 
  	}
 
    if ( -f $notre_fichier ) { 
      push @fichiers, $notre_fichier; 
    } 
    elsif ( -d $notre_fichier and $recursivite == 1 ) { 
      push @fichiers, lister_fichiers($notre_fichier, $recursivite);    # recursivité 
    } 
  } 
 
  chdir $cwd; 
 
  return @fichiers; 
}

avec ou sans commentaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

#	next if ($Fic =~ /$PatternFic/ );

[ptonnerre]

Bonsoir à vous deux et merci pour les réponses,

As-tu testé la dernière proposition de Lolo78 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

/^CVU.*?oracle$|OraInstall.*?PM$|^vindexing/

non, on m'a mis sur autre chose et je ne pourrai tester qu'à partir de lundi, à moins de trouver quelques minutes de libre.
Je ne peux pas modifier le programme en production pour l'instant et ma regex doit pouvoir écarter les fichiers lorsqu'elle est traitée par le module File::find par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

$rule->name($pattern);

Je suis coincé à cette utilisation pour le moment :-/
Ta regex va sélectionner les fichiers et non les écarter si je ne me trompe pas.

[Lolo78]

Bonsoir,

je pense que quelque chose selon les lignes suivantes devrait marcher, en utilisant des assertions négatives de longueur nulle et des alternatives.

Avec les données suivantes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
acccz
acccw
bcccz
bccccw

je veux écarter les mots qui commencent par a et finissent par z, ainsi que ceux qui commencent par b et finissent par w.

Voici mon test sous le débugger:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
  DB<1>  @a = qw / acccz acccw bcccz bccccw/;
 
  DB<2> print "$_\n" for grep { /^(?!(a.+z)|(b.+w)$)/   } @a
acccw
bcccz
 
  DB<3>

Ce serait sans doute plus lisible en utilisant le modificateur x (que tu dois pouvoir mettre dans les motifs de ton fichier de config, j'imagine):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
  DB<3> print "$_\n" for grep { /^( ?! (a.+z) | (b.+w)$ )/x   } @a
acccw
bcccz

A noter que File::Find::Rule admet aussi une liste de motifs, il y a peut-être une solution à envisager. Mais il semble dans ce cas faire un ou entre les motifs, alors que tu voudrais peut-être un et entre les motifs; il y a peut-être moyen de s'en sortir avec une solution du même type que ci-dessus, mais je n'ai pas le temps de tester maintenant.

[dmganges]

Bonjour,

Je suis coincé à cette utilisation pour le moment :-/
Ta regex va sélectionner les fichiers et non les écarter si je ne me trompe pas.

Oui le next dans le programme inverse la sélection

Comme j'ai le temps de tester avant que les poules ne se lèvent...
En appliquant la proposition de Lolo78 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

print "$_\n" for grep { /^(?!(a.+z)|(b.+w)$)/   } @a

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
#!/usr/bin/perl 
use warnings; 
use strict;
 
# TOUJOURS Selon l'idée de Lolo78
#print "$_\n" for grep { /^(?!(a.+z)|(b.+w)$)/   } @a
 
# Ne sélectionne pas
my $PatternFic = '^(?!(CVU.*?oracle$)|(OraInstall.*?PM$)|(^vindexing))';
 
# Alors qu'effectivement celle-ci sélectionne
#my $PatternFic = '^CVU.*?oracle$|OraInstall.*?PM$|^vindexing';
 
# MAIS LE 
# next if ($Fic =~ /$PatternFic/ );
# INVERSE l'assertion ci-dessus
 
my $repertoire = 'E:/_DEV/Developpez/ptonnerre/Fic';
 
print "TOUJOURS Selon la proposition de Lolo78\nEn commentant l'un ou l'autre PatternFic\n\n";
 
foreach my $fichier ( lister_fichiers( $repertoire, 1 ) ) {
  print "Fichier : $fichier\n"; 
} 
 
#====================================================== 
# Nombre d'arguments : 1 ou 2 
# Argument(s)        : un répertoire et valeur 0 ou 1 
# Retourne           : Tableau de fichier (@fichiers)
# ORIGINE = https://perl.developpez.com/faq/perl/?page=Fichiers-et-repertoires#Comment-lister-les-fichiers-d-un-repertoire
#====================================================== 
sub lister_fichiers { 
  my ( $repertoire, $recursivite ) = @_; 
 
  require Cwd; 
  require File::Spec; 
 
  my $cwd = Cwd::getcwd(); 
 
  # Recherche dans les sous-répertoires ou non 
  if ( ( not defined $recursivite ) || ( $recursivite != 1 ) ) { $recursivite = 0; } 
 
  # Verification répertoire 
  if ( not defined $repertoire ) { die "Aucun repertoire de specifie\n"; } 
 
  # Ouverture d'un répertoire 
  opendir my $fh_rep, $repertoire or die "impossible d'ouvrir le répertoire $repertoire\n"; 
 
  # Liste fichiers et répertoire sauf (. et ..) 
  my @fic_rep = grep { !/^\.\.?$/ } readdir $fh_rep; 
 
  # Fermeture du répertoire 
  closedir $fh_rep or die "Impossible de fermer le répertoire $repertoire\n"; 
 
  chdir $repertoire; 
  $repertoire = Cwd::getcwd(); 
 
  # On récupère tous les fichiers 
  my @fichiers; 
  foreach my $nom (@fic_rep) { 
    my $notre_fichier = File::Spec->catfile( $repertoire, $nom );
 
    if ( -f "$repertoire/$nom") {
			my ($Fic, $Ext) = split (/\./,$nom);
			next if ($Fic =~ /$PatternFic/ );
 
  	}
 
    if ( -f $notre_fichier ) { 
      push @fichiers, $notre_fichier; 
    } 
    elsif ( -d $notre_fichier and $recursivite == 1 ) { 
      push @fichiers, lister_fichiers($notre_fichier, $recursivite);    # recursivité 
    } 
  } 
 
  chdir $cwd; 
 
  return @fichiers; 
}

Les deux regex semblent bien complémentaires :

[ptonnerre]

Merci pour votre aide, je teste ça ASAP et vous tiens au courant.

[CosmoKnacki]

Moi je l'écrirais:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

^(?!CVU.*oracle$|OraInstall.*PM$|vindexing)

Sans groupes de captures, sans l'ancre redondante ^ devant vindexing et avec des quantificateurs gourmands (puisque la contrainte est en fin de chaîne autant utiliser le backtracking.)

[ptonnerre]

Bonjour,

vos solutions fonctionnent, exemple de motif pour écarter les fichiers commençant par xfile, yfile zfile ou ceux se terminant par 1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $pattern = qr/^(?!xfile.+|yfile.+|zfile.+|.+1$)/

ou

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $pattern = qr/^(?!(xfile.+)|(yfile.+)|(zfile.+)|(.+1$))

Je n'ai jamais utilisé les assertions négatives et suis preneur de quelques explications ou d'un pointeur sur le sujet.

Un grand à vous pour votre aide précieuse

[ptonnerre]

pointeur sur le sujet.

J'ai trouvé ce lien qui me semble pas mal.
Si vous avez d'autres sources, je suis preneur.

[CosmoKnacki]

Je viens de jeter un œil sur les tutoriels de la section Perl et malheureusement le tutoriel dédié aux expressions régulières n'aborde pas les assertions avant et arrière (lookahead, lookbehind) qu'elles soient négatives ou pas. Je crois qu'il y a des exemples dans le tutoriel de Guillaume Rossolini qui est assez pédagogique en section PHP.

Sinon en bref:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
(?=...)  la position courante est suivie de ...
(?!...)  la position courante n'est pas suivie de ...
(?<=...) la position courante est précédée de ...
(?<!...) la position courante n'est pas précédée de ...

Comme tu peux le constater, ces assertions décrivent ce qu'il doit y avoir ou ne doit pas y avoir dans une chaîne avant ou après la position de l'assertion.

Pour la chaîne abc:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
a(?=b)  vrai
a(?!b)  faux
a(?=c)  faux
a(?!c)  vrai
 
(?<=b)c vrai
(?<!b)c faux
(?<=a)c faux
(?<!a)c vrai

Ces assertions ne consomment pas de caractères (on dit aussi qu'elles ont une largeur nulle):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
a(?=b)b  vrai
a(?=b)c  faux
a(?!c)b  vrai
 
ab(?<=b)c vrai
a(?<=b)c faux
a(?<!c)b vrai

Ces assertions peuvent contenir n'importe quelle pattern. La seule limitation concerne les tests arrières qui doivent contenir une pattern de longueur fixe. Concrètement tu ne peux pas utiliser de quantificateur (* + ? {m,n} {n}) ni d'alternative (a|bb|ccc) ni de référence à un groupe de capture (car la longueur de la capture n'est pas établie) dans un test arrière positif ou négatif:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
correct:
(?=a.*c)
(?!a.*c)
(?=a{1,5})
(?=a|b|c)
(a)(?=\1)
 
incorrect: (provoquera une erreur)
(?<=a.*c)
(?<!a.*c)
(?<=a{1,5})
(?<=a|b|c)
(a)(?<=\1)

Les astuces pour pallier à cette limitation sont diverses et variées mais pas miraculeuses. La première consiste d'éviter le test arrière en écrivant "normalement" ce qui vient avant et en utilisant un groupe de capture pour extraire ce que l'on cherche vraiment. Donc au lieu d'écrire (?<=pat1)pat2 on écrit pat1(pat2) et on extrait $1. On peut aussi utiliser \K qui déplace la position de début du résultat pat1\Kpat2 ($& ne contiendra que ce qui correspond à pat2). Mais pour ces deux méthodes, les caractères de pat1 seront néanmoins consommés.
Pour ce qui est des alternatives par contre, rien n'empêche d'écrire (?:(?<=a)|(?<=b)|(?<=c)).
À noter sur ce dernier point une petite différence avec PCRE (le moteur utilisé par php notamment) qui autorise (?<=pat1|pat2|pat3|...) si chacune des alternatives est de taille fixe.



Pour allez plus loin, une autre particularité, ces assertions sont naturellement atomiques (une fois la parenthèse close, le moteur de regex ne peut plus faire de retour arrière dans la sous pattern (backtracking) pour tester une autre possibilité. D'où le truc bien connu (en Javascript et en Python) pour émuler un groupe atomique (?>pattern) en utilisant un test avant un groupe de capture et une référence arrière: (?=(pattern))\1.
Ce qui ne sert strictement à rien en Perl vu que les groupes atomiques existent déjà.

Une autre source intéressante: rexegg.com (en anglais)

[ptonnerre]

Merci à tous, on peut clore le fil.

[Lolo78]

Bonjour,
voici une documentation supplémentaire sur les assertions de largeur nulle: la section Lookaround Assertions du chapitre: https://perldoc.perl.org/perlre.html#Extended-Patterns de la documentation officielle Perl sur les expressions régulières.