Lingua::Rhyme - MySQL-based rhyme-lookups.

	use Lingua::Rhyme;
	$Lingua::Rhyme::chat=1;
	$Lingua::Rhyme::DATABASE = "rhymedict";
	$Lingua::Rhyme::USER	 = "MyUserName";
	$Lingua::Rhyme::PASSWORD = "password";

	Lingua::Rhyme::build('C:/lang/win2k/perl/site/lib/lingua');

	use Lingua::Rhyme;
	$Lingua::Rhyme::DATABASE = "rhymedict";
	$Lingua::Rhyme::USER	 = "MyUserName";
	$Lingua::Rhyme::PASSWORD = "password";

	my @rhymes_for_house = @{ Lingua::Rhyme::simplefind('house') };

	my @rhymes_for_tomAto = @{ Lingua::Rhyme::simplefind('tomato') };

	warn "Test if 'house' rhymes with 'mouse'....\n";
	if (simplematch("house","mouse")){
		warn "They rhyme.\n";
	} else {
		warn "They don't rhyme!";
	}

	warn syllable("contrary");




	__END__

	DBD::mysql::db do failed: Duplicate entry '#?2,M+?*.+' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 13570.
	DBD::mysql::db do failed: Duplicate entry '7*?7\.?/.N' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 16070.
	DBD::mysql::db do failed: Duplicate entry 'E,[' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 20111.
	DBD::mysql::db do failed: Duplicate entry 'E1=' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 20397.
	DBD::mysql::db do failed: Duplicate entry '02)?#D/.?2' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 20623.
	DBD::mysql::db do failed: Duplicate entry 'e,:' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 25587.
	DBD::mysql::db do failed: Duplicate entry 'E)@' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 25605.
	DBD::mysql::db do failed: Duplicate entry 'e):' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 30844.
	DBD::mysql::db do failed: Duplicate entry 'e2:' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 30983.
	DBD::mysql::db do failed: Duplicate entry 'e"[' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 34284.
	DBD::mysql::db do failed: Duplicate entry 'E#,U' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 34545.
	DBD::mysql::db do failed: Duplicate entry 'e4:' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 34637.
	DBD::mysql::db do failed: Duplicate entry '-T2,M+?*.+' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 36221.
	DBD::mysql::db do failed: Duplicate entry '/B+,=' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 41578.
	DBD::mysql::db do failed: Duplicate entry '4T2)A#?/.N' for key 1 at E:\Src\Pl\Text\Rhyme\build.pl line 53, <WORDS> line 41821.

	0.081 Mon Apr 08 19:32 2002
		- fixed buy in syllable

	0.08  Mon Apr 08 19:22 2002
		- tidied up POD and modified param of C<build()>.

	0.07  Fri Jun 01 12:12:00 2001
		- added matchall routine

	0.06  Thu May 31 14:35:00 2001
		- corrected connection bug

	0.05  Thu May 31 13:13:00 2001
		- added multiple.txt db
		- added new functions and renamed old functions

	0.04  Wed May 30 19:01:25 2001
		- completely rewritten - now uses a MySQL DB.
		- moved namespace, as rhyming is now a linguist, not textual, operation (if it ever was).

	0.03  Tue May 29 13:35:12 2001
		- ACTUALLY text-rhyme-0.03
		- added parsing of final consenants. Still I can't spell.

	0.02  Tue May 29 12:32:00 2001
		- ACTUALLY text-rhyme-0.02
		- damn, got the module name wrong!

	0.01  Tue May 29 12:18:12 2001
		- ACTUALLY text-rhyme-0.01
		- original version; created by h2xs 1.20 with options

			-Xcfn Text::Rhyme

#! perl -w
package Lingua::Rhyme;
our $VERSION = 0.092;

use strict;
use warnings;
use DBI();

our $chat;

our $DATABASE = "rhymedict";
our $HOSTNAME = "localhost";
our $PORT     = "3306";
our $USER     = 'NotAdministrator';
our $PASSWORD = 'password';
our $DRIVER   = "mysql";

our $_connected;

sub build {
	local (*WORDS,*RHYMES);
	my ($base, $chat)=('',1);
	if (defined $_[0]){
		$base = shift;
	} else {
		foreach (@INC){
			$base = $_ if /site/;
			last;
		}
	}
	die "Please read the POD and edit the source code to set the database-access variables."
		if (not defined $USER and not defined $PASSWORD);
	die "Could not find words.txt from which to build db!\nDir: $base"
		if not -e "$base/Rhyme/dict/EN/words.txt";
	die "Could not find rhymes.txt from which to build db!\nDir: $base"
		if not -e "$base/Rhyme/dict/EN/rhymes.txt";
	die "Could not find multiple.txt from which to build db!\nDir: $base"
		if not -e "$base/Rhyme/dict/EN/multiple.txt";

	warn "Setting up db connection...\n" if $chat;
	our $dsn = "DBI:$DRIVER:database=$DATABASE;host=$HOSTNAME;port=$PORT";
	our $dbh = DBI->connect($dsn, $USER, $PASSWORD);
	DBI->install_driver("mysql");

	#
	# Create a new tables: **words**
	#
	warn "Building table words...\n" if $chat;
	$dbh->do("DROP TABLE IF EXISTS words");
	$dbh->do("CREATE TABLE words "
			."("
				. "word	char(255) NOT NULL, "
				. "idx	char(10) NOT NULL, "
				. "syllables int NOT NULL, "
				. "PRIMARY KEY(word) "
			. ")"
	);

	open WORDS,"$base/Rhyme/dict/EN/words.txt" or die "Couldn't find words.txt from which to build db table!";
	while (<WORDS>){
		my ($word, $idx, $syllables) = split /\s/,$_;
		$dbh->do("INSERT INTO words (word,idx,syllables) VALUES ( " .$dbh->quote($word).",".$dbh->quote($idx).",$syllables)");
	}
	close WORDS;

	#
	# Create a new tables: **rhymes**
	#
	warn "Building table rhymes...\n" if $chat;
	$dbh->do("DROP TABLE IF EXISTS rhymes");
	$dbh->do("CREATE TABLE rhymes "
			."("
				. "idx	char(10) NOT NULL, "
				. "rhymes text NOT NULL, "
				. "PRIMARY KEY(idx) "
			. ")"
	);

	open RHYMES,"$base/Rhyme/dict/EN/rhymes.txt" or die "Couldn't find rhymes.txt from which to build db table!";
	while (<RHYMES>){
		my ($idx, $rhymes) = split /\s/,$_,2;
		$dbh->do("INSERT INTO rhymes (idx,rhymes) VALUES ( " .$dbh->quote($idx).",".$dbh->quote($rhymes).")");
	}
	close WORDS;


	#
	# Create a new tables: **multiple**
	#
	warn "Building table multiple...\n" if $chat;
	$dbh->do("DROP TABLE IF EXISTS multiple");
	$dbh->do("CREATE TABLE multiple "
			."("
				. "word	char(255) NOT NULL, "
				. "multiples text NOT NULL, "
				. "PRIMARY KEY(word) "
			. ")"
	);

	open MULTIPLE,"$base/Rhyme/dict/EN/multiple.txt" or die "Couldn't find multiple.txt from which to build db table!";
	while (<MULTIPLE>){
		my ($word, $multiples) = split /\s/,$_,2;
		$dbh->do("INSERT INTO multiple (word,multiples) VALUES ( " .$dbh->quote($word).",".$dbh->quote($multiples).")");
	}
	close WORDS;

	warn "All built without problems, disconnecting...\n" if $chat;
	$dbh->disconnect();
	warn "...disconnected from db.\n" if $chat;
} # End sub build




#
# Private subroutine _connect just sets up the dbh is not already done so
# stores in global $_connected
#
sub _connect {
	if (defined $_connected) {
		#warn "Already connected to db.\n" if $chat; return $_connected
	}
	die "Please read the POD and edit the source code to set the database-access variables."
		if (not defined $USER and not defined $PASSWORD);
	warn "Connecting to db...\n" if $chat;
	my $dsn = "DBI:$DRIVER:database=$DATABASE;host=$HOSTNAME;port=$PORT";
	my $dbh = DBI->connect($dsn, $USER, $PASSWORD);
	DBI->install_driver("mysql");
	$_connected = $dbh;
	return $dbh;
}

#
# Private subroutine _disconnect disconnects the global connection if it exists, otherwise
# can disconnect a specific dbh if passed.
#
sub _disconnect {
	warn "Disconnecting from db.\n" if $chat;
	if (defined $_connected) { $_connected->disconnect() }
	else { $_[0]->disconnect() }
}

sub simplefind { my ($lookup) = (uc shift);
	unless (defined $lookup) {
		warn "&simplefind requires a scalar to lookup as its sole argument.";
		return undef;
	}
	$_ = _simplefind(_connect,$lookup);
	_disconnect;
	return $_;
}


#
# Privaet sub _simplefind same as public simplefind but doesn't connect/disconnect
# Accepts: dbh ref, scalar for word to lookup
# Returns: ref to array
#
sub _simplefind { my ($dbh,$lookup) = (shift,shift);
	my $sth;
	my $rhymes_ref;
	die "_simplefind requires 2 args " unless defined $dbh and defined $lookup;
	warn "Looking up '$lookup' ... \n" if $chat;
	$sth = $dbh->prepare("SELECT idx FROM words WHERE word = ".$dbh->quote($lookup) );
	$sth->execute();
	my $idx_ref = $sth->fetchrow_arrayref();
	warn "... and got @$idx_ref\n" if defined $idx_ref and $chat;
	$sth->finish();
	if (defined $idx_ref){
		warn "Looking up index '@$idx_ref' ...\n"  if $chat;
		$sth = $dbh->prepare("SELECT rhymes FROM rhymes WHERE idx = ".$dbh->quote(@$idx_ref) );
		$sth->execute();
		if  ($rhymes_ref = $sth->fetchrow_arrayref() ) {
			chomp @$rhymes_ref;
			warn "... and got '@$rhymes_ref'\n"  if $chat;
		} else {
			warn "... and got nothing!\n"  if $chat;
		}
		$sth->finish();
		@$rhymes_ref[0] =~ s/\(\d+\)//g;	# Remove number refs
		@_ = split' ',@$rhymes_ref[0];
	} else {
		@_ = ();
		warn "Got nothing from db for '$lookup'.\n" if $chat
	}
	return \@_;
}

sub findall { my ($lookup) = (uc shift);
	unless (defined $lookup) {
		warn "&findall requires a scalar to lookup as its sole argument.";
		return undef;
	}
	my @found = ();
	my $sth;
	my $dbh = _connect;

	warn "Looking up '$lookup' in multiple db  ... \n" if $chat;
	$sth = $dbh->prepare("SELECT multiples FROM multiple WHERE word = ".$dbh->quote($lookup) );
	$sth->execute();
	my $lookup_ref = $sth->fetchrow_arrayref();
	warn "... and got @$lookup_ref\n" if $chat and defined $lookup_ref;
	$sth->finish();

	# Not in mulitple table, try words table by setting the value explicitly
	$lookup_ref = [$lookup] if (not defined $lookup_ref);

	foreach my $lookup (split' ',@$lookup_ref[0]){
		push @found, @{_simplefind($dbh, $lookup)};
	}

	_disconnect();

	# Remove duplicates
	my %dropdupes = map { $_ => 1 } @found;
	@found = sort keys %dropdupes;

	return \@found;
}

sub simplematch { my ($lookup,$against) = (uc shift, uc shift);
	unless (defined $lookup or not defined $against) {
		warn "&lookup requires a scalar to lookup, and a scalar to match against as its two arguments.";
		return undef;
	}
	my $found;
	my $dbh = _connect;
	foreach (@{_simplefind($dbh,$lookup)}) {
		if ($_ eq $against){
			$found = 1;
			last;
		}
	}
	_disconnect($dbh);
	return $found;
}

sub matchall {
	my @words;
	($words[0],$words[1]) = (uc $_[0], uc $_[1]);
	unless (defined $words[0]and defined $words[1]) {
		warn "&findall requires two scalars to lookup as its two arguments.";
		return undef;
	}
	my $success;	# undef
	my @found = {};
	my $sth;
	my $dbh = _connect;

	CHECKBOTH:
	for my $i (0..1){
		warn "Looking up word $i ('$words[$i]') in multiple db  ... \n" if $chat;
		$sth = $dbh->prepare("SELECT multiples FROM multiple WHERE word = ".$dbh->quote($words[$i]) );
		$sth->execute();
		my $lookup_ref = $sth->fetchrow_arrayref();
		warn "... and got @$lookup_ref\n" if $chat and defined $lookup_ref;
		$sth->finish();

		# Not in mulitple table, try words table by setting the value explicitly
		$lookup_ref = [$words[$i]] if (not defined $lookup_ref);

		foreach my $lookup (split' ',@$lookup_ref[0]){
			foreach ( @{_simplefind($dbh, $lookup)} ){
				$found[$i]{$_} = 1;
				if (exists $found[$i]{$words[0]} and exists $found[$i]{$words[1]}){
					$success = 1;
					last CHECKBOTH;
				}
			}
		}
	}
	_disconnect();
	return $success;
}

sub syllable { my ($lookup) = (uc shift);
	my $s = _syllable(_connect,$lookup);
	_disconnect;
	return $s;
}



#
# Private sub _syllable
# Accepts dbh and word to lookup
# Returns number of syllables id'ed in db for word to lookup, or undef
#
sub _syllable { my ($dbh,$lookup) = (shift,shift);
	my $sth;
	my $rhymes_ref;
	warn "Looking up '$lookup' ... \n" if $chat;
	$sth = $dbh->prepare("SELECT syllables FROM words WHERE word = ".$dbh->quote($lookup) );
	$sth->execute();
	my $syl_ref = $sth->fetchrow_arrayref();
	warn "... and got @$syl_ref[0] syllable\n" if defined $syl_ref and $chat;
	return defined $syl_ref? @$syl_ref[0]  : undef;
}














1;
__END__