1: #!/usr/bin/perl -w
   2: 
   3: # here is my take on a very well worn theme
   4: # this script will rename all the files of a given extension
   5: # in a given directory to a new extension and then offers the 
   6: # option to copy them to a new directory with or without
   7: # deleting the originals. Interface is via prompts.
   8: 
   9: use strict;
  10: use Fcntl qw(:flock);
  11: 
  12: my ($dir, $new_dir, $from, $to);
  13: my $flock   = 0;    # set to 1 to flock
  14: my $timeout = 10;   # timout waiting for flock
  15: 
  16: until ($dir) {
  17:     print 'Enter dir for renaming: ';
  18:     chomp ($dir = <STDIN>);
  19:     $dir =~ tr|\\|/|;
  20:     unless (-d $dir) {
  21:         print "Directory $dir does not exist\n";
  22:         $dir = '';
  23:     }
  24: }
  25: $dir .= '/' unless $dir =~ m|/$|;
  26: 
  27: until ($from) {
  28:     print 'Rename from: ';
  29:     chomp ($from = <STDIN>);
  30:     my $count = 0;
  31:     while(<$dir*$from>) {$count++}
  32:     unless ($count) {
  33:         print "There are no files in $dir that match *$from\n";
  34:         $from = '';
  35:     }
  36: }
  37: 
  38: print 'Rename to: ';
  39: chomp ($to = <STDIN>);
  40: 
  41: my $count = 0;
  42: while (<$dir*$from>) {
  43:     my ($old,$new);
  44:     $old = $new = $_;
  45:     $new =~ s/$from$/$to/;
  46:     unless (exist($new)) {      
  47:        if (rename $old, $new) { 
  48:            print "Renamed $old to $new\n";
  49:            $count++;
  50:        }
  51:        else {
  52:            warn "Unable to rename $old to $new $!\n";
  53:        }
  54:     }
  55: }
  56: print "Renamed $count files\n";
  57: exit unless $count;
  58: 
  59: print "Do you want to copy the renamed files to a new dir?\n";
  60: print "Enter a new dir to copy or just hit enter to not copy: ";
  61: chomp ($new_dir = <STDIN>);
  62: exit unless $new_dir;
  63: $new_dir =~ tr|\\|/|;
  64: $new_dir .= '/' unless $new_dir =~ m|/$|;
  65: 
  66: print "Delete old files in $dir after copying (y/n) ";
  67: my $delete = (<STDIN> =~ m/^y/) ? 1 : 0;
  68: 
  69: makedir($new_dir);
  70: move($delete);
  71: exit;
  72: 
  73: ##################################################################
  74: 
  75: sub makedir {
  76:     my $dir = shift;
  77:   return if -d $dir;
  78:     mkdir $dir or die "Unable to make new dir $dir $!\n";
  79: }
  80: 
  81: sub exist {
  82:     my $file = shift;
  83:     if (-e $file) {
  84:         print "File $file exists, owerwrite (y/n) ";
  85:       return (<> =~ m/^y/i) ? 0 : 1
  86:     }
  87:  return 0;
  88: }
  89: 
  90: sub move {
  91:      my $delete = shift;
  92:      while(<$dir*$to>) {
  93:         my $file = $_;
  94:         (my $newfile) = $file =~ m/$dir(.*)$/;
  95:         $newfile = $new_dir.$newfile;
  96:         unless (exist($newfile)) {
  97:             open(INFILE, "<$file") or die "Unable to open $file $!\n";
  98:             open(OUTFILE, ">$newfile") or die "Unable to open $file $!\n";
  99:             binmode INFILE;
 100:             binmode OUTFILE;
 101:             if ($flock) {
 102:                 my $count = 0;
 103:                 until (flock OUTFILE, LOCK_EX) {
 104:                     sleep 1;
 105:                     die "Can't lock file $newfile: $!\n" if ++$count >= $timeout;
 106:                 }
 107:             } 
 108:             while (read(INFILE, my $buffer, 16384)) {
 109:                 print OUTFILE $buffer;
 110:             } 
 111:             close INFILE;
 112:             close OUTFILE;
 113:             print "Copied  $file to $newfile\n";
 114:             if ($delete) {
 115:                 if (unlink $file) { 
 116:                     print "Deleted $file\n";
 117:                 } else {
 118:                     warn "Unable to delete $file $!\n";
 119:                 }
 120:             }
 121:         }
 122:     }
 123: }