Old stuff/ecole_etude_fac_de_pau/perl/subdir_renomme.pl
(Deskargatu)
#!/usr/bin/perl -w
if (!$ARGV[0]) { die("Argument: Repertoire de fichiers a renommer\n"); }
$dir[0] = $ARGV[0];
sub suppr(@)
{
$repertoire = $dir[0];
shift @dir;
opendir(DIR,$repertoire);
while($element = readdir(DIR))
{
next if ($element =~ /\.\.?/);
if ($element =~ /[^a-zA-Z0-9\-\.\_]/ or $element =~ /[^a-zA-Z0-9\.]{2}/)
{
$new_file = $element;
$new_file =~ s/([^\.a-zA-Z0-9])[^a-zA-Z0-9\.]+/$1/g;
$new_file =~ s/\ /-/g;
$new_file =~ s/[^\w\-\.\ \_]//g;
$new_file = $repertoire."/".$new_file;
$old_file = $repertoire."/".$element;
print "rename $old_file $new_file;\n";
rename $old_file, "$new_file" or warn("IMPOSSIBLE DE RENOMMER $element :: $!\n");
}
if(-d $repertoire."/".$element)
{
push(@dir,"$repertoire/$element");
}
}
}
while($dir[0]) { suppr(@dir); }
print "\n\n";