Tuesday, April 9, 2013

Perl Script to Clean up file names


#--------------------------------------------------#
# Program to clean up file names.                  #
# It removes special characters from file names.   #  
# Useful for MP3s or any other files.              #
# Author: Ashok Kumar                              #
#--------------------------------------------------#
use Cwd;
use strict;
use warnings;

my $dir = getcwd;
my $extLength;
my $fName;
my $fileLength;
my $fName;
   
print "Processing Folder $dir\n\n";
 

opendir(DIR, "$dir") or die "unable to open dir $dir";

while (my $file = readdir(DIR)) {

        # Use a regular expression to ignore files beginning with a period
        next if ($file =~ m/^\./);
       
        print "Old File Name: $file\n";

#Get extension of file
my ($fileExt) = $file =~ /(\.[^.]+)$/;
#print "Extension:$fileExt\n";

#Length of file name
$fileLength = length($file);
#print "File Length : $fileLength\n";

#Length of extension
$extLength = length($fileExt);
#print "Extension Length : $extLength\n";

#Extract file name without extension

$fName = substr $file, 0, ($fileLength-$extLength);
#print "File Name without ext:$fName\n";

# Removing numbers
$fName =~ s/\d//g;;
#print "Without Numbers:$fName\n";


#Replace Braces with space
$fName =~ s/\(/ /g;
$fName =~ s/\)/ /g;
$fName =~ s/-/ /g;
#print "Replaced ():$fName\n";

#Remove special characters
$fName =~ tr/\$#@~!&*()[]%;.,:?^`\\\///d;
#print "After removing special chars:$fName\n";

#Replace _ with space
$fName =~ s/_/ /g;



#Remove leading space
$fName =~ s/^\s+//;
#print "After removing Leading Space:$fName\n";


#Create new name without numbers

$fName = $fName.$fileExt;
print "New Name:$fName\n\n";

#Rename File
rename($file,$fName);


}

closedir(DIR);
exit 0;

No comments:

Post a Comment