#!/bin/perl
#
# wordlist_cleanup [-d] [file...]
#
# Clean up a sorted word list, that is to be used for passphrase generation
# so as to...
#
#   1/ Sorting of input ("sort -f")
#
#   2/ remove duplicated ("uniq -i") keeping the first (capitalised) word
#
#   3/ Remove words which have a 'common suffix' to a previous word
#      Such as plurals ('s', 'es'), verb ('ed', 'ing') and adjectives ('ly')
#      For example:  zoo, zoos => remove zoos
#
#   4/ Remove words which are a prefix of a later word. (unless '-p' option)
#      For example:  zoo zookeeper => remove zoo
#
# All tests being done case-insensitive, allowing capitalized names, and
# acronyms to be retained.
#
# Test list...
#   echo 'Zoo zoomy zoos Zoomy zoom zoomly' | tr ' ' '\012' |
#      wordlist_cleanup -d
#   # => Zoomy
#
# Anthony Thyssen,  30 May 2021
#

$DEBUG=0;
if ( $ARGV[0] eq '-d' ) {
  $DEBUG=1; shift;
}
if ( $ARGV[0] eq '-p' ) {
  $preserve_prefix_words=1; shift;
}

@suffixes = qw( s es ing ed ly );

# sort input, case insensitive (EG: aa Ac acd Acde acde ad)
open(SORT,"-|") or exec( "sort", "-f", @ARGV ) or exit(1);
chop( @words = <SORT> );
close(SORT);

# print join("\n", @words), "\n" if $DEBUG;

while( $prefix = shift((@words)) ) {

  #print STDERR "---\nPREFIX $prefix\n" if $DEBUG;
  $is_prefix_word = 0;

  for($i=0; $word = $words[$i]; ) {
    #print STDERR "INPUT  $word\n" if $DEBUG;

    # is there a common prefix
    last if lc($prefix) ne lc(substr($word,0,length($prefix)));

    # get the suffix component
    $suffix = substr($word,length($prefix));
    #print STDERR "SUFFIX $prefix-$suffix\n"  if $DEBUG;

    # remove duplicate (later words)
    unless( length $suffix ) {
      print STDERR ("remove duplicate $prefix-$suffix\n")  if $DEBUG;
      splice(@words,$i,1);
      next;
    }

    # remove common suffixes
    if ( grep {$suffix eq $_} @suffixes ) {
      print STDERR ("remove suffix word $prefix-$suffix\n")  if $DEBUG;
      splice(@words,$i,1);
      next;
    }

    # remove prefix if word not removed
    unless ( $is_prefix_word++ ) {
      print STDERR ("remove prefix word for $prefix-$suffix\n") if $DEBUG;
    }
    $i++;
  }

  # output word if it was not a prefix of later words (option -p overrides)
  print "$prefix\n" if !$is_prefix_word or $preserve_prefix_words
}

