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