renameext

   1 #!/usr/bin/perl -w
   2 ###APPNAME:     renameext
   3 ###APPAUTHOR:   duel
   4 ###APPDATE:     Sun Mar 30 12:46:15 2008
   5 ###APPVER:      0.1
   6 ###APPDESC:     rename files using perl regexp
   7 ###APPUSAGE:    [-t] (pattern|func) (files...)
   8 ###APPEXAMPLE:  renameext -t 's/^.*(\d+)\.jpg/$1' *\n\trenameext -t 'ucfirst' *
   9 ###APPOPTION:   -t:Test Mode
  10 use strict;
  11 $ARGV[0]="-h" unless(@ARGV);
  12 use lib $ENV{XR_PERL_MODULE_DIR};
  13 use MyPlace::Script::Usage qw/help_even_empty format_help/;
  14
  15 exit 0 if(help_even_empty($0,@ARGV));
  16
  17
  18 use utf8;
  19 use Encode;
  20 my $utf8 = find_encoding("utf8");
  21 my @OLDARGV = @ARGV;
  22 @ARGV = ();
  23 foreach(@OLDARGV) {
  24     push @ARGV,$utf8->decode($_);
  25 }
  26 binmode STDERR,'utf8';
  27 binmode STDOUT,'utf8';
  28 binmode STDIN,'utf8';
  29
  30 my $exp=shift;
  31 my $test;
  32 $exp=shift,$test="true" if($exp eq "-t");
  33 if($exp =~ /\/.*\//) {
  34     eval
  35     ('
  36         sub s_code
  37         {
  38             my $r = shift;
  39             $r =~ ' . "$exp" . ' if(\$r);
  40             return $r;
  41         }
  42     ');
  43 }
  44 else {
  45     eval
  46     (   '
  47         sub s_code
  48         {
  49             my $r = shift;
  50             $r = ' . "$exp" . ' $r;
  51             return $r;
  52         }
  53         '
  54     );
  55 }
  56 die("$@\n") if($@);
  57
  58 my $tempname = 0;
  59 while(-e $tempname) {
  60     $tempname ++;
  61 }
  62 sub my_rename {
  63     my ($old,$new)=@_;
  64     rename $old,"$tempname" or return undef;
  65     rename "$tempname",$new or return undef;
  66     return 1;
  67 }
  68
  69 my @files;
  70 if(@ARGV) {
  71     @files = @ARGV;
  72 }
  73 else {
  74     print STDERR "Please input filenames:\n";
  75     while(<STDIN>) {
  76         chomp;
  77         push @files,$_;
  78     }
  79 }
  80
  81
  82 my $dfile=0;
  83 foreach my $old(grep !/^\.\.?$/,@files) {
  84     my $new = &s_code($old);
  85     if($new eq $old) {
  86         next;
  87     }
  88     if(-e $new) {
  89         $dfile++;
  90         print STDERR $dfile,"\"$old\"\n\t->\"$new\" [Failed:File exists]\n";
  91         next;
  92     }
  93     if($test) {
  94         print STDERR ("\"$old\"\n\t->\"$new\" (Test only) [Sucessed!]\n");
  95     }
  96     else {
  97         if(&my_rename($old,$new)) {
  98             print STDERR ("\"$old\"\n\t->\"$new\" [Sucessed!]\n");
  99         }
 100         else {
 101             print STDERR ("\"$old\"\n\t->\"$new\" [Failed:$!]\n");
 102         }
 103     }
 104 }