source:
lab.git/misc/findcombinable.pl
@
0e3de64
Last change on this file since 0e3de64 was 0e3de64, checked in by mitty <mitty@…>, 11 years ago | |
---|---|
|
|
File size: 1.0 KB |
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; | |
[0e3de64] | 35 | my @entries = sort grep { !m/^(\.|\.\.)$/g } readdir($dir); |
[68d6d5b] | 36 | closedir($dir); |
37 | ||
38 | my @dirs; | |
39 | while (my $entry = shift @entries) { | |
[e4e7407] | 40 | $entry = $utf8->decode($entry); |
[1f4b1b5] | 41 | if (match($entry)) { |
[68d6d5b] | 42 | print "'$target/$entry' can be composed\n"; |
43 | next; | |
44 | } | |
45 | if (-d "$target/$entry") { | |
46 | push @dirs, $entry; | |
47 | next; | |
48 | } | |
49 | } | |
50 | ||
51 | while (my $entry = pop @dirs) { | |
52 | checkdir("$target/$entry"); | |
53 | } | |
54 | } |
Note: See TracBrowser
for help on using the repository browser.