#!/usr/bin/env perl
# (c) MiF, 2006, alexey@mitme.ru
# depends: ipa.src.hex.utf8, ipa.dst.hex.utf8
# ipa.src.hex.utf8 - [t]-DSL set converted from utf-16 to utf-8 

package IPATranscription;

use Data::Dumper;

my $path = __FILE__;
$path = '.' if ($path !~ /\//);
$path =~ s/\/[^\/]+$//os;

my $isrc = `cat $path/ipa.src.hex.utf8`;
my $idst = `cat $path/ipa.dst.hex.utf8`;

our $singleton;

sub utf8SeqLen
{
	my ($self, $bt) = @_;

	$bt = substr($bt,0,1) if (length($bt) > 1);
	$bt = ord($bt);
	return 4 if (($bt & 248) == 240);
	return 3 if (($bt & 240) == 224);
	return 2 if (($bt & 224) == 192);
	return 1 if (!($bt & 128));
	return 1;
}

sub new
{
	my $class = shift;

	return $singleton if ($singleton);

	my $self = bless {}, $class;

	$self->{'stable'}->{'1'} = {};
	$self->{'stable'}->{'2'} = {};
	$self->{'stable'}->{'3'} = {};
	$self->{'stable'}->{'4'} = {};

	my ($ipachar, $i);
	my @isrc = split /\n/, $isrc;
	my @idst = split /\n/, $idst;

 my $count;
 if (($count = scalar(@isrc)) != scalar(@idst) || !$count)
	{
		warn "IPATranscription.pm: depends failed: check ipa.src/dst.hex.utf8 files first\n";
		return undef;
	}

 # generating substitution table
	for ($i = 0; $i < $count; $i++)
	{
		my ($ibsrc, $ibdst) = ($isrc[$i], $idst[$i]);
		$ibsrc =~ s/\s+$//gos;
		$ibdst =~ s/\s+$//gos;
		$ibsrc =~ s/(..)/pack "C",hex($1)/geos;
		$ibdst =~ s/(..)/pack "C",hex($1)/geos;
		if (!length($ibsrc) || !length($ibdst))
		{
			warn "IPATranscription.pm: bad src-dst length: check ipa.src/dst.hex.utf8 files first\n";
			return undef;
		}
		my $clen = $self->utf8SeqLen($ibsrc);
		$self->{'stable'}->{ $clen }->{ $ibsrc } = $ibdst; 
	}

	$singleton = $self;
	return $singleton;
}

sub convert
{
	my ($self, $str) = @_;

	my @chars = split //, $str;
	my $i = 0;
	my $len = scalar(@chars);
	my $clen;
	my $res = '';
	while ($i < $len)
	{
		$clen = $self->utf8SeqLen($chars[$i]);
		my $ibsrc = substr($str, $i, $clen);
		$i += $clen;
		if (exists $self->{'stable'}->{ $clen }->{ $ibsrc })
		{
			my $ipachar = $self->{'stable'}->{ $clen }->{ $ibsrc };
			$res .= $ipachar; 
		}
		else
		{
			$res .= $ibsrc;
		}
	}
	return $res;
}

if (IPATranscription->new())
{
	1;
}
else
{
	0;
}


