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
  16 sub usage() {
  17     print STDERR "$0 [-v#] [<options>] <spelling categories> <size>\n";
  18     exit 1;
  19 }
  20
  21 GetOptions ("dir|d=s", \$dir,
  22             "with-variants|v=i", => \$with_variants,
  23             "variants=s", \$variants_str,
  24             "file-names-only|f", \$file_names_only,
  25             "no-implied", \$no_implied) or usage();
  26 $dir = "final" unless defined $dir;
  27
  28 my %spelling_map = qw(en-us american en-gb british? en-gb-ise british
  29                       en-gb-ize british_z en-gb-oed british_z en-ca canadian);
  30 $spelling_map{$_} = $_
  31     foreach (qw(english special american british canadian
  32                 variant_0 variant_1 variant_2
  33                 british_variant_0 british_variant_1
  34                 canadian_variant_0 canadian_variant_1));
  35
  36 die "Cannot specify both --with-variants and --variants" if $with_variants && $variants_str;
  37 $variants_str = "non" unless defined $variants_str || defined $with_variants;
  38 $variants_str = join(',', 'non', 0..$with_variants) if defined $with_variants;
  39 my %use_variant_level;
  40 foreach (split ',', $variants_str) {
  41     die "Invalid variant num: $_" unless /^(non|[012])$/;
  42     $use_variant_level{$_} = 1;
  43 }
  44
  45 $no_implied = 1 unless $use_variant_level{non};
  46
  47 usage unless @ARGV >= 2;
  48
  49 my $SIZE = pop @ARGV;
  50 die "Invalid size: $SIZE\n" unless $SIZE =~ /^\d\d$/;
  51
  52 my @SPS = map {my $sp = $_;
  53                $sp =~ tr/_/-/;
  54                $sp = $spelling_map{lc $sp};
  55                die "Must specify en_GB-ise or en_GB-ize\n"
  56                    if $sp eq 'british?' && $use_variant_level{non};
  57                $sp = 'british' if $sp eq 'british?';
  58                die "Unknown spelling category: $_\n" unless defined $sp;
  59                $sp;} @ARGV;
  60 my %SPS;
  61 $SPS{$_} = 1 foreach (@SPS);
  62
  63 $SPS{english} = 1 unless $no_implied;
  64 $SPS{special} = 1 unless $no_implied;
  65
  66 $SPS{variant_0} = 1 if $SPS{american} && $use_variant_level{0};
  67 $SPS{variant_1} = 1 if $SPS{american} && $use_variant_level{1};
  68 $SPS{british_variant_0} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{0};
  69 $SPS{british_variant_1} = 1 if ($SPS{british} || $SPS{british_z}) && $use_variant_level{1};
  70 $SPS{canadian_variant_0} = 1 if $SPS{canadian} && $use_variant_level{0};
  71 $SPS{canadian_variant_1} = 1 if $SPS{canadian} && $use_variant_level{1};
  72 $SPS{variant_2} = 1 if $use_variant_level{2};
  73
  74 unless ($use_variant_level{non}) {
  75     delete $SPS{$_} foreach (@SPS);
  76 }
  77
  78 opendir D, $dir or die "Unable to open dir $dir\n";
  79
  80 my @files = readdir(D);
  81
  82 my @words;
  83
  84 foreach (sort @files) {
  85     my ($sp, $type, $size) = /^(\w+)-([^.]+)\.(\d\d)/ or next;
  86     next unless $SPS{$sp};
  87     next unless $size <= $SIZE;
  88     if ($file_names_only) {
  89         print "$_\n";
  90     } else {
  91         open F, "$dir/$_" or die "Unable to open $dir/$_ for reading";
  92         while (<F>) {
  93             chop;
  94             push @words, $_;
  95         }
  96     }
  97 }
  98
  99 my $prev = '';
 100 foreach (sort @words) {
 101     next if $_ eq $prev;
 102     print "$_\n";
 103     $prev = $_;
 104 }
 105
 106
 107
 108
 109
 110