2012-03-02 15 views
5

Dado un archivo de entrada de gran tamaño que se parece a esto:Cómo escribir esto mejor en Perl

02/26/2012 08:54:38 Error:java.sql.Exception 
02/26/2012 08:54:48 Error:java.sql.Exception 
02/26/2012 08:56:05 Error:java.sql.Exception 
02/26/2012 08:57:21 Error:java.sql.Exception 
02/26/2012 08:59:29 Error:java.sql.Exception 
02/26/2012 09:01:14 Error:java.sql.Exception 
02/26/2012 09:08:48 Error:java.sql.Exception 
02/26/2012 09:10:41 Error:java.sql.Exception 

que estoy tratando de averiguar el recuento de errores por hora; es decir, Busco a un archivo de salida que tiene este aspecto:

02/26/2012 08 -> 5 
02/26/2012 09 -> 3 

Aquí es un script que está trabajando para mí:

#!/bin/perl 
open(MYFILE, 'tata2'); 
my %table; 
while (<MYFILE>) { 
    chomp; 
    $dtkey = substr $_, 0, 13; 
    $table{$dtkey}++; 
} 
close(MYFILE); 
for my $key (keys %table) { 
    print "$key -> $table{$key}\n"; 
} 

embargo, dada las características de Perl, estoy bastante seguro de que esto puede hacerse en menos líneas. Le agradecería mucho si puede proporcionar algunos ejemplos. Espero que sea útil para aquellos que quieran reducir las líneas de código escritas para lograr algo.

+2

'use strict; use advertencias; ' – Ether

+3

No Perl, pero' sed 's /:.*//' | uniq -c' –

Respuesta

6

Lo que tienes ya es bastante corto. Puede mejorar un poco las cosas usando manejadores de archivos léxicos y verificando el valor de retorno de open.

Aquí es una reescritura utilizando algunos de otras características sintácticas de Perl:

open my $fh, '<', 'filename' or die $!; 
my %table; 

while (<$fh>) { 
    $table{$1}++ if /([^:]+)/ # regex is a bit shorter than the substr 
} 

print "$_ -> $table{$_}\n" for keys %table; # statement modifier form 

O si realmente quiere ser breve, ¿qué tal un chiste:

perl -lnE '$t{$1}++ if /([^:]+)/; END {say "$_ -> $t{$_}" for keys %t}' infile 
+0

limpio! - aceptará tu respuesta si nadie publica algo mejor. –

+3

En lugar de 'END', puede usar el operador esquimal kiss. '} {say ... keys% t''. – TLP

+2

No estoy seguro si es mejor/más corto/más legible, pero aquí hay uno que usa autosplit en dos puntos y el operador esquimal: 'perl -F: -lanwe '$ a {$ F [0]} ++; } {print "$ _ -> $ a {$ _}" para las claves% a 'infile' – TLP

2

Usted puede hacer uso efectivo de named capture groups, una nueva característica desde la versión 5.10, para que su patrón exprese mejor su intención y produzca resultados correctamente ordenados.

Puede prescindir por completo de los números y crear grupos de captura con nombre. La notación es (?<name>...) para declarar y \g{name} a la referencia. (Para ser compatible con las expresiones regulares .NET, \g{name} también se puede escribir como \k{name}, \k<name> o \k'name'). nombre no debe comenzar con un número, ni contener guiones. Cuando diferentes grupos dentro del mismo patrón tienen el mismo nombre, cualquier referencia a ese nombre asume el grupo definido más a la izquierda. Los grupos con nombre cuentan en numeración absoluta y relativa, y también pueden ser referidos por esos números. (Es posible hacer las cosas con los grupos de captura con nombre que de otro modo requerirían (??{}).) Contenidos en grupos

de captura están en el ámbito de forma dinámica y su disposición fuera del patrón hasta el final del bloque que lo contiene o hasta la siguiente persona compatible, lo que ocurra primero. (Ver las declaraciones compuestas en perlsyn.) Puede consultarlas por número absoluto (usando $1 en lugar de \g1, etc.); o por su nombre a través del %+ hash, usando $+{name}.

Para cada línea de entrada, busque una coincidencia pero permute los componentes a YYYY/MM/DD HH para ordenarlos fácilmente.

#! /usr/bin/env perl 

use strict; 
use warnings; 

use 5.10.0; # named capture buffers 

*ARGV = *DATA; # for demo only; remove for real use 

my %hour_errors; 
while (<>) { 
    $hour_errors{"$+{y}/$+{m}/$+{d} $+{h}"}++ 
    if m!^ (?<m> \d+)/(?<d> \d+)/(?<y> \d+) \s+ (?<h> \d+) :!x; 
} 

print "$_ -> $hour_errors{$_}\n" for sort keys %hour_errors; 

__DATA__ 
02/26/2012 08:54:38 Error:java.sql.Exception 
02/26/2012 08:54:48 Error:java.sql.Exception 
02/26/2012 08:56:05 Error:java.sql.Exception 
02/26/2012 08:57:21 Error:java.sql.Exception 
02/26/2012 08:59:29 Error:java.sql.Exception 
02/26/2012 09:01:14 Error:java.sql.Exception 
02/26/2012 09:08:48 Error:java.sql.Exception 
02/26/2012 09:10:41 Error:java.sql.Exception 

Salida:

2012/02/26 08 -> 5 
2012/02/26 09 -> 3
1

substr es más eficiente que regex si lo que importa. Si tiene acceso a CPAN, la ordenación se puede eliminar con Tie :: IxHash, que internamente mantiene las claves en orden de inserción (pero aún así es un hash). (Agregué algunas filas más que ilustran el problema de clasificación.)

use Tie::IxHash; 
tie my %table, 'Tie::IxHash'; 
$table{substr $_, 0, 13}++ while <DATA>; 
print "$_ -> $table{$_}\n" for keys %table; 
__DATA__ 
02/26/2012 09:10:41 Error:java.sql.Exception 
02/26/2012 08:54:38 Error:java.sql.Exception 
02/26/2012 08:54:48 Error:java.sql.Exception 
02/26/2012 08:56:05 Error:java.sql.Exception 
02/26/2012 08:57:21 Error:java.sql.Exception 
02/26/2012 08:59:29 Error:java.sql.Exception 
02/26/2012 09:01:14 Error:java.sql.Exception 
02/26/2012 09:08:48 Error:java.sql.Exception 
02/26/2012 09:10:41 Error:java.sql.Exception 
03/26/2012 08:54:38 Error:java.sql.Exception 
03/26/2012 08:54:48 Error:java.sql.Exception 
03/26/2012 08:56:05 Error:java.sql.Exception 
03/26/2012 08:57:21 Error:java.sql.Exception 
03/26/2012 08:59:29 Error:java.sql.Exception 
03/26/2012 09:01:14 Error:java.sql.Exception 
03/26/2012 09:08:48 Error:java.sql.Exception 
04/26/2012 08:54:38 Error:java.sql.Exception 
04/26/2012 08:54:48 Error:java.sql.Exception 
04/26/2012 08:56:05 Error:java.sql.Exception 
04/26/2012 08:57:21 Error:java.sql.Exception 
04/26/2012 08:59:29 Error:java.sql.Exception 
04/26/2012 09:01:14 Error:java.sql.Exception 
04/26/2012 09:08:48 Error:java.sql.Exception 
04/26/2012 09:10:41 Error:java.sql.Exception 

Si usted no tiene acceso a Tie :: IxHash entonces aquí es una versión corta con una especie de las claves que se repiten (menos DATOS).

my %table; 
$table{substr $_, 0, 13}++ while <DATA>; 
print "$_ -> $table{$_}\n" for sort { "@{[($a=~/(\d+)\D?/g)[2,1,0,3]]}" cmp "@{[($b=~/(\d+)\D?/g)[2,1,0,3]]}" } keys %table; 
Cuestiones relacionadas