VMS also should search for extensions in cpan/ as well as ext/
[perl.git] / win32 / sync_ext.pl
1 =comment
2
3 Synchronize filename cases for extensions.
4
5 This script could be used to perform following renaming:
6 if there exist file, for example, "FiLeNaME.c" and
7 filename.obj then it renames "filename.obj" to "FiLeNaME.obj".
8 There is a problem when some compilers (e.g.Borland) generate
9 such .obj files and then "make" process will not treat them
10 as dependant and already maked files.
11
12 This script takes two arguments - first and second extensions to
13 synchronize filename cases with.
14
15 There may be specified following options:
16   --verbose    <== say everything what is going on
17   --recurse    <== recurse subdirectories
18   --dummy      <== do not perform actual renaming
19   --say-subdir
20 Every such option can be specified with an optional "no" prefix to negate it.
21
22 Typically, it is invoked as:
23   perl sync_ext.pl c obj --verbose
24
25 =cut
26
27 use strict;
28
29 my ($ext1, $ext2) = map {quotemeta} grep {!/^--/} @ARGV;
30 my %opts = (
31   #defaults
32     'verbose' => 0,
33     'recurse' => 1,
34     'dummy' => 0,
35     'say-subdir' => 0,
36   #options itself
37     (map {/^--([\-_\w]+)=(.*)$/} @ARGV),                            # --opt=smth
38     (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),  # --opt --no-opt --noopt
39   );
40
41 my $sp = '';
42 sub xx {
43   opendir DIR, '.';
44   my @t = readdir DIR;
45   my @f = map {/^(.*)\.$ext1$/i} @t;
46   my %f = map {lc($_)=>$_} map {/^(.*)\.$ext2$/i} @t;
47   for (@f) {
48     my $lc = lc($_);
49     if (exists $f{$lc} and $f{$lc} ne $_) {
50       print STDERR "$sp$f{$lc}.$ext2 <==> $_.$ext1\n" if $opts{verbose};
51       if ($opts{dummy}) {
52         print STDERR "ren $f{$lc}.$ext2 $_.$ext2\n";
53       }
54       else {
55         system "ren $f{$lc}.$ext2 $_.$ext2";
56       }
57     }
58   }
59   if ($opts{recurse}) {
60     for (grep {-d&&!/^\.\.?$/} @t) {
61       print STDERR "$sp\\$_\n" if $opts{'say-subdir'};
62       $sp .= ' ';
63       chdir $_ or die;
64       xx();
65       chdir ".." or die;
66       chop $sp;
67     }
68   }
69 }
70
71 xx();