Tfe

Ongi etorri tfe-ren webgunera...

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";