user-tools/rename.td

   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 #  Then further developed by A Hrubak and renamed to rename.td,
   7 #  because he was not aware of newer versions, like file-rename(1p) (alias prename).
   8 #
   9 #  This script is free software; you can redistribute it and/or modify it
  10 #  under the same terms as Perl itself.
  11 #
  12 # Larry(?)'s RCS header:
  13 #  RCSfile: rename,v   Revision: 4.1   Date: 92/08/07 17:20:30
  14 #
  15 # $RCSfile: rename,v $$Revision: 1.5 $$Date: 1998/12/18 16:16:31 $
  16 #
  17 # $Log: rename,v $
  18 # Revision 1.5  1998/12/18 16:16:31  rmb1
  19 # moved to perl/source
  20 # changed man documentation to POD
  21 #
  22 # Revision 1.4  1997/02/27  17:19:26  rmb1
  23 # corrected usage string
  24 #
  25 # Revision 1.3  1997/02/27  16:39:07  rmb1
  26 # added -v
  27 #
  28 # Revision 1.2  1997/02/27  16:15:40  rmb1
  29 # *** empty log message ***
  30 #
  31 # Revision 1.1  1997/02/27  15:48:51  rmb1
  32 # Initial revision
  33 #
  34
  35 use strict;
  36
  37 use Getopt::Long;
  38 Getopt::Long::Configure('bundling');
  39
  40 my $verbose = 0;
  41 my ($no_act, $force, $op);
  42
  43 die "Usage: rename [-v] [-n] [-f] perlexpr [filenames]\n"
  44 unless GetOptions(
  45         'v|verbose+' => \$verbose,
  46         'n|no-act|dry-run|dryrun' => \$no_act,
  47         'f|force' => \$force,
  48 ) and $op = shift;
  49
  50 if (!@ARGV) {
  51     print STDERR "reading filenames from STDIN\n" if $verbose;
  52     @ARGV = <STDIN>;
  53     chomp(@ARGV);
  54 }
  55
  56 $header_emitted = 0;
  57 $highest_errno = 0;
  58
  59 sub emit_header
  60 {
  61         return if $header_emitted;
  62         print join "\t", "STATUS", "OLD", "NEW";
  63         print "\n";
  64 }
  65
  66 for (@ARGV)
  67 {
  68     my $was = $_;
  69     eval $op;
  70     die $@ if $@;
  71
  72     my $status;
  73
  74     if($was eq $_)
  75     {
  76         $status = "KEEP" if $verbose >= 2;
  77     }
  78     elsif (-e $_ and !$force)
  79     {
  80         $status = "SKIP";
  81     }
  82     else
  83     {
  84         if ($no_act)
  85         {
  86                 $status = "WOULD";
  87         }
  88         else
  89         {
  90             if(rename $was, $_)
  91             {
  92                 $status = "OK" if $verbose;
  93             }
  94             else
  95             {
  96                 my $errno = int $!;
  97                 $status = "ERR $errno";
  98                 $highest_errno = $errno if $errno > $highest_errno;
  99             }
 100         }
 101     }
 102
 103     if(defined $status)
 104     {
 105         emit_header;
 106             print join "\t", $status, $was, $_;
 107         print "\n";
 108     }
 109 }
 110
 111 exit $highest_errno;
 112
 113 __END__
 114
 115 =head1 NAME
 116
 117 rename.td - rename multiple files by a Perl expression
 118
 119 =head1 SYNOPSIS
 120
 121 rename.td S<[ B<-v>[B<v>] ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>
 122
 123 cat files.list | rename.td S<[ B<-v>[B<v>] ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr>
 124
 125 =head1 DESCRIPTION
 126
 127 B<rename.td> renames the files supplied according to the rule specified as the first argument.
 128 The I<perlexpr> argument is a Perl expression which is expected to modify the C<$_>
 129 string in Perl for at least some of the filenames specified.
 130 If a given filename is not modified by the expression, it will not be renamed.
 131 If no filenames are given on the command line, filenames will be read via standard input.
 132
 133 For example, to rename all files matching C<*.bak> to strip the extension,
 134 you might say
 135
 136         rename.td 's/\.bak$//' *.bak
 137
 138 To translate uppercase names to lower, you'd use
 139
 140         rename.td 'y/A-Z/a-z/' *
 141
 142 =head1 OPTIONS
 143
 144 =over 8
 145
 146 =item B<-v>, B<--verbose>
 147
 148 Verbose: print names of files successfully renamed.
 149
 150 =item B<-vv>
 151
 152 Verbose extra: print names of files of which name is not changed.
 153
 154 =item B<-n>, B<--dry-run>, B<--no-act>
 155
 156 No Action: show what files would have been renamed, or skipped.
 157
 158 =item B<-f>, B<--force>
 159
 160 Force: overwrite existing files.
 161
 162 =back
 163
 164 =head1 OUTPUT
 165
 166 Output Tab-delimited fields line-by-line.
 167 First line is the headers.
 168 Each subsequent line describes a file in this way:
 169
 170 =over 4
 171
 172 =item 1st field - status
 173
 174 =over 8
 175
 176 =item B<KEEP> - no change in file name, shown in B<-vv> mode
 177
 178 =item B<SKIP> - destination already exists, not in B<--force> mode
 179
 180 =item B<WOULD> - would be attempted to rename, in B<--dry-run> mode
 181
 182 =item B<OK> - successfully renamed
 183
 184 =item B<ERR I<nnn>> - error happened during rename, error code is I<nnn>
 185
 186 =back
 187
 188 =item 2nd field - old file name
 189
 190 =item 3rd field - new file name
 191
 192 =back
 193
 194 =head1 EXIT STATUS
 195
 196 Zero when all rename succeeded, otherwise the highest error number of all the failed renames, if any.
 197 See rename(2) for these error numbers.
 198
 199 =head1 ENVIRONMENT
 200
 201 No environment variables are used.
 202
 203 =head1 CREDITS
 204
 205 Larry Wall (author of the original)
 206
 207 Robin Barker
 208
 209 =head1 SEE ALSO
 210
 211 mv(1), perl(1), rename(2), file-rename(1p) (prename(1)), rename.ul (rename(1)), renamemanual(1)
 212
 213 =head1 DIAGNOSTICS
 214
 215 If you give an invalid Perl expression you'll get a syntax error.
 216
 217 =head1 BUGS
 218
 219 The original C<rename> did not check for the existence of target filenames,
 220 so had to be used with care.  I hope I've fixed that (Robin Barker).
 221
 222 =cut