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);
  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
  40 die "Cannot specify both --with-variants and --variants" if $with_variants && $variants_str;
  41 $variants_str = "non" unless defined $variants_str || defined $with_variants;
  42 $variants_str = join(',', 'non', 1..$with_variants) if defined $with_variants;
  43 my %use_variant_level;
  44 foreach (split ',', $variants_str) {
  45     die "Invalid variant num: $_" unless /^(non|[123])$/;
  46     $use_variant_level{$_} = 1;
  47 }
  48
  49 $no_implied = 1 unless $use_variant_level{non};
  50
  51 usage unless @ARGV >= 2;
  52
  53 my $SIZE = pop @ARGV;
  54 die "Invalid size: $SIZE\n" unless $SIZE =~ /^\d\d$/;
  55
  56 my @SPS = map {my $sp = $_;
  57                $sp =~ tr/_/-/;
  58                $sp = $spelling_map{lc $sp};
  59                die "Must specify en_GB-ise or en_GB-ize\n"
  60                    if $sp eq 'british?' && $use_variant_level{non};
  61                $sp = 'british' if $sp eq 'british?';
  62                die "Unknown spelling category: $_\n" unless defined $sp;
  63                $sp;} @ARGV;
  64 my %SPS;
  65 $SPS{$_} = 1 foreach (@SPS);
  66
  67 $SPS{english} = 1 unless $no_implied;
  68 $SPS{special} = 1 unless $no_implied;
  69
  70 $SPS{variant_1} = 1 if $SPS{american} && $use_variant_level{1};
  71 $SPS{variant_2} = 1 if $SPS{american} && $use_variant_level{2};
  72 $SPS{british_variant_1} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{1};
  73 $SPS{british_variant_2} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{2};
  74 $SPS{canadian_variant_1} = 1 if $SPS{canadian} && $use_variant_level{1};
  75 $SPS{canadian_variant_2} = 1 if $SPS{canadian} && $use_variant_level{2};
  76 $SPS{variant_3} = 1 if $use_variant_level{3};
  77
  78 unless ($use_variant_level{non}) {
  79     delete $SPS{$_} foreach (@SPS);
  80 }
  81
  82 opendir D, $dir or die "Unable to open dir $dir\n";
  83
  84 my @words;
  85
  86 sub deaccent($) {
  87     local $_ = $_[0];
  88     # from deaccent-toperl.cc
  89     # the line is encoded in iso-8859-1 to match the input encoding:
  90     tr/ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüýÿ/AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy/;
  91     return $_;
  92 }
  93 my $add_word;
  94 if (!defined($accents) || $accents eq 'keep') {
  95     $add_word = sub {push @words, $_[0]};
  96 } elsif ($accents eq 'strip') {
  97     $add_word = sub {push @words, deaccent($_[0])};
  98 } elsif ($accents eq 'both') {
  99     $add_word = sub {push @words, $_[0];
 100                      my $new_word = deaccent($_[0]);
 101                      push @words, $new_word if $new_word ne $_[0];}
 102 } else {
 103     die "--accents must be one of: keep, strip, both\n";
 104 }
 105
 106 my @files = readdir(D);
 107
 108 foreach (sort @files) {
 109     my ($sp, $type, $size) = /^(\w+)-([^.]+)\.(\d\d)/ or next;
 110     next unless $SPS{$sp};
 111     next unless $size <= $SIZE;
 112     if ($file_names_only) {
 113         print "$_\n";
 114     } else {
 115         open F, "$dir/$_" or die "Unable to open $dir/$_ for reading";
 116         while (<F>) {
 117             chop;
 118             $add_word->($_);
 119         }
 120     }
 121 }
 122
 123 my $prev = '';
 124 foreach (sort @words) {
 125     next if $_ eq $prev;
 126     print "$_\n";
 127     $prev = $_;
 128 }
 129