mk-list

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Getopt::Long;
   7
   8 Getopt::Long::Configure ("bundling");
   9
  10 my $with_variants;
  11 my $file_names_only;
  12 my $dir;
  13 my $no_implied;
  14 my $variants_str;
  15 my $accents;
  16
  17 sub usage() {
  18     print STDERR "$0 [-v#] [<options>] <spelling categories> <size>\n";
  19     exit 1;
  20 }
  21
  22 GetOptions ("dir|d=s", \$dir,
  23             "with-variants|v=i", => \$with_variants,
  24             "variants=s", \$variants_str,
  25             "file-names-only|f", \$file_names_only,
  26             "no-implied", \$no_implied,
  27             "accents=s", \$accents) or usage();
  28 $dir = "final" unless defined $dir;
  29
  30 die "Cannot specify both --file-names-only and --accents" if $file_names_only && $accents;
  31
  32 my %spelling_map = qw(en-us american en-gb british? en-gb-ise british
  33                       en-gb-ize british_z en-gb-oed british_z en-ca canadian en-au australian);
  34 $spelling_map{$_} = $_
  35     foreach (qw(english special american british canadian
  36                 variant_1 variant_2 variant_3
  37                 british_variant_1 british_variant_2
  38                 canadian_variant_1 canadian_variant_2
  39                 australian_variant_1 australian_variant_2));
  40
  41 die "Cannot specify both --with-variants and --variants" if $with_variants && $variants_str;
  42 $variants_str = "non" unless defined $variants_str || defined $with_variants;
  43 $variants_str = join(',', 'non', 1..$with_variants) if defined $with_variants;
  44 my %use_variant_level;
  45 foreach (split ',', $variants_str) {
  46     die "Invalid variant num: $_" unless /^(non|[123])$/;
  47     $use_variant_level{$_} = 1;
  48 }
  49
  50 $no_implied = 1 unless $use_variant_level{non};
  51
  52 usage unless @ARGV >= 2;
  53
  54 my $SIZE = pop @ARGV;
  55 die "Invalid size: $SIZE\n" unless $SIZE =~ /^\d\d$/;
  56
  57 my @SPS = map {my $sp = $_;
  58                $sp =~ tr/_/-/;
  59                $sp = $spelling_map{lc $sp};
  60                die "Must specify en_GB-ise or en_GB-ize\n"
  61                    if $sp eq 'british?' && $use_variant_level{non};
  62                $sp = 'british' if $sp eq 'british?';
  63                die "Unknown spelling category: $_\n" unless defined $sp;
  64                $sp;} @ARGV;
  65 my %SPS;
  66 $SPS{$_} = 1 foreach (@SPS);
  67
  68 $SPS{english} = 1 unless $no_implied;
  69 $SPS{special} = 1 unless $no_implied;
  70
  71 $SPS{variant_1} = 1 if $SPS{american} && $use_variant_level{1};
  72 $SPS{variant_2} = 1 if $SPS{american} && $use_variant_level{2};
  73 $SPS{british_variant_1} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{1};
  74 $SPS{british_variant_2} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{2};
  75 $SPS{canadian_variant_1} = 1 if $SPS{canadian} && $use_variant_level{1};
  76 $SPS{canadian_variant_2} = 1 if $SPS{canadian} && $use_variant_level{2};
  77 $SPS{australian_variant_1} = 1 if $SPS{australian} && $use_variant_level{1};
  78 $SPS{australian_variant_2} = 1 if $SPS{australian} && $use_variant_level{2};
  79 $SPS{variant_3} = 1 if $use_variant_level{3};
  80
  81 unless ($use_variant_level{non}) {
  82     delete $SPS{$_} foreach (@SPS);
  83 }
  84
  85 opendir D, $dir or die "Unable to open dir $dir\n";
  86
  87 my @words;
  88
  89 sub deaccent($) {
  90     local $_ = $_[0];
  91     # from deaccent-toperl.cc
  92     # the line is encoded in iso-8859-1 to match the input encoding:
  93     tr/ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüýÿ/AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy/;
  94     return $_;
  95 }
  96 my $add_word;
  97 if (!defined($accents) || $accents eq 'keep') {
  98     $add_word = sub {push @words, $_[0]};
  99 } elsif ($accents eq 'strip') {
 100     $add_word = sub {push @words, deaccent($_[0])};
 101 } elsif ($accents eq 'both') {
 102     $add_word = sub {push @words, $_[0];
 103                      my $new_word = deaccent($_[0]);
 104                      push @words, $new_word if $new_word ne $_[0];}
 105 } else {
 106     die "--accents must be one of: keep, strip, both\n";
 107 }
 108
 109 my @files = readdir(D);
 110
 111 foreach (sort @files) {
 112     my ($sp, $type, $size) = /^(\w+)-([^.]+)\.(\d\d)/ or next;
 113     next unless $SPS{$sp};
 114     next unless $size <= $SIZE;
 115     if ($file_names_only) {
 116         print "$_\n";
 117     } else {
 118         open F, "$dir/$_" or die "Unable to open $dir/$_ for reading";
 119         while (<F>) {
 120             chop;
 121             $add_word->($_);
 122         }
 123     }
 124 }
 125
 126 my $prev = '';
 127 foreach (sort @words) {
 128     next if $_ eq $prev;
 129     print "$_\n";
 130     $prev = $_;
 131 }
 132