perl/etc/wren

   1 #! /usr/bin/perl
   2 #---------------------------------------------------------------------
   3 # $Id: wren.pl 1752 2007-04-08 00:46:39Z cjm $
   4 # Copyright 2007 Christopher J. Madsen <perl@cjmweb.net>
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the same terms as Perl itself.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
  12 # GNU General Public License or the Artistic License for more details.
  13 #
  14 # Rename files via wildcard
  15 #---------------------------------------------------------------------
  16
  17 use English;
  18 use Getopt::Long 2.10;
  19 use strict;
  20
  21 my $VERSION = join('', 'r', (q$Rev: 1752 $ =~ /(\d+)/));
  22
  23 my $description;
  24
  25 sub isWin32 () { $^O =~ /win32/i }
  26
  27 #---------------------------------------------------------------------
  28 # Parse arguments
  29
  30 my($opt_capitalize, $opt_lowercase, $opt_uppercase, $opt_fixed_strings,
  31    $opt_ignore_case, $opt_no_change, $date_suffix, $svn, $use_date);
  32
  33 my($options,$match,$replace) = '';
  34
  35 Getopt::Long::config(qw(bundling no_getopt_compat));
  36 GetOptions(
  37     'capitalize|c'    => \$opt_capitalize,
  38     'lowercase|l'     => \$opt_lowercase,
  39     'uppercase|u'     => \$opt_uppercase,
  40     'date-suffix|d'   => \$date_suffix,
  41     'evaluate|e'      => sub { $options .= 'e' },
  42     'fixed-strings|F' => \$opt_fixed_strings,
  43     'ignore-case|i'   => \$opt_ignore_case,
  44     'just-print|dry-run|recon|n' => \$opt_no_change,
  45     'multiple|m'      => sub { $options .= 'g' },
  46     'subversion|svn|s'=> \$svn,
  47     'help'            => \&usage,
  48     'version'         => \&usage
  49 ) or usage();
  50
  51 if ($opt_capitalize) {
  52     $match   = '(?<!\w\')\b([a-zA-Z])([a-zA-Z]*)';
  53     $replace = '\U$1\L$2';
  54 } elsif ($opt_lowercase) {
  55     $match   = '.+';
  56     $replace = '\L$&';
  57 } elsif ($opt_uppercase) {
  58     $match   = '.+';
  59     $replace = '\U$&';
  60 } elsif ($date_suffix) {
  61     $match    = "\$";
  62     $replace  = '.$date';
  63     $use_date = 1;
  64 } else {
  65     $options .= "i" if $opt_ignore_case;
  66
  67     usage() if $#ARGV < 2;
  68     $match   = shift @ARGV;
  69     $replace = shift @ARGV;
  70     if ($opt_fixed_strings) {
  71         $match = quotemeta($match);
  72         $replace = quotemeta($replace);
  73     } else {
  74         $replace =~ s/\$MATCH|\$0/\$&/;
  75         $use_date = 1 if $match =~ /\$date/ or $replace =~ /\$date/;
  76     }
  77 } # end else MATCH REPLACE
  78
  79 usage() if $#ARGV < 0;          # No files specified
  80
  81 #---------------------------------------------------------------------
  82 require Wild if isWin32; # Expand wildcards
  83
  84 unless ($opt_no_change or not eval { require MSDOS::Descript; 1 }) {
  85   $description = MSDOS::Descript->new;
  86 }
  87
  88 my $loop =
  89     'foreach my $file (@ARGV) {' .
  90     '    my $newName = $file;';
  91 $loop .=
  92     '    my (@date,$date) = (localtime((stat $file)[9]))[5,4,3]; ++$date[1]; ' .
  93     '    $date[0] %= 100;  $date = sprintf"%02d%02d%02d", @date; '
  94     if $use_date; # Calculate the file date only if we use it
  95 $loop .=
  96     "    \$newName =~ s;$match;$replace;$options;" .
  97     '    doRename($file,$newName);' .
  98     '}';
  99
 100 eval $loop;
 101 die $@ if $@;
 102
 103 $description->update if $description;
 104
 105 exit;
 106
 107 #=====================================================================
 108 # Subroutines:
 109 #---------------------------------------------------------------------
 110 # Do the actual renaming on disk:
 111 #
 112 # Input:
 113 #   oldName:  The file to rename (must be in the current directory)
 114 #   newName:  The new name of the file
 115 #
 116 # Returns:  true for success, false for error
 117
 118 sub renameFile
 119 {
 120   if ($svn) {
 121     return system(qw(svn rename), @_) == 0;
 122   } else {
 123     return rename $_[0], $_[1];
 124   }
 125 } # end renameFile
 126
 127 #---------------------------------------------------------------------
 128 # Rename a file:
 129 #
 130 # Input:
 131 #   oldName:  The file to rename (must be in the current directory)
 132 #   newName:  The new name of the file
 133
 134 sub doRename
 135 {
 136     my ($oldName,$newName) = @ARG;
 137     return unless ($oldName ne $newName) && (-e $oldName);
 138     print $oldName," " x (12-length($oldName))," => ",$newName;
 139     if ($opt_no_change) {
 140         print "\n";
 141     } elsif (( (isWin32 and (lc($oldName) eq lc($newName)))
 142                or (not -e $newName) )
 143              and renameFile($oldName,$newName)) {
 144         print "\n";
 145         $description->rename($oldName, $newName) if $description;
 146     } else {
 147         print " error\n";
 148     }
 149 } # end doRename
 150
 151 #---------------------------------------------------------------------
 152 # Display usage information and exit:
 153
 154 sub usage {
 155     print "WRen $VERSION\n";
 156     exit if $_[0] and $_[0] eq 'version';
 157     print "\n" . <<'';
 158 Usage:  wren [options] MATCH REPLACE file ...
 159         wren [-c | -d | -l | -u] file ...
 160   -F, --fixed-strings   Treat MATCH & REPLACE as fixed strings (not regexps)
 161   -e, --evaluate        Evaluate REPLACE as a Perl expression
 162   -i, --ignore-case     Use case insensitive matching
 163   -m, --multiple        Replace multiple occurrences in each filename
 164   -n, --just-print      Don't actually rename any files
 165   -c, --capitalize      Capitalize the first word of all filenames
 166   -d, --date-suffix     Append modification date to all filenames
 167   -s, --subversion      Use "svn rename"
 168   -l, --lowercase       Convert all filenames to lowercase
 169   -u, --uppercase       Convert all filenames to UPPERCASE
 170       --help            Display this help message
 171       --version         Display version information
 172
 173     exit;
 174 } # end usage