#!usr/bin/perl

# SurreaLearruS 

use strict;											# as if...
use Net::Dict; # lookups for word type
# use WWW::Gazetteer::HeavensAbove;	#when it works again, random places..
use Lingua::EN::Syllable;
use LWP::Simple;
use Algorithm::Numerical::Shuffle qw /shuffle/;		# Ta Abigail :)

my $place = @ARGV[0] or die "Usage - limerick placename\n";
my $dict = Net::Dict->new('dict.org');
my $prhyme = rhyme($place,'n') or die "No rhyme for $place!\n";
print "found rhyme for $place...\n";
my $place_syll = syllable($place);	
# set up word array, 
my @words;				# thanks to BrowserUK :)
open FILE, '<', '/usr/share/dict/words' or die $!; # I liked Tie::File solution too, 
while(<FILE>) {push @words, tell FILE;}	# but needs permissions to rw dict..
print "loaded words\n";
my %people = (				#people, syllables and s/he
	'lady'=>[2,'s'],
	'woman'=>[2,'s'],
	'man'=>[1],
	'boy'=>[1],
	'girl'=>[1,'s']
);													# etc..
my @people = keys %people;
my $person = $people[int(rand(@people))];
my $psyllables = $people{$person}[0];
my $gender = $people{$person}[1];
my $qualifier = int(rand(2));
if ($qualifier) {
	$person = ((int(rand(2))) ?'old ':'young ').$person;
	$psyllables++;
}
print "got person...\n";
my $conj = ('by','with','in')[int(rand(3))];
my $noun1 = rand_word('n');
print "picked 1st noun...\n";
my ($noun2,$n2rhyme);
while (!$n2rhyme) {
	$noun2 = rand_word('n');
	$n2rhyme = rhyme($noun2,'n');
}
print "picked 2nd noun & rhyme...\n";
my $once = 'once' if ($psyllables + $place_syll) < 4;
print "There $once was ",indef($person)," $person from $place,\n",
	"who ",past(rand_word('v'))," ",indef($noun1)," $noun1 $conj ",indef($prhyme)," $prhyme,\n",
	$gender,"he ",past(rand_word('v'))," ",indef($noun2)," $noun2,\n",
	"and ",past(rand_word('v'))," ",indef($n2rhyme)," $n2rhyme,\n",
	"that ",rand_word('adj')," $person from $place.\n";
close FILE;
exit;

sub rhyme {
	my ($word, $type) = @_;
	my $page = LWP::Simple::get("http://www.rhymezone.com/r/rhyme.cgi?Word=$word&typeofrhyme=perfect&org1=syl&org2=l");
	my @rhymes;
	push @rhymes, $1 while ($page =~ /HREF="d\?u=(\w+?)"/sg);
	@rhymes = shuffle (@rhymes);
	foreach (@rhymes) {
		return $_ if ($_ ne $word && word_type($_) eq $type);
	}
	return 0;
}

sub rand_word {
	my $type = shift();
	my ($word,$t);
	my $start = rand(@words);
	while ($t ne $type) {
		$start = 0 if ($start++ > $#words);
		$word = do{ seek FILE, $words[$start], 0; <FILE>;}; 
		chomp $word;
		next if ($word eq ucfirst($word));#skip proper nouns
		$t = word_type($word);
	}
	$word;
}

#parse Wordnet Definition for 'n 1:' etc...
#will be improved to take all meanings into account - for now just return first one.
sub word_type {
	my $word = shift();
    my $h = $dict->define($word,'wn');
	$h->[0][1] =~ /\b(\w+)\s+1?:/s;
	return $1;
}

sub get_places {	#awww - it was so sweet too...:)
	my ($pattern,$country) = @_;
	my $atlas = WWW::Gazetteer::HeavensAbove->new;
    my @az = $atlas->find($pattern,$country);
	return @az;
}

sub indef {return ((shift =~ /^[aeoiu]/i) ? 'an' : 'a');} #dodgy, but works for most cases :)

sub past {my $v = shift(); return ($v =~/^(.*)y/) ?$1.'ied' : $v .(($v =~/e$/) ? "d":"ed");} # even dodgier!