File Coverage

blib/lib/Text/WagnerFischer/Amharic.pm

Criterion	Covered	Total	%
statement	41	48	85.4
branch	11	20	55.0
condition	6	18	33.3
subroutine	8	8	100.0
pod			n/a
total	66	94	70.2

package Text::WagnerFischer::Amharic;
use base qw( Text::WagnerFischer );

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

use Regexp::Ethiopic::Amharic ( 'getForm', 'setForm', ':forms' );

	$VERSION = "0.06";
	#
	# This linking is done so that the export of "distance" works
	# as before:
	#
	*distance = \&Text::WagnerFischer::distance;
	@EXPORT_OK = qw( &distance );


	#
	# "override" the _weight function with the local one:
	#
	*Text::WagnerFischer::_weight = \&_am_weight;


	#
	# Set a new default penalty costs:
	#
	# WagnerFischer   :  equal, insert/delete, mismatch,
	# Right Family but:  phoneme/glyph equiv, zemene, wrong form
	# Right Form but  :  phoneme/glyph equiv, shift slip, wrong base
	#           other :  phoneme equiv
	$Text::WagnerFischer::REFC = [0,2,3, 1,2,1, 1,1,2, 1];


	%IMCapsMismatch =(
		ስ => "ጽ",
		ጽ => "ስ",
		ቅ => "ቕ",
		ቕ => "ቅ",
		ት => "ጥ",
		ጥ => "ት",
		ች => "ጭ",
		ጭ => "ች",
		ን => "ኝ",
		ኝ => "ን",
		ክ => "ኽ",
		ኽ => "ክ",
		ዝ => "ዥ",
		ዥ => "ዝ",
		ጵ => "ፕ",
		ፕ => "ጵ"
	);
}



sub _am_weight
{
my ($x,$y,$refc)=@_;

	my $value;

	# print "Comparing: $x/$y\n";

	if ($x eq $y) {
		$value = $refc->[0];                      #  cost for letter match
	} elsif ( ($x eq '-') or ($y eq '-') ) {
		$value = $refc->[1];                      #  cost for insertion/deletion operation
	} else {
		my $yግዕዝ = setForm ( $y, $ግዕዝ );

		my $yEquiv  = Regexp::Ethiopic::Amharic::getRe ( "[=$yግዕዝ=]" );
		my $yFamily = Regexp::Ethiopic::Amharic::getRe ( "[#$yግዕዝ#]" );

		# print "  $yግዕዝ: $yEquiv / $yFamily\n";
		# print "yEquiv/yFamily:  <$yEquiv><$yFamily>\n";

		if ( $x =~ /$yFamily/ ) {                 #  x & y are in the same family
			if ( $yEquiv && $x =~ /$yEquiv/ ) {
				$value = $refc->[3];      #  phono/glyph equivalence: ኮ/ኰ, ቁ/ቍ
			}
			elsif ( ($x =~ /[ዉው]/) && ($y =~ /[ዉው]/) ) {
				$value = $refc->[3];      #
			}
			elsif ( (getForm($x) > 7) || (getForm($y) > 7) ) {
				$value = $refc->[4];      #  labiovelar mismatch
			}
			else {
				$value = $refc->[5];      #  form mismatch
			}
		} elsif ( getForm($x) == getForm($y) ) {  #  right form, wrong family
			if ( $yEquiv && $x =~ /$yEquiv/ ) {
				$value =  $refc->[6];     #  phono/glyph equivalence: ሳ/ሣ
			}
			else {
				my $xሳድስ = setForm ( $x, $ሳድስ );
				my $yሳድስ = setForm ( $y, $ሳድስ );
				if ( $IMCapsEquivalence{$xሳድስ} eq $yሳድስ ) {
					$value =  $refc->[7];  #  finger slipped on shift key: ት/ጥ
				}
				else {
					$value =  $refc->[8];  #  family mismatch
				}
			}
		} elsif ( $yEquiv && $x =~ /$yEquiv/ ) {  #  different family, differnt form but related: ሀ/ሐ/ኀ/ሃ/ሓ/ኃ/ኻ
			$value =  $refc->[9];
		} else {
			$value = $refc->[2];              #  cost for letter mismatch
		}
	}

	# print "Comparing: $x/$y => $value\n";
	$value;
}


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

__END__