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>
