File Coverage

blib/lib/String/Downgrade/Amharic.pm

Criterion	Covered	Total	%
statement	60	67	89.5
branch	9	18	50.0
condition	1	3	33.3
subroutine	10	10	100.0
pod	0	2	0.0
total	80	100	80.0

package String::Downgrade::Amharic;

# If either of these next two lines are inside
# the BEGIN block the package will break.
#
use utf8;
use Regexp::Ethiopic::Amharic qw(:forms overload setForm subForm);

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

	$VERSION = "0.03";

	@EXPORT = qw( &downgrade );

	%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 $to = subForm ( 'ሀ', $from );
			my $compliment = ( $from =~ /[#ኀ#]/ ) ? "ሐ" : "ኀ" ;
			$to .= subForm ( $compliment, $from );
			_downgradeMultiTarget ( \@list, \$re, $from, $to );
		}
		if ( /([ሐኀኃሓኻኍ])/ ) {
			my $to = $HaMaps{$1};
			_downgradeMultiTarget ( \@list, \$re, $1, $to );
		}
	}


	( @list, $re );
}



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

__END__