src/find-ss

   1 #!/usr/bin/perl
   2
   3 sub strip_plurel()
   4 {
   5     local $_ = $_[0];
   6     my @l;
   7     push @l, "$1y" if /^(.+)[iI]es$/;
   8     push @l, $1    if /^(.+)es$/;
   9     push @l, $1    if /^(.+?)\'?s$/;
  10     return @l;
  11 }
  12
  13 # STDIN contains the the list of words which contain the base forms
  14
  15 while (<STDIN>) {
  16     print unless $ARGV[1] eq "noecho";
  17     chop;
  18     $lookup{$_} = 1;
  19 }
  20
  21 # ARGV[0] is the file of words with possible 's's that we want to
  22 # extract provided the base from is was in the above list
  23
  24 open IN, $ARGV[0] or die;
  25
  26 while (<IN>) {
  27     chop;
  28     my $print = 0;
  29     foreach $s (&strip_plurel($_))
  30     {
  31         if (exists $lookup{$s})
  32         {
  33             $print = 1;
  34         }
  35     }
  36     print "$_\n" if $print;
  37 }
  38
  39
  40
  41
  42
  43
  44