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();