Foro - Perl en Español

por **creating021** » 2006-02-23 16:42 @737

Hola.

He hecho un programa que corta archivos según un tamaño dado, pero el problema es que lo almacena en un '@' y lo trabaja por líneas, esto es muy lento y pesado, además pone la máquina muy lenta si el archivo es de 1 GB o más.

Así que supongo que si se pudiera trabajar con un while() (sacando del archivo cierto tamaño) sería más rápido.

La pregunta es: ¿cómo lo hago más rápido?

#!/boot/home/config/bin/perl -w
use strict;
my ( $do, $file, @out ) = @ARGV;
die "Error, bad usage" unless @ARGV > 2;
 
sub cut {
    open FL, $file or die "Error $file: $!";
    my @line = <FL>;
    close FL;
    my $a = 0;
    my $lines;
    foreach (@line) { $lines = "$lines$line[$a++]"; }
    my $allb = length $lines;
    my $tama = $allb / $#out;
    my $b    = 0;
    my $d    = $tama;
    my $e    = 0;
    foreach (@out) {
        if ( $d > $allb ) { die "Done\n"; }
        open OT, "+>$out[$b]";
        my $ot = substr( $lines, $e, $d );
        print OT $ot;
        close OT;
        $b++;
        $e = $e + $d;
        $d = $d + $d;
    }
    die "Done\n";
}
 
sub forme {
    my $res;
    my $x = 0;
    my $a = 0;
    foreach (@out) {
        open A, $out[$a] or warn "Error $file: $!";
        my @a = <A>;
        my $z = 0;
        foreach (@a) { $res = "$res$a[$z++]"; }
        close A;
        $a++;
    }
    open F, "+>$file" or die "Error $file: $!";
    print F $res;
    close F;
    die "Done\n";
}
if ( $do eq "cut" )  { cut(); }
if ( $do eq "make" ) { forme(); }
die "Error: bad usage";
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

Nota: La dirección #!/boot/home/config/bin/perl -w es para BeOS/Zeta, la idea es hacerlo 100% en Perl

Gracias :wink:

por **explorer** » 2006-02-24 16:47 @741

Es que ese es el problema... Estás utilizando operaciones de cadena de caracteres que, cuando se trata de ficheros muy grandes, puede llegar a saturar la memoria.

Lo mejor es no leer los ficheros. Sólo la parte que nos interesa.
Una forma posible de hacerlo:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
use warnings;
use strict;
 
die "Error de uso.\n"
   ."\tcut  <fichero origen> <fichero(s) destino>\n"
   ."\tmake <fichero destino> <fichero(s) origen>\n" unless @ARGV > 2;
 
# Leemos el programa
my $programa = shift @ARGV;
 
## Hay que cortar el fichero origen en tantas partes como los de destino
if ( $programa eq 'cut' ) {
 
  my ($origen, @destinos) = @ARGV;
 
  ## Abrimos el fichero de origen. Lo hacemos aquí para asegurarnos de que existe
  open(my $fh, '<', $origen) or die "ERROR: No pude abrir el fichero de origen: $!\n";
  binmode $fh;
 
  ## Tamaño de cada bloque. Cuidado con los redondeos: no podemos copiar medio byte!
  my $tamano = int( 0.5 + ( (-s $origen) / @destinos) );
 
  ## Informar
  print "Cortando $origen de ", -s $origen, " en ", scalar @destinos, " ficheros, de tamaño $tamano bytes cada uno...\n";
 
  ## Bucle de copia para todos los destinos
  for ( my $i=0; $i < @destinos; $i++ ) {
 
    print "\tParte ", $i+1, " -> $destinos[$i]";
 
    ## Abrimos el fichero destino correspondiente
    open(my $hl, '>', $destinos[$i]) or die "ERROR: No puedo escribir en $destinos[$i]: $!\n";
    binmode $hl;
 
    ## Nos posicionamos dentro del fichero, leemos el trozo
    my $buffer;
    seek $fh, $i * $tamano, 0;
    read $fh, $buffer, $tamano;
 
    ## Escribimos en el destino
    print $hl $buffer;
 
    ## Cerramos fichero
    close $hl;
    print "\n";
  }
  close $fh;
 
## Hay que abrir los ficheros y meterlos en el destino
} elsif ( $programa eq 'make' ) {
 
  my ($destino, @origenes) = @ARGV;
 
  print "Uniendo los ficheros @origenes en el fichero $destino...\n";
 
  ## Abrimos el destino
  open(my $hl, '>', $destino) or die "ERROR: No pude escribir en $destino: $!\n";
  binmode $hl;
 
  foreach my $origen ( @origenes ) {
 
    print "\tLeyendo $origen";
 
    ## Abrimos origen
    open(my $fh, '<', $origen) or die "ERROR: No pude abrir el fichero $origen: $!\n";
    binmode $fh;
 
    ## Leemos el fichero y lo guardamos
    my $buffer;
    read $fh, $buffer, -s $origen;
    print $hl $buffer;
 
    ## Cerramos fichero
    close $fh;
    print "\n";
  }
 
  close $hl;
}
Coloreado en 0.004 segundos,  usando GeSHi 1.0.8.4

Esta solución sólo tiene en memoria cada vez un tamaño igual a la de una parte del fichero, no el total.

por **creating021** » 2006-02-24 17:51 @785

print "Mil Gracias explorer!!!\n"x1000;
print "Mil Gracias Kidd!!!\n"x1000;

por **creating021** » 2006-02-25 10:03 @460

En efecto, 1.8 GB en tres partes = 20m41.851s

Gracias

Foro - Perl en Español

Usando while y length

Usando while y length

Publicidad

Re: usando while y length

Re: usando while y length

¿Quién está conectado?