Skip site navigation (1)Skip section navigation (2)
Date:      Tue, 27 Nov 2001 03:07:49 -0500
From:      parv <parv_@yahoo.com>
To:        jayyness@mindspring.com
Cc:        freebsd-questions@freebsd.org
Subject:   Re: Mass Renaming of Files
Message-ID:  <20011127030749.A38784@moo.holy.cow>
In-Reply-To: <Springmail.105.1006808059.0.84387100@www.springmail.com>; from jayyness@mindspring.com on Mon, Nov 26, 2001 at 03:54:19PM -0500
References:  <Springmail.105.1006808059.0.84387100@www.springmail.com>

next in thread | previous in thread | raw e-mail | index | archive | help
my good (wo)man, wrap your damn lines around 65 or so characters.
it is more important if want a reply.


in message <Springmail.105.1006808059.0.84387100@www.springmail.com>, 
wrote jayyness@mindspring.com thusly...
>
> Thought I would ask here, though, to see if any of you had any 
> experience in this type of thing and found a simpler solution.
> 
> I am trying to parse directories and files into lists, but I am 
> running into a lot of issues because there are spaces in directory 
> names and file names.
> 
> Do any of you know of a script that could be written or possibly 
> existst that would search for and replace spaces with underscores?

below is a perl program which changes the file name to [a-zA-Z0-9_-.]
only characterset, optionally only [a-z0-9_-.].

beware of a bug: this doesn't check if you there is already another 
file w/ the same name as the translated one. say if you have 2 files:
'pq' and 'p q'. the script will move 'p q' to 'pq', obliterating the 
old 'pq'.

--------  sanefilename.perl  -----
#! /usr/local/bin/perl -w

##  author: parv, parv_@yahoo.com
##  date: aug 31 2001
##
##  license: free to use as you please w/ credit given
##
##  script name: sanefilename.perl
##
##  purpose: 
##    change file names which are not composed of [a-zA-Z0-9-_.]
##    characters; optionally, not use [A-Z]
##
##  usage:
##    sanefilename.perl [-low] file [file2 file3 ...]
##     (-low option excludes [A-Z] characters])

use strict;

# modules to move & parse file name
use File::Basename;
use File::Copy;

# module to parse option
use Getopt::Long qw(:config posix_default require_order);

die " \* give file name(s) to change to sane version(s) \n"
  unless (@ARGV);


# check option if names needed to be lowercased
my $lowercase = 0;
GetOptions('lowercase|lower|low' => \$lowercase)
  || die " * wrong option given. \n";

# create alpha list to be used as regex in file renaming below
my $valid_alpha;

if ( $lowercase ) { $valid_alpha = join('', ('a' .. 'z')) }
else              { $valid_alpha = join('', ('a' .. 'z', 'A' .. 'Z')) }


foreach (@ARGV)
{
  my ($old_file,$path) = fileparse($_,'');
  
  die "\* destination, $path, is either not a directory or is not writeable, exiting... \n"
    unless (-d $path || -w $path);


  unless ( -e $path . $old_file ) 
  {
    print " - ${path}${old_file} doesn't exist, skipping...\n";
    next;
  }

  if ( $old_file !~ m#[^\d\Q${valid_alpha}_-.\E]# )
  {
    print " - ok  ${path}${old_file} ...\n";
    next;
  }
  #else
  #{
    my $new_file = $old_file;
     
    $new_file =~ tr [A-Z] [a-z] if ($lowercase);

    # change all the wrong characters to -
    $new_file =~ s#[^\d\Q${valid_alpha}-_.\E]#-#g; 

    # prefer - to _ 
    $new_file =~ s#(?:\Q_-|-_\E)#-#g;

    # prefer . to - or _
    $new_file =~ s#(?:\Q._|_.|-.|.-\E)#.#g;

    # minimize the consecutive ocurrance of . - _ to one of each
    $new_file =~ s#([\Q.-_\E]){2,}#$1#g;
      
    # remove end non [${valid_alpha}\d] characters
    #$new_file =~ s#(?:([^\d${valid_alpha}])$|^$1)##;
    $new_file =~ s#(?:[^\d${valid_alpha}]$|^[^\d${valid_alpha}])##;

    if ( $old_file eq $new_file )
    {
      print " # sane name seem to be calculated same as the insane;\n   ${path}${old_file} is not moved...\n";
      next;
    }
    #else
    #{
      print " - ${path}${old_file}  ->  ${path}${new_file} ... \n";

      move("${path}${old_file}","${path}${new_file}")
        || die "\* couldn't move ${path}${old_file} to ${path}${new_file}: $! \n" ;
    #}
  #}
}

print "...done\n";
--------  sanefilename.perl  -----


-- 
 

To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-questions" in the body of the message




Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20011127030749.A38784>