Category: Utility Script
Author/Contact Info Mike Palmer mp@netpimpz.com
Description: This script will rename all files and folders in the current directory taking out multiple spaces and replacing them with 1 underscore. I needed this because I kept finding IMAP users that were creating folder names like " My Folder " and it was causing folder display problems in our webmail. 
#!/usr/bin/perl -w
# This program will take all spaces out of file names and replace with
+ underscores.
# raven@netpimpz.com
# 2002-04-07 04:31:02
use strict;
use File::Copy;

# Grab a file listing from the current directory
my @filez = <*>;

my $files = 0;
 foreach my $file (@filez) {
    chomp($file);
    my $old_file = $file;
    $file =~ s/\s+/_/g;
    $file =~ s/\(|\)//g;
        if ($old_file ne $file) {
            move($old_file,$file) or die "Error moving file : $!";
            $files++;
        }
 }

print "Modified $files files.\n";
Replies are listed 'Best First'.
Re: Space Out
by grinder (Bishop) on Apr 17, 2002 at 20:40 UTC
    I might be missing something, but in the comments you talk of renaming, but in the code you use move. This should really only be if used if you know (or the possibility exists) that you might cross file-system boundaries.

    Since you appear to be renaming in the same directory, you can get away with the far cheaper rename. It may well be that move is smart enough to know that if this is the case it can fall back to a rename anyway. But I'm not sure, and without going to the effort of consulting the documentation, I can't be certain. Which makes it a losing proposition.

    Another minor thing is that

      $file =~ s/\(|\)//g

    is better written as

      $file =~ tr/()//d

    print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u'
[reply]
[d/l]
[select]
Re: Space Out
by neilwatson (Priest) on Apr 19, 2002 at 19:33 UTC
    I use something extra to clean up my music files after ripping them:

    Sane Name

    #!/usr/bin/perl -w

#sanename renames files in a given directory recursively.
#it removes capitals, spaces and other unwanted symbols

use strict;
use warnings;
use locale;
use File::Find;

my $dir = "/oggs/new"; #base search directory

find(\&files, $dir); #rename files

find(\&dirs, $dir); #rename dirs

sub files {
 if (-f $_) {
  my $newfile = $_;

  # Converts all ~&@#%(){}[]"'`<>! _  to _
  $newfile =~ s/(\~|\&|\@|\#|\%|\(|\)|\{|\}|\[|\]|\"|\'|\`|\<|\>|\!|\s
+-\s)/_/g;
 
  $newfile =~ s/\s+/_/g; #replace whitespace with _
  $newfile = lc($newfile); #convert to lowercase
   $newfile =~ s/^\d{2}_//; #remove track numbers
  $newfile =~ s/_-_/_/g; #replace _-_ with _
 
  #print "$newfile\n";
  print "$File::Find::name changed to $File::Find::dir/$newfile\n";
  rename($File::Find::name, "$File::Find::dir/$newfile");
 }
}

sub dirs {
 if (-d $_) {
  my $newfile = $_;

  # Converts all ~&@#%(){}[]"'`<>! _  to _
  $newfile =~ s/(\~|\&|\@|\#|\%|\(|\)|\{|\}|\[|\]|\"|\'|\`|\<|\>|\!|\s
+-\s)/_/g;
 
  $newfile =~ s/\s+/_/g; #replace whitespace with _
  $newfile = lc($newfile); #convert to lowercase
   $newfile =~ s/^\d{2}_//; #remove track numbers
  $newfile =~ s/_-_/_/g; #replace _-_ with _
 
  #print "$newfile\n";
  print "$File::Find::name changed to $File::Find::dir/$newfile\n";
  rename($File::Find::name, "$File::Find::dir/$newfile");
 }
}

    [download]

    Neil Watson
    watson-wilson.ca

[reply]
[d/l]

Back to Code Catacombs