Sandbox

From BitFolk
Jump to: navigation, search
  1 #!/usr/bin/perl -w
  2 #
  3 #  This script was developed by Robin Barker (Robin.Barker@npl.co.uk),
  4 #  from Larry Wall's original script eg/rename from the perl source.
  5 #
  6 #  This script is free software; you can redistribute it and/or modify it
  7 #  under the same terms as Perl itself.
  8 #
  9 # Larry(?)'s RCS header:
 10 #  RCSfile: rename,v   Revision: 4.1   Date: 92/08/07 17:20:30 
 11 #
 12 # $RCSfile: rename,v $$Revision: 1.5 $$Date: 1998/12/18 16:16:31 $
 13 #
 14 # $Log: rename,v $
 15 # Revision 1.5  1998/12/18 16:16:31  rmb1
 16 # moved to perl/source
 17 # changed man documentation to POD
 18 #
 19 # Revision 1.4  1997/02/27  17:19:26  rmb1
 20 # corrected usage string
 21 #
 22 # Revision 1.3  1997/02/27  16:39:07  rmb1
 23 # added -v
 24 #
 25 # Revision 1.2  1997/02/27  16:15:40  rmb1
 26 # *** empty log message ***
 27 #
 28 # Revision 1.1  1997/02/27  15:48:51  rmb1
 29 # Initial revision
 30 #
 31 
 32 use strict;
 33 
 34 use Getopt::Long;
 35 Getopt::Long::Configure('bundling');
 36 
 37 my ($verbose, $no_act, $force, $op);
 38 
 39 die "Usage: rename [-v] [-n] [-f] perlexpr [filenames]\n"
 40     unless GetOptions(
 41 	'v|verbose' => \$verbose,
 42 	'n|no-act'  => \$no_act,
 43 	'f|force'   => \$force,
 44     ) and $op = shift;
 45 
 46 $verbose++ if $no_act;
 47 
 48 if (!@ARGV) {
 49     print "reading filenames from STDIN\n" if $verbose;
 50     @ARGV = <STDIN>;
 51     chop(@ARGV);
 52 }
 53 
 54 for (@ARGV) {
 55     my $was = $_;
 56     eval $op;
 57     die $@ if $@;
 58     next if $was eq $_; # ignore quietly
 59     if (-e $_ and !$force)
 60     {
 61 	warn  "$was not renamed: $_ already exists\n";
 62     }
 63     elsif ($no_act or rename $was, $_)
 64     {
 65 	print "$was renamed as $_\n" if $verbose;
 66     }
 67     else
 68     {
 69 	warn  "Can't rename $was $_: $!\n";
 70     }
 71 }
 72 
 73 __END__
 74 
 75 =head1 NAME
 76 
 77 rename - renames multiple files
 78 
 79 =head1 SYNOPSIS
 80 
 81 B<rename> S<[ B<-v> ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>
 82 
 83 =head1 DESCRIPTION
 84 
 85 C<rename>
 86 renames the filenames supplied according to the rule specified as the
 87 first argument.
 88 The I<perlexpr> 
 89 argument is a Perl expression which is expected to modify the C<$_>
 90 string in Perl for at least some of the filenames specified.
 91 If a given filename is not modified by the expression, it will not be
 92 renamed.
 93 If no filenames are given on the command line, filenames will be read
 94 via standard input.
 95 
 96 For example, to rename all files matching C<*.bak> to strip the extension,
 97 you might say
 98 
 99 	rename 's/\.bak$//' *.bak
100 
101 To translate uppercase names to lower, you'd use
102 
103 	rename 'y/A-Z/a-z/' *
104 
105 =head1 OPTIONS
106 
107 =over 8
108 
109 =item B<-v>, B<--verbose>
110 
111 Verbose: print names of files successfully renamed.
112 
113 =item B<-n>, B<--no-act>
114 
115 No Action: show what files would have been renamed.
116 
117 =item B<-f>, B<--force>
118 
119 Force: overwrite existing files.
120 
121 =back
122 
123 =head1 ENVIRONMENT
124 
125 No environment variables are used.
126 
127 =head1 AUTHOR
128 
129 Larry Wall
130 
131 =head1 SEE ALSO
132 
133 mv(1), perl(1)
134 
135 =head1 DIAGNOSTICS
136 
137 If you give an invalid Perl expression you'll get a syntax error.
138 
139 =head1 BUGS
140 
141 The original C<rename> did not check for the existence of target filenames,
142 so had to be used with care.  I hope I've fixed that (Robin Barker).
143 
144 =cut