[Linuxcommand-discuss] Re: Bash script for renaming files

[Karl V. <vo...@dn...>]

>> On Sun, 25 Aug 2002 12:02:28 -0700, 
>> "Bruce Burhans" <bbu...@ea...> said:

B> Here's a script I wrote that I woouldn't mind some feedback
B> on.......It's for changing the extensions on files in the pwd and skips
B> over files without the extension entered as the first argument.....

   This perl script does the same thing, but allows you to see what would
   be renamed without actually renaming it.

-- 
Karl Vogel               ASC/YCOA, Wright-Patterson AFB, OH 45433
vo...@dn...                   http://www.dnaco.net/~vogelke

I've discovered that using VMS is a lot like driving a nail with
your head: sure, you eventually get something practical done,
but it usually results in a headache and some blood loss.   --Sean A. Simpson

---------------------------------------------------------------------------
#!/usr/local/bin/perl
#
# From rw...@ta... Sat Mar  7 19:12:58 1992
# From: rw...@ta... (Bob Kerns)
# Subject: improved rename command.
# Date: Tue, 3 Mar 1992 05:38:21 GMT
# 
# Here's my improved rename command I mentioned in my earlier post.
# 
# In particular, it lets you express the renaming in terms of patterns
# of wildcards instead of regexps.  (You can still specify a regexp
# if you want).  It will also copy, if you'd like.

'di';
'ig00';

# This is both a perl script and a man page.

# Pretty much a complete rewrite of Larry Wall's rename hack,
# to more careful not to clobber files or rename multiple files
# to the same thing.

$DeleteOK = 0;
$showpattern = 0;
$nodoit = 0;
$perlit = 0;


sub usage
{
    print STDERR "Usage: rename [-copy [-p]] [-i] [-delete] 'source-pattern' 'dest-pattern'
- or -
rename [-copy [-p]] [-i] [-s] [-n] [-delete] -e 'perl-expression' [filenames]

Flags:
-copy  copy files         -i   interactive          -e       perl expression
-p     preserve dates     -s   show perl regexps    -delete  allow deletion
-n     No action (just print)

>>> Don't forget the quotes! <<<\n";
exit(-1);
}

sub die
{
    print STDERR (@_,"\n");
    $nodoit || exit(-1);
}

sub unbrace
{   local ($x) = (@_);
    $x =~ s/\\\{/\(/;
    $x =~ s/\\\,/\|/g;
    $x =~ s/\\\}/\)/;
    return $x;
}

sub expand_udir
{   local($fname) = @_;
    local($flag,$uname) = ($fname =~ m!^(\~([^/]*))\/! );
    if ($flag) {
	if ($uname) {
	    local($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) =
		getpwnam($uname);
	    $fname =~ s!^\~[^/]*\/!$dir\/!;
	} else {
	    local($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) =
		getpwuid($<);
	    $fname =~ s!^\~\/!$dir\/!;
	}
    }
    return($fname);
}

# Routine to compute highest version number.
sub newest
{
    local($fname) = @_;
    local($highest) = (0);
    $fname || ($fname = $_);
    $fname =~ s/\~\d+\~/\~\*\~\$/ || ($fname .= "~*~");
    foreach $file (<${fname}>) {
      ($version) =~ /\~(d+)\~$/;
      ($version > $highest) && ($highest = $version);
    }
    return($highest);
}

# First, scan for options.

while (1) {
    ($op = shift) || &usage;
    ($op =~ /^-delete$/ ) && do {
	($DeleteOK = 1);
	next;
    };
    ($op =~ /^-s$/ ) && do {
	($showpattern = 1);
	next;
    };
    ($op =~ /^-n$/ ) && do {
	($nodoit = 1);
	next;
    };
    ($op =~ /^-copy$/ ) && do {
	($copy = 1);
	next;
    };
    # This is only meaningful for -copy, but since it makes copy behave more like
    # rename, accept it without complaint from users who might 'just want to be sure'.
    ($op =~ /^-p$/ ) && do {
	(@cpopts = ("-p"));
	next;
    };

    ($op =~ /^-i$/ ) && do {
	($interactive = 1);
	next;
    };
    ($op =~ /^-e$/ ) && do {
	($perlit = 1);
	next;
    };
    # otherwise
    unshift(@ARGV, $op);
    last;
};

if ($perlit)
{
    ($op = shift) || &usage;
    @files = @ARGV;
    if (!@files) {
	@files = <STDIN>;
	chop(@files);
    }
    $showpattern && print STDERR ("Using perl expression \'$op\'\n");

} else {
    ($#ARGV != 1) && &usage;
    ($spattern, $dpattern) = @ARGV;
    $spattern = &expand_udir($spattern);
    $dpattern = &expand_udir($dpattern);
    $spattern =~ m#^[^\*\?\{\}]*\/#;
    $head=$&;
    if ($head) {
	$newhead = <${head}>;
        if ($newhead ne $head) {
	    $wd = `pwd`;
	    print STDERR ("Replacing $head with $newhead.\n");
	    $spattern =~ s*^$head*$newhead*;
	}
    }
    $spattern =~ s/\W/\\$&/g;	# Quote everything needing it.
    $spattern =~ s/(^|[^\\])\\\*/$1(.*)/g;	# Turn wildcards into regexps
    $spattern =~ s/(^|[^\\])\\\?/$1(.)/g;
    $spattern =~ s/(^|[^\\])(\\\{\S+(\\\,\S+)+\\\})/ $1 . &unbrace($2) /eg;
    $dpattern =~ s/\W/\\$&/g;	# Quote everthing needing it in destination.

    for ($i=1; ($dpattern =~ s/\\(\*|\?)/\${$i}/) ; $i++) {};
    $foo=$op;
    @files = <${foo}>;
    $op = "s/$spattern/$dpattern/";

    $showpattern && print STDERR ("Using perl expression \'$op\'\n");

};

%seen=();
foreach (@files) {
    $was = $_;
    eval $op;
    die $@ if $@;
    if ($seen{ $_ }) {
	&die("$was and $seen{$_} would both rename to $_.");
    }
    $seen{ $_ } = $was;
    $_ = $was;			# Undo the change for the next pass.
}

$DeleteOK && print STDERR ">> Overwritting existing files is enabled (-d option).\n";
$nodoit && print STDERR ">> No changes will actually be made (-n option).\n";

FILE: for (@files) {
    $was = $_;
    eval $op;
    die $@ if $@;
    if ($was eq $_) {
	print STDERR ("$was unchanged.\n");
    } else {
	$overwrite = (($DeleteOK && (-e $_)) ? ' (overwrite)' : "");
	print STDOUT ("$was -> $_$overwrite\n");
	if ($interactive) {
	    QUERY: while (1) {
		local($input);
		print STDERR ("OK? ");
		(($input=<STDIN>) =~ /^\s*y|yes/i) && last QUERY;
		($input =~ /\s*n|no/i) && next FILE;
	    }
	  }
	if (!(-e $was)) {
	    &die("Source file does not exist: $was");
	}
	if (!$DeleteOK && (-e  $_)) {
	    &die("Target file exists: $_");
	} elsif (!$nodoit) {
	    $!=0;
	    if ($copy) {
		local($err);
		($err = system("cp", "-p", $was, $_)) &&
		    ($! = ($err >> 8)) &&
			&die("Could not copy: $!");
	    } else {
		rename($was,$_) || 	&die ("Error while renaming: $!");
	    }
	}
    }
}
##############################################################################

	# These next few lines are legal in both Perl and nroff.

.00;			# finish .ig
 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
.TH RENAME 1 "October 8, 1991"
.AT 3
.SH NAME
rename \- renames multiple files
.SH SYNOPSIS
.B rename
.I [options] 'spattern' 'dpattern'
.break
.B rename
.I [options]
-e
.I perlexpr [files]
.SH DESCRIPTION
.I Rename

.nf
.I Option	Meaning
  -copy		copy
  -p		preserve dates
  -i		interactive
  -s		show generated perl regular expression.
  -n		nothing.  Do nothing, just indicate what would be done.
  -delete	Allow deleting of files to occur.
  -e		Perl expression, instead of wildcard patterns.
.fi

Renames the filenames, carefully. 

Without the -e option, it renames files by wildcard pattern.  All the
files which match the pattern 'spattern' are transformed into files
which match the pattern 'dpattern'.  'spattern' can have any combination
of '*', '?', and '{h,c}' wildcards.  You should supply a '*' where you
in 'dpattern' where you would like the corresponding matched component
to appear in the destination filename.  You may use more than one
wildcard, but they must appear in the destination in the same order.

If you wish to use wildcards in directory names, some restrictions
apply regarding directory links; see the section on
.B BUGS

With the -e option, the first argument is a Perl expression which is expected
to modify the $_ string in Perl for at least some of the filenames specified.
If a given filename is not modified by the expression, it will not be
renamed.

When using the -e option, if no filenames are given on the command line,
filenames will be read via standard input.

The -delete option allows existing files to be deleted to allow the rename
or copy.

The -s option shows the perl expression which will be used to perform
the rename.  This is useful with the -n option, if you might want to
supply your own perl expression using the -p option.  Use -s -n to
see what expression would be used and its effects, and then use
the -n -e options to try out your own expression and see its effects,
and then when you're happy, drop the -n  option to actually perform
it.

If the -copy option is specified, it copies using cp.  You may supply
the -p option to preverve the creation dates.  (I considered making that
the default, but decided it would be too inconsistent with other Un*x
'tools').

The -i (interactive) option asks you yes or no for each file.

.PP
For example, to rename all files matching *.bak to strip the extension,
you might say
.nf

	rename '*.bak/' '*'

.fi
or
.nf

	rename -e 's/\\.bak$//' *.bak

.fi


To translate uppercase names to lower, you'd use
.nf

	rename -e 'y/A-Z/a-z/' *

.fi
.SH RESTRICTIONS
If you give a perl expression, it will be evaluated twice per file.
The first time is during a scan to see if any two filenames might
conflict.  Be sure not to write an expression which cannot be safely
executed twice.  (This would be hard to do on one comand line).

.nf
rename 'foo*bar?baz' 'foo?bar*baz'
.fi
is a noop.  In the replacement expression, ? and * are treated
exactly the same.
.SH ENVIRONMENT
No environment variables are used.
.SH FILES
.SH AUTHOR
Bob Kerns, Cambridge Research Labs, Digital Equipment Corporation.

A nearly-complete rewrite of something by Larry Wall, perlmeister.
.SH "SEE ALSO"
mv(1)
.br
perl(1)
.SH DIAGNOSTICS
If you give an invalid Perl expression you'll get a syntax error.
.SH BUGS
Symbolic directory links, and ~ are not handled well, because the shell
may expand these into filenames which no longer match the source pattern.
This will occur when wildcards in directory names and symbolic links in
the directory path are combined too intimately.  We carefully get around
the problem for directories appearing before the first wildcard.

Names of symbolic links, occurring to the right of wildcards, will confuse it,
resulting in it not renaming any files, as in the example below.  ('test' is a
symbolic link under ~rwk/vm/src to /udir/rwk/vm-test.).

.nf
taunton:~> rename -s '~rwk/vm/src/*/foo.c' '../test/foo.c.old'
Replacing ~rwk/vm/src/ with /udir/rwk/vm/src/.
Using perl expression 's/\\/udir\\/rwk\\/vm\\/src\\/(.*)\\/foo\\.c/\\.\\.\\/test\\/foo\\.c.old/'
/udir/rwk/vm-test/foo.c unchanged.
.fi

.ex