File Coverage

blib/lib/Lingua/Translit.pm

Criterion	Covered	Total	%
statement	81	83	97.5
branch	42	50	84.0
condition	12	18	66.6
subroutine	13	13	100.0
pod	6	6	100.0
total	154	170	90.5

package Lingua::Translit;

#
# Copyright (C) 2007-2008 ...
#   Alex Linke
#   Rona Linke
# Copyright (C) 2009-2016 Lingua-Systems Software GmbH
# Copyright (C) 2016-2017 Netzum Sorglos, Lingua-Systems Software GmbH
# Copyright (C) 2017-2022 Netzum Sorglos Software GmbH
#

use strict;
use warnings;

require 5.008;

use Carp qw/croak/;
use Encode qw/encode decode/;

use Lingua::Translit::Tables;

our $VERSION = '0.29';

=pod

=encoding utf8

=head1 NAME

Lingua::Translit - transliterates text between writing systems

=head1 SYNOPSIS

  use Lingua::Translit;

  my $tr = new Lingua::Translit("ISO 843");

  my $text_tr = $tr->translit("character oriented string");

  if ($tr->can_reverse()) {
    $text_tr = $tr->translit_reverse("character oriented string");
  }

=head1 DESCRIPTION

Lingua::Translit can be used to convert text from one writing system to
another, based on national or international transliteration tables.
Where possible a reverse transliteration is supported.

The term C describes the conversion of text from one
writing system or alphabet to another one.
The conversion is ideally unique, mapping one character to exactly one
character, so the original spelling can be reconstructed.
Practically this is not always the case and one single letter of the
original alphabet can be transcribed as two, three or even more letters.

Furthermore there is more than one transliteration scheme for one writing
system.
Therefore it is an important and necessary information, which scheme will be
or has been used to transliterate a text, to work integrative and be able to
reconstruct the original data.

Reconstruction is a problem though for non-unique transliterations, if no
language specific knowledge is available as the resulting clusters of
letters may be ambiguous.
For example, the Greek character "PSI" maps to "ps", but "ps" could also
result from the sequence "PI", "SIGMA" since "PI" maps to "p" and "SIGMA"
maps to s.
If a transliteration table leads to ambiguous conversions, the provided
table cannot be used reverse.

Otherwise the table can be used in both directions, if appreciated.
So if ISO 9 is originally created to convert Cyrillic letters to
the Latin alphabet, the reverse transliteration will transform Latin
letters to Cyrillic.

=head1 METHODS

=head2 new(I<"name of table">)

Initializes an object with the specific transliteration table, e.g. "ISO 9".

=cut

sub new {
    my $class = shift();
    my $name  = shift();

    my $self;

    # Assure that a table name was set
    croak("No transliteration name given.") unless $name;

    # Stay compatible with programs that use Lingua::Translit < 0.05
    if ( $name =~ /^DIN 5008$/i ) {
        $name = "Common DEU";
    }

    my $table = Lingua::Translit::Tables::_get_table_reference($name);

    # Check that a table reference was assigned to the object
    croak("No table found for $name.") unless $table;

    # Assure the table's data is complete
    croak("$name table: missing 'name'")    unless defined $table->{name};
    croak("$name table: missing 'desc'")    unless defined $table->{desc};
    croak("$name table: missing 'reverse'") unless defined $table->{reverse};
    croak("$name table: missing 'rules'")   unless defined $table->{rules};

    # Copy over the table's data
    $self->{name}  = $table->{name};
    $self->{desc}  = $table->{desc};
    $self->{rules} = $table->{rules};

    # Set a truth value of the transliteration's reversibility according to
    # the natural language string in the original transliteration table
    $self->{reverse} = ( $table->{reverse} =~ /^true$/i ) ? 1 : 0;

    undef($table);

    return bless $self, $class;
}

=head2 translit(I<"character oriented string">)

Transliterates the given text according to the object's transliteration
table.
Returns the transliterated text.

=cut

sub translit {
    my $self = shift();
    my $text = shift();

    # Return if no input was given
    return undef if ! defined $text;
    return ''    if $text eq '';

    my $utf8_flag_on = Encode::is_utf8($text);

    unless ($utf8_flag_on) {
        $text = decode( "UTF-8", $text );
    }

    foreach my $rule ( @{ $self->{rules} } ) {
        if ( defined $rule->{context} ) {
            my $c = $rule->{context};

            # single context rules
            if ( defined $c->{before} && !defined $c->{after} ) {
                $text =~ s/$rule->{from}(?=$c->{before})/$rule->{to}/g;
            }
            elsif ( defined $c->{after} && !defined $c->{before} ) {
                $text =~ s/(?<=$c->{after})$rule->{from}/$rule->{to}/g;
            }

            # double context rules: logical "inbetween"
            elsif ( defined $c->{before} && defined $c->{after} ) {
                $text =~ s/
                (?<=$c->{after})$rule->{from}(?=$c->{before})
                /$rule->{to}/gx;
            }

            else {
                croak("incomplete rule context");
            }
        }
        else {
            $text =~ s/$rule->{from}/$rule->{to}/g;
        }
    }

    unless ($utf8_flag_on) {
        return encode( "UTF-8", $text );
    }
    else {
        return $text;
    }
}

=head2 translit_reverse(I<"character oriented string">)

Transliterates the given text according to the object's transliteration
table, but uses it the other way round. For example table ISO 9 is a
transliteration scheme for the conversion of Cyrillic letters to the Latin
alphabet. So if used reverse, Latin letters will be mapped to Cyrillic ones.

Returns the transliterated text.

=cut

sub translit_reverse {
    my $self = shift();
    my $text = shift();

    # Return if no input was given
    return undef if ! defined $text;
    return ''    if $text eq '';

    # Is this transliteration reversible?
    croak("$self->{name} cannot be reversed") unless $self->{reverse};

    my $utf8_flag_on = Encode::is_utf8($text);

    unless ($utf8_flag_on) {
        $text = decode( "UTF-8", $text );
    }

    foreach my $rule ( @{ $self->{rules} } ) {
        if ( defined $rule->{context} ) {
            my $c = $rule->{context};

            # single context rules
            if ( defined $c->{before} && !defined $c->{after} ) {
                $text =~ s/$rule->{to}(?=$c->{before})/$rule->{from}/g;
            }
            elsif ( defined $c->{after} && !defined $c->{before} ) {
                $text =~ s/(?<=$c->{after})$rule->{to}/$rule->{from}/g;
            }

            # double context rules: logical "inbetween"
            elsif ( defined $c->{before} && defined $c->{after} ) {
                $text =~ s/
                    (?<=$c->{after})$rule->{to}(?=$c->{before})
                    /$rule->{from}/gx;
            }

            else {
                croak("incomplete rule context");
            }
        }
        else {
            $text =~ s/$rule->{to}/$rule->{from}/g;
        }
    }

    unless ($utf8_flag_on) {
        return encode( "UTF-8", $text );
    }
    else {
        return $text;
    }
}

=head2 can_reverse()

Returns true (1), iff reverse transliteration is possible.
False (0) otherwise.

=cut

sub can_reverse {
    return $_[0]->{reverse};
}

=head2 name()

Returns the name of the chosen transliteration table, e.g. "ISO 9".

=cut

sub name {
    return $_[0]->{name};
}

=head2 desc()

Returns a description for the transliteration,
e.g. "ISO 9:1995, Cyrillic to Latin".

=cut

sub desc {
    return $_[0]->{desc};
}

=head1 SUPPORTED TRANSLITERATIONS

=over 4

=item Cyrillic

I, not reversible, ALA-LC:1997, Cyrillic to Latin, Russian

I, reversible, ISO 9:1995, Cyrillic to Latin

I, reversible, ISO 9:1954, Cyrillic to Latin

I, reversible, DIN 1460:1982, Cyrillic to Latin, Russian

I, reversible, DIN 1460:1982, Cyrillic to Latin, Ukrainian

I, reversible, DIN 1460:1982, Cyrillic to Latin, Bulgarian

I, not reversible, The Streamlined System: 2006,
Cyrillic to Latin, Bulgarian

I, reversible, GOST 7.79:2000 (table B), Cyrillic to Latin,
Russian

I, not reversible, GOST 7.79:2000 (table B), Cyrillic to
Latin with support for Old Russian (pre 1918), Russian

I, reversible, GOST 7.79:2000 (table B), Cyrillic to Latin,
Ukrainian

I, not reversible, BGN/PCGN:1947 (Standard Variant),
Cyrillic to Latin, Russian

I, not reversible, BGN/PCGN:1947 (Strict Variant),
Cyrillic to Latin, Russian

=item Greek

I, not reversible, ISO 843:1997, Greek to Latin

I, not reversible, DIN 31634:1982, Greek to Latin

I, not reversible, Greeklish (Phonetic), Greek to Latin

=item Latin

I, not reversible, Czech without diacritics

I, not reversible, German without umlauts

I, not reversible, Unaccented Polish

I, not reversible, Romanian without diacritics as commonly used

I, not reversible, Slovak without diacritics

I, not reversible, Slovenian without diacritics

I, reversible, Romanian with appropriate diacritics

=item Arabic

I, not reversible, Common Romanization of Arabic

=item Sanskrit

I, not reversible, IAST Romanization to Devanāgarī

I, not reversible, Devanāgarī to IAST Romanization

=back

=head1 ADDING NEW TRANSLITERATIONS

In case you want to add your own transliteration tables to
L, have a look at the developer documentation at
L.

A template of a transliteration table is provided as well
(F) so you can easily start developing.


=head1 RESTRICTIONS

L is suited to handle B and utilizes comparisons
and regular expressions that rely on B.
Therefore, any input is supposed to be B
(C, ...) instead of byte oriented.

However, if your data is byte oriented, be sure to pass it
B to translit() and/or translit_reverse() - it will be
converted internally.

=head1 BUGS

None known.

Please report bugs using CPAN's request tracker at
L.

=head1 SEE ALSO

L, L, L

C's manpage

L

=head1 CREDITS

Thanks to Dr. Daniel Eiwen, Romanisches Seminar, Universitaet Koeln for his
help on Romanian transliteration.

Thanks to Dmitry Smal and Rusar Publishing for contributing the "ALA-LC RUS"
transliteration table.

Thanks to Ahmed Elsheshtawy for his help implementing the "Common ARA" Arabic
transliteration.

Thanks to Dusan Vuckovic for contributing the "ISO/R 9" transliteration table.

Thanks to Ștefan Suciu for contributing the "ISO 8859-16 RON" transliteration
table.

Thanks to Philip Kime for contributing the "IAST Devanagari" and "Devanagari
IAST" transliteration tables.

Thanks to Nikola Lečić for contributing the "BGN/PCGN RUS Standard" and
"BGN/PCGN RUS Strict" transliteration tables.

=head1 AUTHORS

Alex Linke

Rona Linke

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2007-2008 Alex Linke and Rona Linke

Copyright (C) 2009-2016 Lingua-Systems Software GmbH

Copyright (C) 2016-2017 Netzum Sorglos, Lingua-Systems Software GmbH

Copyright (C) 2017-2022 Netzum Sorglos Software GmbH

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;

# vim: set ft=perl sts=4 sw=4 ts=4 ai et: