source:
lab.git/misc/findcombinable.pl
@
6473c3b
| Last change on this file since 6473c3b was 7ec37bd, checked in by mitty <mitty@…>, 13 years ago | |
|---|---|
|
|
| File size: 996 bytes | |
| Rev | Line | |
|---|---|---|
| [68d6d5b] | 1 | #! /usr/bin/perl -w |
| 2 | ||
| 3 | use strict; | |
| 4 | use warnings; | |
| 5 | use utf8; | |
| 6 | ||
| [e4e7407] | 7 | use Encode; |
| [2526624] | 8 | use Unicode::Normalize qw(NFC); |
| [68d6d5b] | 9 | |
| 10 | my $top = shift @ARGV || exit; | |
| 11 | if (! -d $top) { exit; } | |
| 12 | ||
| [e4e7407] | 13 | my $utf8 = find_encoding("utf8"); |
| 14 | ||
| [68d6d5b] | 15 | checkdir($top); |
| 16 | ||
| [1f4b1b5] | 17 | sub match { |
| [68d6d5b] | 18 | my $str = shift @_; |
| 19 | ||
| [2526624] | 20 | $str = $utf8->decode($str); |
| [68d6d5b] | 21 | if ($str ne NFC($str)) { |
| [7ec37bd] | 22 | return $utf8->encode(NFC($str)); |
| [68d6d5b] | 23 | } |
| 24 | ||
| 25 | return ''; | |
| 26 | } | |
| 27 | ||
| 28 | sub checkdir { | |
| 29 | my $target = shift @_; | |
| 30 | ||
| [dfae53c] | 31 | print STDERR "# checking '$target'\n"; |
| [68d6d5b] | 32 | opendir(my $dir, $target) || return $target; |
| [0e3de64] | 33 | my @entries = sort grep { !m/^(\.|\.\.)$/g } readdir($dir); |
| [68d6d5b] | 34 | closedir($dir); |
| 35 | ||
| 36 | my @dirs; | |
| 37 | while (my $entry = shift @entries) { | |
| [7ec37bd] | 38 | if (my $composed = match($entry)) { |
| 39 | print "'$target/$entry' can be composed to '$composed'\n"; | |
| [68d6d5b] | 40 | next; |
| 41 | } | |
| 42 | if (-d "$target/$entry") { | |
| 43 | push @dirs, $entry; | |
| 44 | next; | |
| 45 | } | |
| 46 | } | |
| 47 | ||
| 48 | while (my $entry = pop @dirs) { | |
| 49 | checkdir("$target/$entry"); | |
| 50 | } | |
| 51 | } |
Note: See TracBrowser
for help on using the repository browser.
