C<$x = /(.)/> ne C<($x) = /(.)/>
[p5sagit/p5-mst-13.2.git] / win32 / sncfnmcs.pl
CommitLineData
3b48d85d 1=comment
2
3Synchronize filename cases.
4This script takes two arguments - first and second extensions to synchronize
5filename cases with.
6
7There may be specified following options:
8 --verbose <== say everything what is going on
9 --recurse <== recurse subdirectories
10 --dummy <== do not perform actual renaming
11 --say-subdir
12Every such option can be specified with an optional "no" prefix to negate it.
13
14Typically, it is invoked as:
15 perl sync-fnamescase.pl c obj --verbose
16
17=cut
18
19use strict;
20
21my ($ext1, $ext2) = map {quotemeta} grep {!/^--/} @ARGV;
22my %opts = (
23 #defaults
24 'verbose' => 0,
25 'recurse' => 1,
26 'dummy' => 0,
27 'say-subdir' => 0,
28 #options itself
29 (map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth
30 (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt --no-opt --noopt
31 );
32
33my $sp = '';
34sub xx {
35 opendir DIR, '.';
36 my @t = readdir DIR;
37 my @f = map {/^(.*)\.$ext1$/i} @t;
38 my %f = map {lc($_)=>$_} map {/^(.*)\.$ext2$/i} @t;
39 for (@f) {
40 my $lc = lc($_);
41 if (exists $f{$lc} and $f{$lc} ne $_) {
42 print STDERR "$sp$f{$lc}.$ext2 <==> $_.$ext1\n" if $opts{verbose};
43 if ($opts{dummy}) {
44 print STDERR "ren $f{$lc}.$ext2 $_.$ext2\n";
45 }
46 else {
47 system "ren $f{$lc}.$ext2 $_.$ext2";
48 }
49 }
50 }
51 if ($opts{recurse}) {
52 for (grep {-d&&!/^\.\.?$/} @t) {
53 print STDERR "$sp\\$_\n" if $opts{'say-subdir'};
54 $sp .= ' ';
55 chdir $_ or die;
56 xx();
57 chdir ".." or die;
58 chop $sp;
59 }
60 }
61}
62
63xx();