File Coverage

blib/lib/Text/TransMetaphone.pm

Criterion	Covered	Total	%
statement	51	57	89.4
branch	18	40	45.0
condition			n/a
subroutine	9	10	90.0
pod	2	4	50.0
total	80	111	72.0

package Text::TransMetaphone;
use base qw(Exporter);

use utf8;
BEGIN
{
use strict;
use vars qw($VERSION @EXPORT_OK %LocaleRanges);

	$VERSION = "0.07";

	@EXPORT_OK = qw( trans_metaphone reverse_key );

	%LocaleRanges = ();
}


sub guess_locale
{
my ($word) = @_;

	my $locale;
	$word =~ /(\p{IsLetter})/;
	my $char =  $1;  # grab first letter

	#
	# check ranges of registered locales
	#
	foreach (keys %LocaleRanges) {
		$locale = $_  if ( $char =~ /$LocaleRanges{$_}/ );
	}
	unless ( $locale ) {
		$locale = "am"    if ( $char =~ /\p{InEthiopic}/   );
		$locale = "ar"    if ( $char =~ /\p{InArabic}/     );
		$locale = "ch"    if ( $char =~ /\p{InCherokee}/   );
		$locale = "el"    if ( $char =~ /\p{InGreekAndCoptic}/ );
		$locale = "en_US" if ( $char =~ /\p{InBasicLatin}/ );
		$locale = "gu"    if ( $char =~ /\p{InGujarati}/   );
		$locale = "he"    if ( $char =~ /\p{InHebrew}/     );
		$locale = "ja_hiragana" if ( $char =~ /\p{InHiragana}/ );
		$locale = "ja_katakana" if ( $char =~ /\p{InKatakana}/ );
		$locale = "ru"    if ( $char =~ /\p{InCyrillic}/   );
	}

$locale;

}


sub list_locales
{
	keys %LocaleRanges;
}


sub trans_metaphone
{
my $word = shift;
my $locale = (@_) ? shift : guess_locale ( $word );


	die "No locale identified for $word.  Locale must be specified." unless ( $locale );

	unless ( exists($LocaleRanges{$locale}) ) {
		my $module = "Text::TransMetaphone::$locale";
		eval "require $module;"
		|| die "Unable to load Text::TransMetaphone::$locale : $@";

		$LocaleRanges{$locale} = ${"Text::TransMetaphone::${locale}::LocaleRange"};
	}

	my @keys = &{"Text::TransMetaphone::${locale}::trans_metaphone"} ( $word );

	( wantarray ) ? @keys : $kesy[0];
}


sub reverse_key
{
my ($word, $locale) = @_;

	die "No locale identified for $word.  Locale must be specified." unless ( $locale );

	unless ( exists($LocaleRanges{$locale}) ) {
		my $module = "Text::TransMetaphone::$locale";
		eval "require $module;"
		|| die "Unable to load Text::TransMetaphone::$locale : $@";

		$LocaleRanges{$locale} = ${"Text::TransMetaphone::${locale}::LocaleRange"};
	}

	&{"Text::TransMetaphone::${locale}::reverse_key"} ( $word );

}



#########################################################
# Do not change this, Do not put anything below this.
# File must return "true" value at termination
1;
##########################################################

__END__