Foro - Perl en Español

por **sisifo80** » 2015-01-16 11:50 @535

Hola,

Estoy intentando hacer un script que distribuya archivos en carpetas en función del contenido del archivo. En concreto, tengo un conjunto de archivos .xml que contienen el elemento <year></year>. Dentro de este elemento puede haber cuatro opciones:

Sintáxis: [ Descargar ] [ Ocultar ]

Using xml Syntax Highlighting

<year>1500</year>
<year>1600</year>
<year>1700</year>
<year>1800</year>
Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Lo que quiero es distribuir los archivos .xml en cuatro carpetas (1500, 1600, 1700, 1800) en función del contenido del elemento year. Por ejemplo, si el archivo .xml tiene el elemento <year>1500</year> ese archivo debe ir a la carpeta 1500, y así sucesivamente. Los archivos están todos en una carpeta llamada "input".

He probado a hacer lo siguiente:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

mkdir '1500'; 
mkdir '1600';
mkdir '1700';
mkdir '1800';
 
opendir IN, 'input'; 
my @in = grep { /^[^.]/ } readdir IN;
closedir IN;
 
for my $in (@in) {
  open IN, '<', "input/$in"; 
  $/ = undef;
  
  $file = <IN>; 
  
  if ($file =~ /<year>15/) {
        
  rename "$in", "1500";
  }
  
  }
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Consigo crear las carpetas, pero no consigo crear una copia de cada archivo en la carpeta correspondiente. ¿Alguna sugerencia?

El problema con este enfoque es que si, en el futuro, aparece otro valor de year, tendrás que reeditar el programa.

Lo mejor es que el programa sea lo más robusto posible, es decir: que sea capaz de adaptarse a los cambios.

Ya que la información de en qué carpeta debe almacenarse el archivo está en el propio archivo, podemos aprovecharnos de eso (no probado):

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
opendir IN, 'input';
while (my $in = readdir IN) {
    next if $in =~ /^[.]/;                      # pasa al siguiente si $in comienza por '.'
 
    open ARCHIVO, '<', "input/$in";
    $/ = undef;
    my $file = <ARCHIVO>;
    close ARCHIVO;
 
    if ($file =~ m{<year>(.+?)</year>}) {
        my $year = $1;
 
        if (! -d $year) {                       # si no existe carpeta de ese año
            mkdir $year;                        # la creamos
        }
 
        rename "input/$in", "$year/$in";        # lo movemos
    }
}
closedir IN;
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Fíjate que en el rename() tenemos que dar la ruta completa de dónde a dónde.

Además... si en el archivo no existe una marca <year>, no intenta el movimiento, pues suponemos que no es un archivo de los que nos interesa.

por **sisifo80** » 2015-01-17 05:43 @280

Gracias por tu respuesta, explorer.

El problema es que me expresé mal en mi mensaje. En realidad, el elemento <year></year> no tiene cuatro opciones, tiene múltiples opciones. Por ejemplo:

1) <year>1765</year>
2) <year>1503</year>
3) <year>1654</year>
....

Se trata de distribuir los archivos en función del siglo y, por tanto, en función de los dos primeros dígitos. Por ejemplo, el caso 1 debería aparecer en la carpeta llamada 1700, el caso 2 en la carpeta 1500, etc.

A partir de tu sugerencia, creé el siguiente script, que sí funciona:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
mkdir "1500";
mkdir "1600";
mkdir "1700";
mkdir "1800";
 
opendir IN, 'input';
while ( my $in = readdir IN ) {
    next if $in =~ /^[.]/;
 
    open ARCHIVO, '<', "input/$in";
    $/ = undef;
    my $file = <ARCHIVO>;
    close ARCHIVO;
 
    if ( $file =~ m{<year>15} ) {
 
        rename "input/$in", "1500/$in";
    }
 
    if ( $file =~ m{<year>16} ) {
 
        rename "input/$in", "1600/$in";
    }
 
    if ( $file =~ m{<year>17} ) {
 
        rename "input/$in", "1700/$in";
    }
 
    if ( $file =~ m{<year>18} ) {
 
        rename "input/$in", "1800/$in";
    }
}
closedir IN;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

No obstante, todavía tengo algunas dudas:

1) Compruebo que la orden "rename" elimina el archivo de su ubicación original (en mi caso la carpeta "input"). ¿Existe alguna opción para que el archivo no se traslade sino que simplemente se copie?

2) Cuál es la finalidad que está detrás de la orden

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

next if $in =~ /^[.]/;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

3) Habría alguna forma de hacer más robusta mi propuesta.

Gracias de nuevo por tus sugerencias, con las que siempre aprendo.

por **sisifo80** » 2015-01-17 06:00 @292

Ya me respondo yo a la primera de mis dudas

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use File::Copy;
 
mkdir "1500";
mkdir "1600";
mkdir "1700";
mkdir "1800";
 
opendir IN, 'input';
while ( my $in = readdir IN ) {
    next if $in =~ /^[.]/;
 
    open ARCHIVO, '<', "input/$in";
    $/ = undef;
    my $file = <ARCHIVO>;
    close ARCHIVO;
 
    if ( $file =~ m{<year>15} ) {
 
        copy( "input/$in", "1500/$in" );
    }
 
    if ( $file =~ m{<year>16} ) {
 
        copy( "input/$in", "1600/$in" );
    }
 
    if ( $file =~ m{<year>17} ) {
 
        copy( "input/$in", "1700/$in" );
    }
 
    if ( $file =~ m{<year>18} ) {
 
        copy( "input/$in", "1800/$in" );
    }
}
closedir IN;
 
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **explorer** » 2015-01-17 10:46 @490

1) la línea hace la mismo que el grep() que tenías en el primer código: filtrar aquellos archivos que no empiecen por '.'

2) para hacerlo más robusto lo que hay que hacer es tener que evitar que crear y copiar archivos a nombres de carpetas fijos en el programa.

Esta es otra versión, más robusta (pero no probada):

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use File::Copy;
 
$/ = undef;
 
opendir IN, 'input';
 
while ( my $in = readdir IN ) {
    next if $in =~ /^[.]/;             # pasa al siguiente si $in comienza por '.'
 
    open ARCHIVO, '<', "input/$in";
    my $file = <ARCHIVO>;
    close ARCHIVO;
 
    if ( $file =~ m{<year>(.+?)</year>} ) {
        my $siglo = substr $1, 0, 2;          # los dos primeros caracteres
 
        mkdir $siglo if ! -d $siglo;          # si no existe carpeta de ese año
 
        copy( "input/$in", "$siglo/$in" );    # lo copiamos
    }
}
 
closedir IN;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Como ves, se trata de extraer el número de siglo desde el contenido del propio valor de la etiqueta <year>; crear la carpeta del siglo si no existe; y hacer la copia.

Hay otra forma... si hemos leído todo el archivo, no necesitamos hacer una copia: basta con abrir un nuevo archivo destino y grabar en él el archivo leído:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
$/ = undef;
 
opendir IN, 'input';
 
while ( my $in = readdir IN ) {
    next if $in =~ /^[.]/;                  # pasa al siguiente si $in comienza por '.'
 
    open     my $ARCHIVO, '<', "input/$in";
    my $file = <$ARCHIVO>;
    close       $ARCHIVO;
 
    if ($file =~ m{<year>(..)..</year>}) {
        my $siglo = $1;                     # los dos primeros caracteres son el siglo
 
        mkdir $siglo if ! -d $siglo;        # si no existe carpeta de ese año
 
        open my $OUT, '>', "$siglo/$in";    # lo copiamos
        print   $OUT $file;
        close   $OUT;
    }
}
 
closedir IN;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Queda un poco más corto

De todas maneras, hay un error de concepto: Los siglos no pueden tomarse de los dos primeros caracteres del año.

Un siglo va desde el año 1 hasta el año 100.

Por ejemplo, el siglo XX va desde el 1901 hasta el 2000. Y el XXI va desde el 2001 al 2100.

Esto quedaría mejor así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
$/ = undef;
 
opendir my $DIR, 'input';
 
while (  my $in = readdir $DIR ) {
    next if $in =~ /^[.]/;             # pasa al siguiente si $in comienza por '.'
 
    open     my $ARCHIVO, '<', "input/$in";
    my $file = <$ARCHIVO>;
    close       $ARCHIVO;
 
    next if $file !~ m{<year>(..)(..)</year>};         # pasamos al siguiente si $file no contiene <year>....</year>
 
    my($siglo,$unidades) = ($1,$2);
 
    $siglo-- if $unidades == 0;                        # si el año es 00, pertenece al siglo anterior
 
    mkdir $siglo if ! -d $siglo;                       # crear carpeta si no existe carpeta de ese siglo
 
    open my $OUT, '>', "$siglo/$in";                   # lo copiamos allí
    print   $OUT $file;
    close   $OUT;
}
 
closedir $DIR;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Pero, bueno, quizás sea demasiado estricto.

por **sisifo80** » 2015-01-18 05:29 @270

Sí, tienes toda la razón. Soy consciente del error de concepto con los límites del siglo, aunque responde a decisiones internas en el proyecto en el que trabajo.

Te agradezco mucho tus sugerencias y las distintas opciones que me facilitas. Me sirven de mucho para ir aprendiendo nuevas expresiones en perl. Gracias.

Foro - Perl en Español

Distribuir archivos en carpetas

Distribuir archivos en carpetas

Publicidad

Re: Distribuir archivos en carpetas

Re: Distribuir archivos en carpetas

Re: Distribuir archivos en carpetas

Re: Distribuir archivos en carpetas

Re: Distribuir archivos en carpetas

¿Quién está conectado?