#!/usr/bin/perl

# Copyright (c) 2010, Douglas Haber
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above
#       copyright notice, this list of conditions and the following
#       disclaimer in the documentation and/or other materials provided
#       with the distribution.
#     * The names names of the authors may not be used to endorse or
#       promote products derived from this software without specific
#       prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND ITS
# CONTRIBUTERS ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR ITS
# CONTRIBUTERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
# OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

use strict;

# witty
#  This script takes a word list and then tries to find words that
#  can be placed together to make new words based on the specified
#  rules.   For example:
#       wonderland + landmark = wonderlandmark
#       abundance + ancestors = abundancestors
#       geocentric + trickery = geocentrickery
#       motherland + landfill = motherlandfill
#
#  Inspired by Freud's "Wit and Its Relation to the Unconscious"

my $DICTIONARY = "/usr/share/dict/words"; # Dictionary file to use
my $REAR_CONNECT = 4; # How many letters from the end of one word
                    # should connect into the new word.
my $MIN_START = 4; # Minimum length of the base string
my $MIN_END = 4;   # Minimum length of the end of the second string
my $VERBOSE = 1; # Shall we explain what words it came from?

sub read_words {
    my @words;

    open(FD,"<$DICTIONARY")
	or die "ERROR: Can not open file '$DICTIONARY'\n";
    @words = <FD>;
    close(FD);

    return(\@words);
}

sub check_word {
    # Find matches for the word
    my ($wordlist, $word1, $start, $end) = @_;
    my $word2;

    foreach $word2 (@$wordlist) {
	my ($head, $tail) = $word2 =~ /^(\w{$REAR_CONNECT})(\w+)\n?$/;
	if($head && $tail) {
	    $head = lc($head);
	    $tail = lc($tail);

	    if(($head eq $end) && (length($tail) >= $MIN_END)) {
		$word1 = lc($word1);
		$word2 = lc($word2);

		if($VERBOSE) {
		    chomp($word1); chomp($word2);
		    print "$word1 + $word2 = ${start}${word2}\n";
		}
		else { print "${start}${word2}\n"; }
	    }
	}
    }
}

sub main {
    my $wordlist = read_words();
    my $word1;

    foreach $word1 (@$wordlist) {
	my ($start, $end) = $word1 =~ /^(\w+)(\w{$REAR_CONNECT})\n?$/;
	if($end && length($start) > $MIN_START) {
	    $start = lc($start);
	    $end = lc($end);

	    check_word($wordlist, $word1, $start, $end);
	}
    }
}

main();