/usr/local/CPAN/Regexp-Ethiopic/Regexp/Ethiopic.pm

package Regexp::Ethiopic
EOF
package Regexp::Ethiopic;
use base qw(Exporter);

use utf8;
BEGIN
{
use strict;
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS %EthiopicClasses
	                $áŒá‹•á‹ $áŠ«á‹•á‰¥ $áˆ£áˆáˆµ $áˆ«á‰¥á‹• $áŠƒáˆáˆµ $áˆ³á‹µáˆµ $áˆ³á‰¥á‹•
                	$á‹˜áˆ˜á‹°_áŒá‹•á‹ $á‹˜áˆ˜á‹°_áŠ«á‹•á‰¥ $á‹˜áˆ˜á‹°_áˆ£áˆáˆµ $á‹˜áˆ˜á‹°_áˆ«á‰¥á‹• $á‹˜áˆ˜á‹°_áŠƒáˆáˆµ);

	$VERSION = "0.15";
	
	@EXPORT_OK = qw(%EthiopicClasses &getForm &setForm &subForm &formatForms
	                $áŒá‹•á‹ $áŠ«á‹•á‰¥ $áˆ£áˆáˆµ $áˆ«á‰¥á‹• $áŠƒáˆáˆµ $áˆ³á‹µáˆµ $áˆ³á‰¥á‹•
                	$á‹˜áˆ˜á‹°_áŒá‹•á‹ $á‹˜áˆ˜á‹°_áŠ«á‹•á‰¥ $á‹˜áˆ˜á‹°_áˆ£áˆáˆµ $á‹˜áˆ˜á‹°_áˆ«á‰¥á‹• $á‹˜áˆ˜á‹°_áŠƒáˆáˆµ
	);
	%EXPORT_TAGS = ( forms => [qw(
	                 $áŒá‹•á‹ $áŠ«á‹•á‰¥ $áˆ£áˆáˆµ $áˆ«á‰¥á‹• $áŠƒáˆáˆµ $áˆ³á‹µáˆµ $áˆ³á‰¥á‹•
	                 $á‹˜áˆ˜á‹°_áŒá‹•á‹ $á‹˜áˆ˜á‹°_áŠ«á‹•á‰¥ $á‹˜áˆ˜á‹°_áˆ£áˆáˆµ $á‹˜áˆ˜á‹°_áˆ«á‰¥á‹• $á‹˜áˆ˜á‹°_áŠƒáˆáˆµ)],
			 utils => [qw(&getForm &setForm &subForm &formatForms &isFamilyOf)]
	);


%EthiopicClasses =(
	1	=> "áˆ€áˆˆáˆáˆ˜áˆ áˆ¨áˆ°áˆ¸á‰€á‰á‰ á‰¨á‰°á‰¸áŠ€áŠáŠ˜áŠ áŠ¨áŠ¸á‹ˆá‹á‹˜á‹ á‹¨á‹°á‹¸áŒ€áŒˆáŒ˜áŒ áŒ¨áŒ°áŒ¸á€áˆá",
	2	=> "áˆáˆ‰áˆáˆ™áˆ¡áˆ©áˆ±áˆ¹á‰á‰‘á‰¡á‰©á‰±á‰¹áŠáŠ‘áŠ™áŠ¡áŠ©áŠ¹á‹‰á‹‘á‹™á‹¡á‹©á‹±á‹¹áŒáŒ‰áŒ™áŒ¡áŒ©áŒ±áŒ¹áá‰á‘",
	3	=> "áˆ‚áˆŠáˆ’áˆšáˆ¢áˆªáˆ²áˆºá‰‚á‰’á‰¢á‰ªá‰²á‰ºáŠ‚áŠ’áŠšáŠ¢áŠªáŠºá‹Šá‹’á‹šá‹¢á‹ªá‹²á‹ºáŒ‚áŒŠáŒšáŒ¢áŒªáŒ²áŒºá‚áŠá’",
	4	=> "áˆƒáˆ‹áˆ“áˆ›áˆ£áˆ«áˆ³áˆ»á‰ƒá‰“á‰£á‰«á‰³á‰»áŠƒáŠ“áŠ›áŠ£áŠ«áŠ»á‹‹á‹“á‹›á‹£á‹«á‹³á‹»áŒƒáŒ‹áŒ›áŒ£áŒ«áŒ³áŒ»áƒá‹á“",
	5	=> "áˆ„áˆŒáˆ”áˆœáˆ¤áˆ¬áˆ´áˆ¼á‰„á‰”á‰¤á‰¬á‰´á‰¼áŠ„áŠ”áŠœáŠ¤áŠ¬áŠ¼á‹Œá‹”á‹œá‹¤á‹¬á‹´á‹¼áŒ„áŒŒáŒœáŒ¤áŒ¬áŒ´áŒ¼á„áŒá”",
	6	=> "áˆ…áˆáˆ•áˆáˆ¥áˆáˆµáˆ½á‰…á‰•á‰¥á‰á‰µá‰½áŠ…áŠ•áŠáŠ¥áŠáŠ½á‹á‹•á‹á‹¥á‹á‹µá‹½áŒ…áŒáŒáŒ¥áŒáŒµáŒ½á…áá•",
	7	=> "áˆ†áˆŽáˆ–áˆžáˆ¦áˆ®áˆ¶áˆ¾á‰†á‰–á‰¦á‰®á‰¶á‰¾áŠ†áŠ–áŠžáŠ¦áŠ®áŠ¾á‹Žá‹–á‹žá‹¦á‹®á‹¶á‹¾áŒ†áŒŽáŒžáŒ¦áŒ®áŒ¶áŒ¾á†áŽá–",
	8	=> "á‰ˆá‰˜áŠˆáŠ°á‹€áŒáŠ§",
	9	=> "á‰á‰áŠáŠµá‹…áŒ•",
	10	=> "á‰Šá‰šáŠŠáŠ²á‹‚áŒ’",
	11	=> "áˆ—áˆáˆŸáˆ§áˆ¯áˆ·áˆ¿á‰‹á‰›á‰§á‰¯á‰·á‰¿áŠ‹áŠ—áŠŸáŠ³á‹ƒá‹Ÿá‹§á‹·á‹¿áŒ‡áŒ“áŒ§áŒ¯áŒ·áŒ¿áá—",
	12	=> "á‰Œá‰œáŠŒáŠ´á‹„áŒ”",
	áˆ€	=> "áˆ€-áˆ†",
	áˆˆ	=> "áˆˆ-áˆ",
	áˆ	=> "áˆ-áˆ—",
	áˆ˜	=> "áˆ˜-áˆŸ",
	áˆ 	=> "áˆ -áˆ§",
	áˆ¨	=> "áˆ¨-áˆ¯",
	áˆ°	=> "áˆ°-áˆ·",
	áˆ¸	=> "áˆ¸-áˆ¿",
	á‰€	=> "á‰€-á‰†á‰ˆ-á‰",
	á‰	=> "á‰-á‰–á‰˜-á‰",
	á‰ 	=> "á‰ -á‰§",
	á‰¨	=> "á‰¨-á‰¯",
	á‰°	=> "á‰°-á‰·",
	á‰¸	=> "á‰¸-á‰¿",
	áŠ€	=> "áŠ€-áŠ†áŠˆ-áŠ",
	áŠ	=> "áŠ-áŠ—",
	áŠ˜	=> "áŠ˜-áŠŸ",
	áŠ 	=> "áŠ -áŠ§",
	áŠ¨	=> "áŠ¨-áŠ®áŠ°áŠ²-áŠµ",
	áŠ¸	=> "áŠ¸-áŠ¾á‹€-á‹…",
	á‹ˆ	=> "á‹ˆ-á‹Ž",
	á‹	=> "á‹-á‹–",
	á‹˜	=> "á‹˜-á‹Ÿ",
	á‹ 	=> "á‹ -á‹§",
	á‹¨	=> "á‹¨-á‹®",
	á‹°	=> "á‹°-á‹·",
	á‹¸	=> "á‹¸-á‹¿",
	áŒ€	=> "áŒ€-áŒ‡",
	áŒˆ	=> "áŒˆ-áŒŽáŒ-áŒ•",
	áŒ˜	=> "áŒ˜-áŒž",
	áŒ 	=> "áŒ -áŒ§",
	áŒ¨	=> "áŒ¨-áŒ¯",
	áŒ°	=> "áŒ°-áŒ·",
	áŒ¸	=> "áŒ¸-áŒ¿",
	á€	=> "á€-á†",
	áˆ	=> "áˆ-á",
	á	=> "á-á—",
	áŠ áŠƒá‹	=> "á©-á¼"
);

$EthiopicClasses{'áŒá‹•á‹'}
	= $EthiopicClasses{geez} 
	= $EthiopicClasses{1} 
	;
$EthiopicClasses{'áŠ«á‹•á‰¥'}
	= $EthiopicClasses{kaib} 
	= $EthiopicClasses{2} 
	;
$EthiopicClasses{'áˆ£áˆáˆµ'}
	= $EthiopicClasses{salis} 
	= $EthiopicClasses{3} 
	;
$EthiopicClasses{'áˆ«á‰¥á‹•'}
	= $EthiopicClasses{rabi} 
	= $EthiopicClasses{4} 
	;
$EthiopicClasses{'áŠƒáˆáˆµ'}
	= $EthiopicClasses{hamis} 
	= $EthiopicClasses{5} 
	;
$EthiopicClasses{'áˆ³á‹µáˆµ'}
	= $EthiopicClasses{sadis} 
	= $EthiopicClasses{6} 
	;
$EthiopicClasses{'áˆ³á‰¥á‹•'}
	= $EthiopicClasses{sabi}
	= $EthiopicClasses{7} 
	;
$EthiopicClasses{'á‹˜áˆ˜á‹°á¡áŒá‹•á‹'}
	= $EthiopicClasses{'zemede:geez'}
	= $EthiopicClasses{8}
	;
$EthiopicClasses{'á‹˜áˆ˜á‹°á¡áŠ«á‹•á‰¥'}
	= $EthiopicClasses{'zemede:kaib'}
	= $EthiopicClasses{9}
	;
$EthiopicClasses{'á‹˜áˆ˜á‹°á¡áˆ£áˆáˆµ'}
	= $EthiopicClasses{'zemede:salis'}
	= $EthiopicClasses{10}
	;
$EthiopicClasses{'á‹˜áˆ˜á‹°á¡áˆ«á‰¥á‹•'}
	= $EthiopicClasses{'zemede:rabi'}
	= $EthiopicClasses{11}
	;
$EthiopicClasses{'á‹˜áˆ˜á‹°á¡áŠƒáˆáˆµ'}
	= $EthiopicClasses{'zemede:hamis'}
	= $EthiopicClasses{12}
	;
$EthiopicClasses{'ahaz'}
	= $EthiopicClasses{'áŠ áŠƒá‹'}
	;

	($áŒá‹•á‹, $áŠ«á‹•á‰¥, $áˆ£áˆáˆµ, $áˆ«á‰¥á‹•, $áŠƒáˆáˆµ, $áˆ³á‹µáˆµ, $áˆ³á‰¥á‹•,
	$á‹˜áˆ˜á‹°_áŒá‹•á‹, $á‹˜áˆ˜á‹°_áŠ«á‹•á‰¥, $á‹˜áˆ˜á‹°_áˆ£áˆáˆµ, $á‹˜áˆ˜á‹°_áˆ«á‰¥á‹•, $á‹˜áˆ˜á‹°_áŠƒáˆáˆµ) = (1 .. 12);

}

sub import
{

	my @args = ( shift ); # package
	foreach (@_) {
		if ( /overload/o ) {
			use overload;
			overload::constant 'qr' => \&getRe;
		}
		elsif ( /:forms/o ) {
			Regexp::Ethiopic->export_to_level (1, $args[0], ':forms');  # this works too...
		}
		elsif ( /:utils/o ) {
			Regexp::Ethiopic->export_to_level (1, $args[0], ':utils');  # this works too...
		}
		else {
			push (@args, $_);
		}
	}
	if ($#args) {
		Regexp::Ethiopic->export_to_level (1, @args);  # this works too...
	}

}


sub getForm
{
my ($áˆ†áˆ„) = @_;

	my $form = ord($áˆ†áˆ„)%8 + 1;

	if ( $form == 8 || $áˆ†áˆ„ =~ /[á‰‹á‰›áŠ‹áŠ³á‹ƒáŒ“]/o ) {
		$form = 11;
	}
	elsif ( $áˆ†áˆ„ =~ /[á‰á‰áŠáŠµá‹…áŒ•]/o ) {
		$form = 9;
	}
	elsif ( $áˆ†áˆ„ =~ /[á‰ˆá‰˜áŠˆáŠ°á‹€áŒá‰Šá‰šáŠŠáŠ²á‹‚áŒ’á‰Œá‰œáŠŒáŠ´á‹„áŒ”]/o ) {
		$form += 7;
	}

	$form;
}


sub setForm
{
my ($áˆ†áˆ„, $form) = @_;

	if ( $áˆ†áˆ„ =~ /[áŠˆ-áŠá‰ˆ-á‰á‰˜-á‰áŠ°-áŠµá‹€-á‹…áŒ-áŒ•]/o ) {
		$áˆ†áˆ„ =~ s/[áŠˆ-áŠ]/áŠ…/o;
		$áˆ†áˆ„ =~ s/[á‰ˆ-á‰]/á‰€/o;
		$áˆ†áˆ„ =~ s/[á‰˜-á‰]/á‰/o;
		$áˆ†áˆ„ =~ s/[áŠ°-áŠµ]/áŠ¨/o;
		$áˆ†áˆ„ =~ s/[á‹€-á‹…]/áŠ¸/o;
		$áˆ†áˆ„ =~ s/[áŒ-áŒ•]/áŒˆ/o;
	}
	$form  = 4 if ( $áˆ†áˆ„ =~ /[á‰‹á‰›áŠ‹áŠ³á‹ƒáŒ“]/o );
	$form -= 7 if ( $form == 8 || $form == 10 || $form == 12 );
	$form  = 8 if ( $form == 11        );
	$form  = 6 if ( $form == 9         );

	chr ( ord($áˆ†áˆ„) - ord($áˆ†áˆ„)%8 + $form-1 );
}


sub subForm
{
my ($set, $get) = @_;

	#  e.g. s/([=#áˆ€#=])/subForm($1, áˆ€)/eg;
	setForm ( $set, getForm ( $get ) );
}


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

	my $gez = setForm($a,1);
	my $re  = getRe( "[#$gez#]" );
	( $b =~ /$re/ );
}


sub formatForms
{
my ($format, $string) = @_;

	my @chars = split ( //, $string );

	if ( @chars != ($format =~ s/%/%/g) ) {
		$format =~ s/\p{Ethiopic}//g;
		warn ( "\"$string\" is of different length from $format." );
		return;
	}

	foreach (@chars) {
		$format =~ s/%(\d+)/setForm($_, $1)/e;
	}

	$format;
}


sub handleChars
{
my ($chars,$form) = @_;

	return ( $EthiopicClasses{$form} ) if ( $chars eq "all" );

my $re;

	$chars =~ s/(\w)(?=\w)/$1,/og;
	my @Chars = split ( /,/, $chars );
	foreach (@Chars) {
		if ( /(\w)-(\w)/o ) {
			my ($a,$b) = ($1,$2);
			foreach my $char (sort keys %EthiopicClasses) {
				next if ( length($char) > 1 );
				next unless ( (ord($a) <= ord($char)) && (ord($char) <= ord($b)) );
				if ( $form eq "all" ) {
					$re .= $EthiopicClasses{$char};
				}
				else {
					$EthiopicClasses{$form} =~ /([$EthiopicClasses{$char}])/;
					$re .= $1;
				}
			}
		}
		else {
			my $geez = setForm( $_, $áŒá‹•á‹);
			if ( $form eq "all" ) {
				$re .= $EthiopicClasses{$geez};
			}
			else {
				$EthiopicClasses{$form} =~ /([$EthiopicClasses{$geez}])/;
				$re .= $1;
			}
		}
	}

$re;
}


sub setRange
{
my ($chars,$forms,$not) = @_;
$not ||= $_[3];

	my $re;

	if ( $forms eq "all" ) {
		$re = handleChars ( $chars, $forms );
	}
	else {
		my @Forms = split ( /,/, $forms);
		foreach (@Forms) {
			if ( /(\d)-(\d)/o ) {
				my ($a,$b) = ($1,$2);
				foreach my $form ($a..$b) {
					$re .= handleChars ( $chars, $form );
				}
			}
			else {
				my $form = $_;
				$re .= handleChars ( $chars, $form );
			}
		}
	}

	($re) ? ($not) ? "[$not$re]" : "[$re]" : "";
}


sub getRe
{
$_ = ($#_) ? $_[1] : $_[0];


	s/\[:(\p{Ethiopic}+|\w+):\]/($EthiopicClasses{$1}) ? "[$EthiopicClasses{$1}]" : "[:$1:]"/eog;
	s/\[#(\p{Ethiopic}|\d)#\]/($EthiopicClasses{$1}) ? "[$EthiopicClasses{$1}]" : ""/eog;
	s/\[#(\^)?([\d,-]+)#\]/setRange("all",$2,$1)/eog;
	s/\[#(\^)?([\p{Ethiopic},-]+)#\]/setRange($2,"all",$1)/eog;

	# print "  IN: $_\n";

	#
	# for some stupid reason the below doesn't work, so \w
	# is used in place of \p{Ethiopic}, dangerous...
	#
	# test 9 in examples/overload.pl will fail
	#
	# s/(\p{Ethiopic})\{#([\d,-]+)#\}/setRange($1,$2)/eog;
	s/(\w)\{#([\d,-]+)#\}/setRange($1,$2)/eog;

	s/\[(\^)?(\p{Ethiopic}+.*?)\]\{(\^)?#([\d,-]+)#\}/setRange($2,$4,$1,$3)/eog;

	# print "  OUT: $_\n";

	$_;
}



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


__END__


=head1 NAME

Regexp::Ethiopic - Regular Expressions Support for Ethiopic Script.

=head1 SYNOPSIS

 #
 #  Overloading Perl REs:
 #
 use utf8;
 use Regexp::Ethiopic qw(:forms overload setForm);

 :

 s/([#2#])/setForm($1,$áˆ³á‹µáˆµ)/eg;
 s/([áˆ˜áˆ¨á‰ á‹ˆ]{#2#})/setForm($1,$áˆ³á‹µáˆµ)/eg;
 s/([áˆ˜áˆ¨á‰ á‹ˆ]{#1,3#})/setForm($1,$áˆ³á‹µáˆµ)/eg;
 s/([áˆ˜áˆ¨á‰ á‹ˆ]{#1-3,7#})/setForm($1,$áˆ³á‹µáˆµ)/eg;
 s/([#á€#])/subForm('áŒ¸',$1)/eg;  # substitute, a 'áŒ¸' for a 'á€' in the form found for the 'á€'

 if ( /[#áŠ˜#]/ ) {
   #
   # do something
   #
   :
 }

 :
 :

 #
 #  Without overloading:
 #
 use utf8;
 require Regexp::Ethiopic;

 my $string = "[áˆ˜áˆ¨á‰ á‹ˆ]{#1-3,7#}";
 my $re = Regexp::Ethiopic::getRe ( $string );

 s/abc($re)xyz/"abc".Regexp::Ethipic::setForm($1,6)."xyz"/eg;

=head1 DESCRIPTION

The Regexp::Ethiopic module provides POSIX style character class
definitions for working with the Ethiopic syllabary.  The character
classes provided by the Regexp::Ethiopic package correspond to inate
properties of the script and are language independent.

The Regexp::Ethiopic package is NOT derived from the Regexp class
and may not be instantiated into an object.  Regexp::Ethiopic can
optionally export the utility functions C<getForm>, C<setForm>, 
C<subForm> and C<formatForms> (or all with the C<:utils> pragma)
to query or set the form of an Ethiopic character.  Tags of variables
in the form names set to form values may be exported under the C<:forms>
pragma.

See the files in the doc/ and examples/ directories that are included
with this package.

=head2  Substituion Utilities

=head3  getForm

A utility function to query the "form" of an Ethiopic syllable.  It
will return an integer between 1 and 12 corresponding to the [#\d+#]
classes.

  print getForm ( "áŠ " ), "\n";  # prints 1

=head3  setForm

A utility function to set the form number of a syllable.  The form
number must be an integer between 1 and 12 corresponding to the [#\d+#]
classes.

  s/(.)/setForm($1, 1)/eg;

=head3  subForm

A utility function to set the form number of a syllable based on the
form of another syllable.

  s/(\w+)([#á€#])/$1.subForm('áŒ¸', $2)/eg;


=head3  formatForms

A utility function somewhat analogous to C<sprintf> for a sequence of
syllables:

  print formatForms ( "%1%2%3%4", "áŠ á‰ áŒˆá‹°" ), "\n";  # prints áŠ á‰¡áŒŠá‹³


=head1 LIMITATIONS

The overloading mechanism only applies to the constant part of the RE.  The
following would not be handled by the Regexp::Ethipic package as expected:

  use Regexp::Ethiopic 'overload';

  my $x = "áŠ¨";
        :
        :
  if ( /[#$x#]/ ) {
        :
        :
  }

The package never gets to see the variable C<$x> to then
perform the RE expansion.  The work around is to use the package as per:

  use Regexp::Ethiopic 'overload';

  my $x = "áŠ¨";
        :
        :
  my $re = Regexp::Ethiopic::getRe ( "[#$x#]" );

  if ( /$re/ ) {
        :
        :
  }


This works as expected at the cost of one extra step.  The overloading and
functional modes of the Regexp::Ethiopic package may be used together
without conflict.

=head1 REQUIRES

Works perfectly with Perl 5.8.0, may work with Perl 5.6.x but has
not yet been tested.

=head1 BUGS

None presently known.

=head1 AUTHOR

Daniel Yacob,  L<dyacob@cpan.org|mailto:dyacob@cpan.org>

=head1 SEE ALSO

Included with this package:

  doc/index.html       examples/overload.pl
  examples/utils.pl    examples/asfunction.pl


=cut