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', 'permute');
  39
  40 my $verbose = 0;
  41 my ($no_act, $force, $op);
  42
  43 die "Usage: rename [-v[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 my $header_emitted = 0;
  57 my $highest_errno = 0;
  58
  59 sub emit_header
  60 {
  61         return if $header_emitted;
  62         $header_emitted = 1;
  63         print join "\t", "STATUS", "OLD", "NEW";
  64         print "\n";
  65 }
  66
  67 for (@ARGV)
  68 {
  69     my $was = $_;
  70     eval $op;
  71     die $@ if $@;
  72
  73     my $status;
  74
  75     if($was eq $_)
  76     {
  77         $status = "KEEP" if $verbose >= 2;
  78     }
  79     elsif (-e $_ and !$force)
  80     {
  81         $status = "SKIP";
  82     }
  83     else
  84     {
  85         if ($no_act)
  86         {
  87                 $status = "WOULD";
  88         }
  89         else
  90         {
  91             if(rename $was, $_)
  92             {
  93                 $status = "OK" if $verbose;
  94             }
  95             else
  96             {
  97                 my $errno = int $!;
  98                 $status = "ERR $errno";
  99                 $highest_errno = $errno if $errno > $highest_errno;
 100             }
 101         }
 102     }
 103
 104     if(defined $status)
 105     {
 106         emit_header();
 107             print join "\t", $status, $was, $_;
 108         print "\n";
 109     }
 110 }
 111
 112 exit $highest_errno;
 113
 114 __END__
 115
 116 =head1 NAME
 117
 118 rename.td - rename multiple files by a Perl expression
 119
 120 =head1 SYNOPSIS
 121
 122 rename.td S<[ B<-v>[B<v>] ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr> S<[ I<files> ]>
 123
 124 cat files.list | rename.td S<[ B<-v>[B<v>] ]> S<[ B<-n> ]> S<[ B<-f> ]> I<perlexpr>
 125
 126 =head1 DESCRIPTION
 127
 128 B<rename.td> renames the files supplied according to the rule specified as the first argument.
 129 The I<perlexpr> argument is a Perl expression which is expected to modify the C<$_>
 130 string in Perl for at least some of the filenames specified.
 131 If a given filename is not modified by the expression, it will not be renamed.
 132 If no filenames are given on the command line, filenames will be read via standard input.
 133
 134 For example, to rename all files matching C<*.bak> to strip the extension,
 135 you might say
 136
 137         rename.td 's/\.bak$//' *.bak
 138
 139 To translate uppercase names to lower, you'd use
 140
 141         rename.td 'y/A-Z/a-z/' *
 142
 143 =head1 OPTIONS
 144
 145 =over 8
 146
 147 =item B<-v>, B<--verbose>
 148
 149 Verbose: print names of files successfully renamed.
 150
 151 =item B<-vv>
 152
 153 Verbose extra: print names of files of which name is not changed.
 154
 155 =item B<-n>, B<--dry-run>, B<--no-act>
 156
 157 No Action: show what files would have been renamed, or skipped.
 158
 159 =item B<-f>, B<--force>
 160
 161 Force: overwrite existing files.
 162
 163 =back
 164
 165 =head1 OUTPUT
 166
 167 Output Tab-delimited fields line-by-line.
 168 First line is the headers.
 169 Each subsequent line describes a file in this way:
 170
 171 =over 4
 172
 173 =item 1st field - status
 174
 175 =over 8
 176
 177 =item B<KEEP> - no change in file name, shown in B<-vv> mode
 178
 179 =item B<SKIP> - destination already exists, not in B<--force> mode
 180
 181 =item B<WOULD> - would be attempted to rename, in B<--dry-run> mode
 182
 183 =item B<OK> - successfully renamed
 184
 185 =item B<ERR I<nnn>> - error happened during rename, error code is I<nnn>
 186
 187 =back
 188
 189 =item 2nd field - old file name
 190
 191 =item 3rd field - new file name
 192
 193 =back
 194
 195 =head1 EXIT STATUS
 196
 197 Zero when all rename succeeded, otherwise the highest error number of all the failed renames, if any.
 198 See rename(2) for these error numbers.
 199
 200 =head1 ENVIRONMENT
 201
 202 No environment variables are used.
 203
 204 =head1 CREDITS
 205
 206 Larry Wall (author of the original)
 207
 208 Robin Barker
 209
 210 =head1 SEE ALSO
 211
 212 mv(1), perl(1), rename(2), file-rename(1p) (prename(1)), rename.ul (rename(1)), renamemanual(1)
 213
 214 =head1 DIAGNOSTICS
 215
 216 If you give an invalid Perl expression you'll get a syntax error.
 217
 218 =cut