trunk
| Rev | Line | |
|---|
| [68d6d5b] | 1 | #! /usr/bin/perl -w |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | use utf8; |
|---|
| 6 | |
|---|
| [e4e7407] | 7 | use Encode; |
|---|
| [68d6d5b] | 8 | use Unicode::Normalize qw(NFC NFKC); |
|---|
| [e4e7407] | 9 | binmode STDOUT => 'encoding(utf8)'; |
|---|
| 10 | binmode STDERR => 'encoding(utf8)'; |
|---|
| [68d6d5b] | 11 | |
|---|
| 12 | my $top = shift @ARGV || exit; |
|---|
| 13 | if (! -d $top) { exit; } |
|---|
| 14 | |
|---|
| [e4e7407] | 15 | my $utf8 = find_encoding("utf8"); |
|---|
| 16 | $top = $utf8->decode($top); |
|---|
| 17 | |
|---|
| [68d6d5b] | 18 | checkdir($top); |
|---|
| 19 | |
|---|
| [1f4b1b5] | 20 | sub match { |
|---|
| [68d6d5b] | 21 | my $str = shift @_; |
|---|
| 22 | |
|---|
| 23 | if ($str ne NFC($str)) { |
|---|
| 24 | return 1; |
|---|
| 25 | } |
|---|
| 26 | |
|---|
| 27 | return ''; |
|---|
| 28 | } |
|---|
| 29 | |
|---|
| 30 | sub checkdir { |
|---|
| 31 | my $target = shift @_; |
|---|
| 32 | |
|---|
| 33 | print STDERR "checking '$target'\n"; |
|---|
| 34 | opendir(my $dir, $target) || return $target; |
|---|
| 35 | my @entries = sort readdir($dir); |
|---|
| 36 | closedir($dir); |
|---|
| 37 | |
|---|
| 38 | my @dirs; |
|---|
| 39 | while (my $entry = shift @entries) { |
|---|
| 40 | next if ($entry =~ /^\.+$/); |
|---|
| [e4e7407] | 41 | $entry = $utf8->decode($entry); |
|---|
| [1f4b1b5] | 42 | if (match($entry)) { |
|---|
| [68d6d5b] | 43 | print "'$target/$entry' can be composed\n"; |
|---|
| 44 | next; |
|---|
| 45 | } |
|---|
| 46 | if (-d "$target/$entry") { |
|---|
| 47 | push @dirs, $entry; |
|---|
| 48 | next; |
|---|
| 49 | } |
|---|
| 50 | } |
|---|
| 51 | |
|---|
| 52 | while (my $entry = pop @dirs) { |
|---|
| 53 | checkdir("$target/$entry"); |
|---|
| 54 | } |
|---|
| 55 | } |
|---|
Note: See
TracBrowser
for help on using the repository browser.