Multiple captures par regexp ?

Version imprimable

Bonjour à tous,

voilà mon petit souci. J'ai un fichier comportant sur chaque ligne un certain nombre de champs se suivant séparés par un espace et définis ainsi :
<NOM_CHAMP>:<VALEUR>
Je ne connais pas à l'avance les noms des champs, ni leur nombre. Les valeurs peuvent prendre à peu près n'importe quelle forme (alphanumérique, quelques symboles y compris espace et deux-points...).

Mon but est, vous l'aurez compris, de recréer un tableau plus classique à partir de ce fichier (au format type csv par exemple).

On peut prendre les règles suivantes quand même (pour simplifier un peu - voir script) :
1. pas de point-virgule ou de guillemets ou de caractères trop "chiants" =)
2. un nom de champ commence par une lettre et ne contient que des caractères alphanumériques ou underscore
3. conclusion de 1 & 2 : je repère chaque champ en trouvant un espace suivi d'une lettre éventuellement plusieurs caractères alphanumériques ou underscore et deux-points

J'ai réussi à faire un script qui fonctionne plutôt bien MAIS qui me pose problème au traitement du dernier champ de la ligne ^^ :
Code:

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 #!/usr/bin/perl use strict; open (FIC_E, "dsv.txt") or die ("dsv.txt : $!"); open (FIC_S, ">dsv.csv") or die ("dsv.csv : $!"); my $result; my @keys; my $nbrow=0; while (<FIC_E>) { my @matches = m/(?:([a-zA-Z]\w+)\:(?:(.*?)\s?)(?=[a-zA-Z]\w+\:))/g; next if ($#matches <= 0); for (my $i=0; $i <= $#matches+1; $i+=2) { push (@{$result->{$matches[$i]}}, $matches[$i+1]); push (@keys,$matches[$i]) if ($nbrow == 0); } if (/([a-zA-Z]\w+)\:$/) { push (@{$result->{$1}}, ""); push (@keys,$1) if ($nbrow == 0); } $nbrow++; } foreach my $key (@keys) { print FIC_S $key,";"; } print FIC_S "\n"; for (my $i=0; $i < $nbrow; $i++) { foreach my $key (@keys) { print FIC_S '"',$result->{$key}->[$i],'";'; } print FIC_S "\n"; } close FIC_E; close FIC_S;
La partie intéressante ici est bien entendu ma regexp :
Code:

1 2 3 4 5 #m/(?: # ([a-zA-Z]\w+)\: ==> définition d'un nom de champ : une lettre + alphanum ou underscore... # (?:(.*?)\s?) ==> capture des valeurs correspondantes : le \s? est là pour virer le dernier espace (oui, un champs peut n'être composé que d'espaces) # (?=[a-zA-Z]\w+\:) ==> je m'arrête quand je détecte un nouveau nom de champ #)/g
Il y a peut-être (sûrement) mieux ? Quoiqu'il en soit, ça marche bien comme je l'ai dit, sauf pour le dernier champ puisqu'il ne trouve pas de nouveau nom de champ à la suite :(

Exemple
mon entrée:
Code:

1 2 3 VAR:10 ID:0000000001 DATE: 2008-04-19 14:12:55 VAR: 1 ID: DATE: 2008-04-19 14:13:15 VAR:10 ID:0000000009 DATE: 2008-04-19 14:14:32
ma sortie:
Code:

1 2 3 4 VAR;ID; "10";"0000000001"; " 1";" "; "10";"0000000009";
ce que je voudrais:
Code:

1 2 3 4 VAR;ID;DATE; "10";"0000000001";" 2008-04-19 14:12:55"; " 1";" ";" 2008-04-19 14:13:15"; "10";"0000000009";" 2008-04-19 14:14:32";
merci =)

Si ton but n'est que d'écrire les données dans un fichier de sortie, à ta place, je ferai plus simple, je ne passerai pas par un tableau récupérant les résultats.

Code:

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
#!/usr/bin/perl
 
use strict;
use warnings;
 
 
# créations des filehandles
open my $fic_e, '<', 'dsv.txt' or die "dsv.txt : $!";
open my $fic_s, '>', 'dsv.csv' or die "dsv.csv : $!";
 
 
 
while (my $line = <$fic_e>) {
 
	# format des lignes à récupéréer
	# VAR:10 ID:0000000001 DATE: 2008-04-19 14:12:55
	if ($line =~ m/^\s*([A-Z]+)\:\s*(.*?)\s*([A-Z]+)\:\s*(.*?)\s*([A-Z]+)\:\s*(.*?)$/){
 
		# on imprime les entêtes au premier passage dans la boucle
		if ($. == 1){
			#VAR;ID;DATE;
			print $fic_s "$1;$3;$5;\n";
		}
		#"10";"0000000001";" 2008-04-19 14:12:55";
		print $fic_s qq{"$2";"$4";"$6";\n};	
	}
	else{
		warn $line;
	}
}
 
# fermeture des filehandles 
close $fic_e;
close $fic_s;

La sortie est bien :

Code:

1
2
3
"10";"0000000001";"2008-04-19 14:12:55";
" 1";"          ";"2008-04-19 14:13:15";
"10";"0000000009";"2008-04-19 14:14:32";

PS : j'ai volontairement supprimé l'espace devant la date mais tu peux facilement le récupérer via l'EXPREG si besoin est.

Voila pour le cas général avec un nombre variables de champs (je me suis rendue compte en relisant, que le problème était plus compliqué).
Code:

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 #!/usr/bin/perl use strict; use warnings; # créations des filehandles open my $fic_e, '<', 'dsv.txt' or die "dsv.txt : $!"; open my $fic_s, '>', 'dsv.csv' or die "dsv.csv : $!"; my @recup; while (my $line = <$fic_e>) { # format des lignes à récupéréer # VAR:10 ID:0000000001 DATE: 2008-04-19 14:12:55 while ( $line =~ m/([A-Z]+)\:\s?([^(:?A-Z+:)]+)/g){ # récupération des entêtes lors de la lecture # de la première ligne if($.==1){ print $fic_s "$1;"; } push ( @{$recup[$.]}, $2 ); } } # impression ligne par ligne for my $i (1..$#recup){ print $fic_s "\n"; map {print $fic_s qq{"$_";}} @{$recup[$i]}; } # fermeture des filehandles close $fic_e; close $fic_s;
Citation:

VAR;ID;DATE;
"10 ";"0000000001 ";"2008-04-19 14";
"1 ";" ";"2008-04-19 14";
"10 ";"0000000009 ";"2008-04-19 14";

Il reste un problème au niveau du dernier champ composé de 2 parties. Seule la première est récupérée.

Code:

$line =~ m/([A-Z]+)\:\s?([^(:?A-Z+:)]+)/g

Je voudrais que dans le second couple de parenthèses on récupère tout ce qui n'est pas un groupe de majuscules suivi de deux points ... l'ennui est que la négation porte soit sur un groupe de majuscules, soit sur deux points mais pas sur le groupement. La récupération de $2 s'arrête donc dès qu'on tombe sur un groupe de majuscules ou sur 2 points et non quand on rencontre des majuscules suivies de 2 points. Qui sait comment résoudre ce problème? Merci.

Alors, déjà, merci pour tes réponses : je n'ai pas tout relu, mais je vais jeter un oeil =)

Pour le moment, j'ai trouvé une solution toute conne hier soir : j'ai ajouté 2 petits caractères qui ont tout changé (enfin, 6 avec les parenthèses non capturantes :p) au niveau de la détection de la fin d'un champ !

J'ai modifié la regexp ainsi :
Code:

1 2 3 4 5 #m/(?: # ([a-zA-Z]\w+)\: ==> définition d'un nom de champ : une lettre + alphanum ou underscore... # (?:(.*?)\s?) ==> capture des valeurs correspondantes : le \s? est là pour virer le dernier espace (oui, un champs peut n'être composé que d'espaces) # (?=[a-zA-Z]\w+\:) ==> je m'arrête quand je détecte un nouveau nom de champ #)/g
Code:

1 2 3 4 5 #m/(?: # ([a-zA-Z]\w+)\: ==> définition d'un nom de champ : une lettre + alphanum ou underscore... # (?:(.*?)\s?) ==> capture des valeurs correspondantes : le \s? est là pour virer le dernier espace (oui, un champs peut n'être composé que d'espaces) # (?=(?:[a-zA-Z]\w+\:)|$)) ==> je m'arrête quand je détecte un nouveau nom de champ OU la fin de la ligne ! #)/g
J'ai aussi viré mon second test qui devait récupérer le dernier champ quand il était vide. Je vais regarder tes réponses (et ta question :p) : il y a encore des trucs que je ne connais pas (map, qq et $.). Merci encore

19/03/2009, 14h45
lennelei

Pour répondre à ta question Jasmine80, je ne vois rien d'autre que ce que j'ai utilisé : à savoir tout capturer jusqu'à ce qu'on rencontre des majuscules suivies de 2 points.

Code:

$line =~ m/([A-Z]+)\:\s?(.*?)(?=(?:[A-Z]+\:|$))/g

Je ne sais pas comment dire de capturer tout ce qui n'est pas majuscules suivies de 2 points, donc je lui demande de tout capturer jusqu'à trouver des majuscules suivies de 2 points...
19/03/2009, 15h26
Jasmine80

Ton problème est-il donc résolu?

Oui, toutes mes excuses si j'ai oublié de cliquer sur "résolu" et que quelqu'un l'a fait à ma place (je croyais l'avoir fait !).

Pour info, j'ai ces deux versions (la seconde étant inspirée de la version que tu avais proposée):

Code:

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
#!/usr/bin/perl
 
use strict;
use warnings;
 
open (FIC_E, "dsv.txt") or die ("dsv.txt : $!");
open (FIC_S, ">dsv.csv") or die ("dsv.csv : $!");
 
my $result;
my @keys;
my $nbrow=0;
 
#Traitement
while (<FIC_E>) {
	my @matches = m/(?:([a-zA-Z]\w+)\:(?:(.*?)\s?)(?=(?:[a-zA-Z]\w+\:)|$))/g;
 
	next if ($#matches <= 0);
	for (my $i=0; $i <= $#matches; $i+=2) {
		push (@{$result->{$matches[$i]}}, $matches[$i+1]);
		push (@keys,$matches[$i]) if ($nbrow == 0);
	}
 
	$nbrow++;
}
 
foreach my $key (@keys) {
	print FIC_S $key,";";
}
for (my $i=0; $i < $nbrow; $i++) {
	print FIC_S "\n";
	foreach my $key (@keys) {
		print FIC_S qq{"$result->{$key}->[$i]";};
	}
}
 
close FIC_E;
close FIC_S;

Code:

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
#!/usr/bin/perl
 
use strict;
use warnings;
 
open (FIC_E, "dsv.txt") or die ("dsv.txt : $!");
open (FIC_S, ">dsv.csv") or die ("dsv.csv : $!");
 
my @result;
my $nbrow=0;
 
#Traitement
while (<FIC_E>) {
	next if (!/(?:([a-zA-Z]\w+)\:(?:(.*?)\s?)(?=(?:[a-zA-Z]\w+\:)|$))/g);
	do {
		print FIC_S "$1;" if ($nbrow == 0);
		push (@{$result[$nbrow]}, $2);
	} while (/(?:([a-zA-Z]\w+)\:(?:(.*?)\s?)(?=(?:[a-zA-Z]\w+\:)|$))/g);
	$nbrow++;
}
 
for my $i (0..$#result) {
	print FIC_S "\n";
	map {print FIC_S qq{"$_";}} @{$result[$i]};
}
 
close FIC_E;
close FIC_S;

Je pense qu'il y aurait pas mal d'améliorations à faire ^^

à savoir que dans le fichier d'entrée, il y a plusieurs lignes avant les lignes de données que je dois sauter (d'où l'utilisation du $nbrow à la place de ton $. que je ne connaissais pas !). Je suis aussi bien content d'avoir découvert map et qq :D Merci !

24/03/2009, 10h32
Jasmine80
Juste une remarque, ouvrir les fichiers de cette façon
Code:

1 2 3 # créations des filehandles open my $fic_e, '<', 'dsv.txt' or die "dsv.txt : $!"; open my $fic_s, '>', 'dsv.csv' or die "dsv.csv : $!";
...est préférable à cette façon
Code:

1 2 open (FIC_E, "dsv.txt") or die ("dsv.txt : $!"); open (FIC_S, ">dsv.csv") or die ("dsv.csv : $!");
Perl Best Practice Chapter 10 'I/O'

p202 Don't use bareword filehandles.

p207 'Opening Cleanly' Use either the IO::File module or the three-argument form of open()

Citation:

Using a three-argument open ensures that the specified opening mode can never be subverted by bizarre filenames, since the second argument now specified only the opening mode, and the filename is supplied separately and doesn't have to be decoded at all.
And, as a small side-benefit, each open becomes visually more explicit about the intended mode of the resulting filehandle, which improves the readability oth the resulting code slightly.

Don't use bareword filehandles.

Perl Best Practice
25/03/2009, 09h32
lennelei

Merci pour ces éléments... j'adore Perl, mais je dois avouer que les multiples possibilités qui sont offertes à chaque fois ont de quoi dérouter ^^

J'ai essayé de lire un peu le lien vers ton autre post (sur les BAREWORD), mais je trouve ça passablement obscur :aie:

Un jour, si j'ai le temps, j'essaierais de me plonger dans les méandres du fonctionnement, en attendant, comme tu le dis, je vais essayer d'appliquer les consignes. :king:

Edit question idiote: tu as retiré les parenthèses, c'est voulu (best practice inside) ou c'est une habitude de ta part ? :)
25/03/2009, 10h10
Jasmine80

Citation:

Envoyé par Alek-C

Edit question idiote: tu as retiré les parenthèses, c'est voulu (best practice inside) ou c'est une habitude de ta part ? :)

C'est également un conseil de ce livre, pour les fonctions 'built in', il est conseillé de ne pas utiliser de parenthèses. n°4
25/03/2009, 23h01
Jedai

Citation:

Envoyé par Alek-C

Edit question idiote: tu as retiré les parenthèses, c'est voulu (best practice inside) ou c'est une habitude de ta part ? :)

C'est une question de style, mais la suggestion de PBP est une bonne idée (sauf si ça te révolte vraiment).

Citation:

Merci pour ces éléments... j'adore Perl, mais je dois avouer que les multiples possibilités qui sont offertes à chaque fois ont de quoi dérouter ^^

Certes, mais cela offre également beaucoup de flexibilité et de puissance, si tu veux quelques guides, je te conseille vraiment le livre "Perl Best Practices".

--
Jedaï