File Coverage

blib/lib/Lingua/EN/Namegame.pm

Criterion	Covered	Total	%
statement	34	36	94.4
branch	9	12	75.0
condition	2	6	33.3
subroutine	6	6	100.0
pod	0	2	0.0
total	51	62	82.2

# Namegame.pm module
#########################################################+
#      From the CONSULTIX "Perl Programming" class      #+
# POB 70563, Seattle WA 98107 USA [e-mail] #+
#  Copyright 1997-2001, Tim Maher. All Rights Reserved  #+
#########################################################+
# Tim Maher, [e-mail]

package	Lingua::EN::Namegame;

use 5.006;	# 5.6.0 needed for "our" keyword
use strict;
use warnings;
use Carp;

require	Exporter;

our @ISA		=	qw(Exporter);
our @EXPORT		=	qw(name2verse);
our @EXPORT_OK		=	qw( );
our $VERSION		= 	'0.05';

our ($SEP);

# name_game
# A program that generates a rhyming verse from a name,
# as in the famous song "The Name Game", by Shirley Ellis

# Inspired by "One-Liner #40", in TPJ #15, Fall 1999, p. 11.
#  by Sean M. Burke:
#   s<^([bcdfghjklmnpqrstvwxyz]*)(\w+).*>
#   <$1$2 $1$2 $1o $1$2 / Bonana-Fanna-Fo-F$2 / Fe Fi Mo M$2 / $1$2!>i;

# Reworked by Tim Maher to comply with the
# rhyming rules of the song, as documented in
# http://www.geocities.com/SunsetStrip/Palladium/1306/shirley.htm.

# GENERAL RULES:
# 1) Say the name twice
#	"Dave  Dave"

# 2) Say "bo" and Name again, replacing Name's first letter by B
#	"Bo Bave"

# 3) Say Banana Fanna Fo Name, replacing Name's first letter by F
#	"banana Fanna Fo Fave"

# 4) Say Fee Fi Mo Name, replacing Name's first letter by M
#	"Fee Fi Mo Mave"

# 5) Say Name once more
#	"Dave"


# ALTERNATE RULES, for Names Starting with B, F, or M
#   (e.g., Marsha)
# 2. B-names; instead of bo Bob, use Bo-ob
# 3. F-names; instead of Banana Fanna Fo Fred
#    -- Banana Fanna Fo-red
# 4. M-names; instead of Fee Fi Mo Marsha -- Fee Fi Mo-arsha


sub name2verse {

	my $name=shift;	# grab the name for making the verse
	my ($f, $s, $i, $rest, $verse);

	# need >= two word-chars, including one vowel
	unless ( defined $name  and
			$name =~ /[a-z][a-z]/i  and
				$name =~/[aeiouy]/i ) {
		carp 'name2verse(): Name needs ',
			'two or more letters ',
			"including one vowel\n";
		return undef;
	}

	local $SEP="\n";	# meant to leak into sub indent() below
	# /^([bcdfghjklmnpqrstvwxyz]*)([a-zA-Z]+)/

	# Grab leading consonants (if present), and following vowels

	$name =~ /^\s*([b-df-hj-np-tv-z]*)([a-z]+)/i  or  return undef;

	$f="\u$1";	# force upper-case; "first" part (includes initial)
	$s="\L$2";	# force lower-case; "second" part
	$i=substr($f,0,1);	# force upper-case; "initial"
	$f ne '' and
		$rest=substr($f,1) . $s;	# "rest" of first part

	#print "I, rest, F, S = $i, $rest, $f, $s\n";
	# print "Using rule #2, for $f/$s\n";

	# Now construct the verse for this name

	# Rule #1: State name twice
	$verse="\u$f$s \u$f$s " . indent();

	# Rule #2: General Case; Rob -> Bo-Bob
	if ($i ne 'B') {
		$verse.="bo \uB$s, " . indent();
	}
	# Rule #2: Special Case For B-names; Bob -> Bo-ob
	else {
		$verse.="${i}o-$rest, " . indent();
	}

	# Rule #3: General Case; Tom -> Fo-Fom
	if ($i ne 'F') {			# Fo Fom
		$verse.="Banana Fanna Fo F$s, " . indent();
	}
	# Rule #3: Special Case for F-names; Fred -> Fo-red
	else {
		$verse.="Banana Fanna ${i}o-$rest, " . indent();
	}
	# Rule #4: General Case; Tom -> Mo-Mom
	if ($i ne 'M') {
		$verse.="Fee Fi Mo M$s\n\t";
	}
	# Rule #4: Special Case for M-names; Marsha -> Mo-arsha
	else {
		$verse.="Fee Fi Mo-$s\n\t";
	}
	$verse.="\U$f$s!";
	return $verse;
}
sub indent { return ${SEP}.=' '; }
1;

__DATA__