File Coverage

blib/lib/String/Equivalence/Amharic.pm

Criterion	Covered	Total	%
statement	96	116	82.7
branch	16	34	47.0
condition	1	3	33.3
subroutine	14	17	82.3
pod	5	6	83.3
total	132	176	75.0

package String::Equivalence::Amharic;

# If either of these next two lines are inside
# the BEGIN block the package will break.
#
binmode(STDOUT, ":utf8");
use strict;
use utf8;
use encoding 'utf8';
use Regexp::Ethiopic::Amharic qw(:forms overload setForm subForm %AmharicEquivalence);

BEGIN
{
	use strict;
	use base qw( Exporter );
	use vars qw( $VERSION @EXPORT %HaMaps );

	$VERSION = "0.04";

	@EXPORT = qw( &downgrade &inflate &isEquivalentTo &isReducible &hasEquivalence );

	%HaMaps =(
		ሐ	=> "ኀኃሀሃ",
		ኀ	=> "ሐኃሀሃ",
		ኃ	=> "ኀሐሀሃ",
		ሓ	=> "ሐኀኃሀሃ",
		ኻ	=> "ሀሃ",
		ኍ	=> "ኁሁሑ"
	);
}


sub new
{
	bless ( {}, shift );
}


sub _downgradeMultiTarget
{
my ( $list, $re, $from, $targets ) = @_;

	my @to = split ( //, $targets );
	my @outList = ();

	foreach my $to (@to) {
		my @newList;
		for (my $i=0; $i < @{$list}; $i++) {
			$newList[$i] = $list->[$i];     # copy old list
			$newList[$i] =~ s/$from/$to/;
		}
		push ( @outList, @newList );  # add new keys to old keys
	}
	push ( @{$list}, @outList );  # add new keys to old keys
	$$re =~ s/$from(?!\])/[$from$targets]/;
}


sub _downgrade
{
my ( $list, $re, $from, $to ) = @_;

	unless ( $to ) {
		$to = $from;
		$to =~ tr/ሀሃሗሠ-ሧኣእኧቍኵጕቈኰጐቆኮጎዑዒዔዕዖፀ-ፆኹኺኼኽኾ/ሃሀኋሰ-ሷአእቁኩጉቆኮጎቈኰጐዕኡኢኤእኦጸ-ጾሁሂሄህሆ/;
	}

	my @newList;
	for (my $i=0; $i < @{$list}; $i++) {
		$newList[$i] = $list->[$i];     # copy old list
		$newList[$i] =~ s/$from/$to/;
	}
	push ( @{$list}, @newList );  # add new keys to old keys
	$$re =~ s/$from(?!\])/[$from$to]/;
}


sub downgrade
{
my $self;

	($self, $_) = @_;
	$_ = $self unless ( ref($self) );

	my @list = ( $_ );
	my $re = $_;
	my @letters = split ( // );

	foreach ( @letters ) {
		if ( /([#ሠፀ#]|[ሀሃሗኣእኧቍኵጕቈኰጐቆኮጎዑዒዔዕዖኹኺኼኽኾ])/ ) {
			my $from = $1;
			_downgrade ( \@list, \$re, $from )
				unless ( $from eq "እ" && $re =~ /^እ/ );
		}
		if ( /([ዓዐ])/ ) {
			my $to = ( $1 eq "ዓ" ) ? "አዐ" : "አዓ" ;
			_downgradeMultiTarget ( \@list, \$re, $1, $to );
		}
		if ( /([ሑሒሔሕሖኁኂኄኅኆ])/ ) {
			my $from = $1;
			my $compliment = ( $from =~ /[#ኀ#]/ ) ? "ሐ" : "ኀ" ;
			my $to = subForm ( $compliment, $from ).subForm ( 'ሀ', $from );
			_downgradeMultiTarget ( \@list, \$re, $from, $to );
		}
		if ( /([ሐኀኃሓኻኍ])/ ) {
			my $to = $HaMaps{$1};
			_downgradeMultiTarget ( \@list, \$re, $1, $to );
		}
	}


	wantarray ? ( @list, $re ) : $list[$#list] ;
}


sub isReducible
{
my $self;

	($self, $_) = @_;
	$_ = $self unless ( ref($self) );

	/[#ሐኀሠዐፀ#]|[ቍኍኵጕቈኈኰጐ]/;

}


sub hasEquivalence
{
my $self;

	($self, $_) = @_;
	$_ = $self unless ( ref($self) );

	/[=#ሀሠዐፀ#=]|[=ቍ=]|[=ኍ=]|[=ኵ=]|[=ጕ=]|[=ቈ=]|[=ኈ=]|[=ኰ=]|[=ጐ=]/;
}


sub _inflate
{
my ($re, @words);

	foreach (@_) {
		$re = $_;
		$re =~ s/\[(\w+)\]//;

		my @letters = split ( //, $1 );
		foreach ( @letters ) {
			push ( @words,$re );
			$words[ $#words ] =~ s//$_/;
		}

	}

	if ( $words[0] =~ /\[/ ) {
		push ( @words, _inflate( @words ) );
		@words = grep { !/\[/ } @words;
	}

	return @words;
}


sub inflate
{
my $self;

	($self, $_) = @_;
	$_ = $self unless ( ref($self) );

	my @words = ( $_ );
	my $re = $_;

	my @letters = split ( // );

	foreach ( @letters ) {
		if ( $AmharicEquivalence{$_} ) {
			#
			# these next 3 lines are here to skip over old Amharic
			#
			my $equiv = $AmharicEquivalence{$_};
			$equiv =~ s/[#ኸ#]//g;
			$re =~ s/$_/[$equiv]/g;
			# $re =~ s/$_/[$AmharicEquivalence{$_}]/g;
		}
	}

	if ( $re =~ /\[/ ) {
		push ( @words, _inflate( $re ) );
		@words = grep { !/\[/ } @words;
		push ( @words, $re );
	}

	return @words;
}


sub isEquivalentTo
{
my ($self, $a, $b) = @_;

	unless ( ref($self) ) {
		$b = $a;
		$a = $self;
	}

	my @b = $self->inflate( $b );

	( $a =~ /^$b[$#b]$/ );
}


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

__END__