Comment puis-je lire un motif personnalisé à partir d'un fichier en Perl?

Question

Nouvel an Advance souhaite à tous.

J'ai un fichier journal d'erreurs avec le contenu dans un paramètre de modèle, résultat et stderr (stderr peut être sur plusieurs lignes).

$cat error_log 

<parameter>:test_tot_count 
<result>:1 
<stderr>:Expected "test_tot_count=2" and the actual value is 3 
test_tot_count = 3 
<parameter>:test_one_count 
<result>:0 
<stderr>:Expected "test_one_count=2" and the actual value is 0 
test_one_count = 0 
<parameter>:test_two_count 
<result>:4 
<stderr>:Expected "test_two_count=2" and the actual value is 4 
test_two_count = 4 
... 

J'ai besoin d'écrire une fonction en Perl pour stocker chaque paramètre, de résultat et stderr dans une table de tableau ou de hachage.

Ceci est notre propre structure définie en interne. J'ai écrit la fonction Perl comme ça. Existe-t-il une meilleure façon de le faire en utilisant l'expression régulière elle-même?

my $err_msg = ""; 
while (<ERR_LOG>) 
{ 
    if (/<parameter>:/) 
    { 
     s/<parameter>://; 
     push @parameter, $_; 
    } 
    elsif (/<result>:/) 
    { 
     s/<result>://; 
     push @result, $_; 
    } 
    elsif (/<stderr>:/) 
    { 
     if (length($err_msg) > 0) 
     { 
      push @stderr, $err_msg; 
     } 
     s/<stderr>://; 
     $err_msg = $_; 
    } 
    else 
    { 
     $err_msg .= $_; 
    } 
} 
if (length($err_msg) > 0) 
{ 
    push @stderr, $err_msg; 
} 

Answer 1

Si vous utilisez Perl 5.10, vous pouvez faire quelque chose de très semblable à ce que vous avez maintenant, mais avec beaucoup plus agréable mise en page en utilisant la donnée/lorsque la structure:

use 5.010; 

while (<ERR_LOG>) { 
    chomp; 
    given ($_) { 
     when (m{^<parameter>: (.*)}x) { push @parameter, $1  } 
     when (m{^<result>: (.*)}x) { push @result, $1  } 
     when (m{^<stderr>: (.*)}x) { push @stderr, $1  } 
     default       { $stderr[-1] .= "\n$_" } 
    } 
} 

Il convient de noter que, pour le cas par défaut ici, plutôt que de garder une variable séparée err_msg de $ , Je pousse simplement sur @stderr quand je vois un stderr et en ajoutant le dernier élément du tableau @stderr si je vois une ligne de continuation. J'ajoute une nouvelle ligne quand je vois des lignes de continuation, puisque je suppose que vous les voulez préservées.

Malgré le code ci-dessus à la recherche assez élégant, je ne suis pas vraiment tout ce qui aime garder trois tableaux distincts, car il sera probablement vous causer des maux de tête si les choses se décalaient, et parce que si vous voulez ajouter plus Dans le futur, vous vous retrouverez avec beaucoup de variables flottantes dont vous aurez besoin de suivre. Je vous suggère de stocker chaque enregistrement dans un hachage, puis garder un tableau d'enregistrements:

use 5.010; 

my @records; 

my $prev_key; 

while (<ERR_LOG>) { 
    chomp; 
    given ($_) { 
     when (m{^<parameter> }x) { push(@records, {}); continue;   } 
     when (m{^<(\w+)>: (.*)}x) { $records[-1]{$1} = $2; $prev_key = $1; } 
     default      { $records[-1]{$prev_key} .= "\n$_";  } 
    } 
} 

Ici, nous sommes en poussant un nouveau record sur le tableau quand on voit un champ, en ajoutant une entrée à notre hachage chaque fois nous voyons une paire clé/valeur, et nous ajoutons au dernier champ auquel nous avons ajouté si nous voyons une ligne de continuation. Le résultat final de @records ressemble à ceci:

(
    { 
     parameter => 'test_one_count', 
     result => 0, 
     stderr => qq{Expected "test_one_count=2" and the actual value is 0\ntest_one_count=0}, 
    }, 
    { 
     parameter => 'test_two_count', 
     result => 4, 
     stderr => qq{Expected "test_two_count=2" and the actual value is 4\ntest_two_count=4}, 
    } 
) 

Maintenant, vous pouvez passer une seule structure de données autour de laquelle contient tous vos dossiers, et vous pouvez ajouter des champs à l'avenir (même multi-lignes) et ils seront correctement traités.

Si vous n'utilisez pas Perl 5.10, alors cela peut être une bonne excuse pour mettre à niveau. Sinon, vous pouvez traduire les structures données/quand en structures plus traditionnelles if/elsif/else, mais elles perdent beaucoup de leur beauté dans la conversion.

Paul

Answer 2

Très belle apparence. =) Une amélioration est probablement d'ancrer ces balises au début de la ligne:

if (/^<parameter>:/) 

Il va faire le script un peu plus robuste.

Vous pouvez également éviter le décapage de l'étiquette si vous voyez ce qui est après et utilisez seulement cette partie:

if (/^<parameter>:(.*)/s) 
{ 
    push @parameter, $1; 
} 

Answer 3

La principale chose qui saute pour refactoring est la répétition dans la mise en correspondance, le décapage et stocker. Quelque chose comme ce code (non testé) est plus concis:

my($err_msg , %data); 

while (<ERR_LOG>) { 
    if((my $key) = $_ =~ s/^<(parameter|result|stderr)>://) { 
    if($key eq 'stderr') { 
     push @{ $data{$key} } , $err_msg if $err_msg; 
     $err_msg = $_; 
    } 
    else { push @{ $data{$key} } , $_ } 
    } 
    else { $err_msg .= $_ } 
} 

# grab the last err_msg out of the hopper 
push @{ $data{stderr} } , $err_msg; 

... mais il peut être plus difficile à comprendre six mois à partir de maintenant ... 8 ^)