| 1 | =comment |
| 2 | |
| 3 | Synchronize filename cases for extensions. |
| 4 | |
| 5 | This script takes two arguments - first and second extensions to |
| 6 | synchronize filename cases with. |
| 7 | |
| 8 | There 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 |
| 13 | Every such option can be specified with an optional "no" prefix to negate it. |
| 14 | |
| 15 | Typically, it is invoked as: |
| 16 | perl sync_ext.pl c obj --verbose |
| 17 | |
| 18 | =cut |
| 19 | |
| 20 | use strict; |
| 21 | |
| 22 | my ($ext1, $ext2) = map {quotemeta} grep {!/^--/} @ARGV; |
| 23 | my %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 | |
| 34 | my $sp = ''; |
| 35 | sub 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 | |
| 64 | xx(); |