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