7.1/src/remove-plurals

   1 #!/usr/bin/perl
   2
   3 sub strip_plurel()
   4 {
   5     local $_ = $_[0];
   6     my @l;
   7     push @l, "$1y" if /^(.+)ies$/;
   8     push @l, "$1Y" if /^(.+)IES$/;
   9     push @l, $1    if /^(.+)es$/i;
  10     push @l, $1    if /^(.+)s$/i;
  11     return @l;
  12 }
  13
  14 if ($#ARGV == -1) {
  15     $in = STDIN;
  16 } else {
  17     $in = "IN";
  18     open $in, $ARGV[0] or die;
  19 }
  20
  21 while (<$in>) {
  22     chop;
  23     $lookup{$_} = 1;
  24 }
  25
  26 if ($#ARGV == -1) {
  27     $out = STDOUT;
  28 } else {
  29     close $in;
  30     $out = "OUT";
  31     open $out, ">$ARGV[0]" or die;
  32 }
  33
  34 foreach $w (keys lookup)
  35 {
  36     my $dont_print = 0;
  37     foreach $s (&strip_plurel($w))
  38     {
  39         if (exists $lookup{$s})
  40         {
  41             $dont_print = 1;
  42         }
  43     }
  44     print $out "$w\n" unless $dont_print;
  45 }