Perleando con - buscar y borrar ficheros

A continuación, un pequeño script en Perl que 1/ busca y BORRA en el directorio especificado 2/ los nombres de ficheros según la cadena de búsqueda introducida y 3/ con un tamaño superior al especificado.

Todo ello a través de parámetros en la línea de comandos y ‘globbeando’ el texto para utilizar wildcards o asteriscos.


v.0.01 - Uso: borra_dat.exe directorio texto tamanio(kb)

Espero que lo disfruten:

#!/usr/bin/perl

use strict;

use File::Find;

use File::Glob qw(:glob);

my $uso='borra_dat.exe directorio texto tamanio(kb) ';

my $version='0.01';

if ( @ARGV <>

print "v.$version - Uso: $uso\n";

exit 0;

}

print "Ficheros borrados: \n";

my $directorio = $ARGV[0];

my $texto = glob2pat($ARGV[1]);

sub glob2pat {

my $globstr = $ARGV[1];

my %patmap = (

'*' => '.*',

'?' => '.',

'[' => '[',

']' => ']',

);

$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;

return '^' . $globstr . '$';

}

my $tamano = $ARGV[2] * 1024;

find(\&imprimir_archivo_dat, $directorio);

sub imprimir_archivo_dat{

my $elemento = $_;

#if(-f $elemento && $elemento =~ /\.dat$/ && -s $elemento < $ARGV[2] ){

if(-f $elemento && $elemento =~ $texto && -s $elemento > $ARGV[2] ){

print "$File::Find::name\n";

unlink $elemento;

}

}


Extraído de http://unlugarsinfin.blogspot.es


Comentarios