File Coverage

blib/lib/Lingua/LO/Transform/Romanize/PCGN.pm
Criterion Covered Total %
statement 57 57 100.0
branch 13 14 92.8
condition 5 6 83.3
subroutine 13 13 100.0
pod 2 2 100.0
total 90 92 97.8


line stmt bran cond sub pod time code
1             package Lingua::LO::Transform::Romanize::PCGN;
2 2     2   708 use strict;
  2         2  
  2         45  
3 2     2   5 use warnings;
  2         3  
  2         35  
4 2     2   28 use 5.012000;
  2         4  
5 2     2   5 use utf8;
  2         2  
  2         10  
6 2     2   43 use feature qw/ unicode_strings say /;
  2         2  
  2         141  
7 2     2   8 use charnames qw/ :full lao /;
  2         11  
  2         12  
8 2     2   806 use version 0.77; our $VERSION = version->declare('v0.0.1');
  2         28  
  2         9  
9 2     2   135 use Carp;
  2         2  
  2         93  
10 2     2   357 use Lingua::LO::Transform::Analyze;
  2         3  
  2         12  
11 2     2   59 use parent 'Lingua::LO::Transform::Romanize';
  2         3  
  2         13  
12              
13             =encoding UTF-8
14              
15             =head1 NAME
16              
17             Lingua::LO::Transform::Romanize::PCGN - Romanize Lao syllables according to the PCGN standard
18              
19             =head1 FUNCTION
20              
21             This class is not supposed to be used directly. Rather use
22             L as a factory:
23              
24             my $o = Lingua::LO::Transform::Romanize->new(variant => 'PCGN');
25              
26             =cut
27              
28             my %CONSONANTS = (
29             ກ => 'k',
30             ຂ => 'kh',
31             ຄ => 'kh',
32             ງ => 'ng',
33             ຈ => 'ch',
34             ສ => 's',
35             ຊ => 'x',
36             ຍ => [qw/ gn y /],
37             ດ => [qw/ d t /],
38             ຕ => 't',
39             ຖ => 'th',
40             ທ => 'th',
41             ນ => 'n',
42             ບ => [qw/ b p /],
43             ປ => 'p',
44             ຜ => 'ph',
45             ຝ => 'f',
46             ພ => 'ph',
47             ຟ => 'f',
48             ມ => 'm',
49             ຢ => 'y',
50             ລ => 'l',
51             "\N{LAO SEMIVOWEL SIGN LO}" => 'l',
52             ວ => [qw/ v o /],
53             ຫ => 'h',
54             ອ => '',
55             ຮ => 'h',
56             ຣ => 'r',
57             ໜ => 'n',
58             ໝ => 'm',
59             ຫຼ => 'l',
60             ຫຍ => 'gn',
61             ຫນ => 'n',
62             ຫມ => 'm',
63             ຫຣ => 'r',
64             ຫລ => 'l',
65             ຫວ => 'v',
66             );
67              
68             my %CONS_VOWELS = map { $_ => 1 } qw/ ຍ ຽ ອ ວ /;
69              
70             my %VOWELS = (
71             ### Monophthongs
72             'Xະ' => 'a',
73             'Xັ' => 'a',
74             'Xາ' => 'a',
75             'Xາວ' => 'ao',
76              
77             'Xິ' => 'i',
78             'Xີ' => 'i',
79              
80             'Xຶ' => 'u',
81             'Xື' => 'u',
82              
83             'Xຸ' => 'ou',
84             'Xູ' => 'ou',
85              
86             'ເXະ' => 'é',
87             'ເXັ' => 'é',
88             'ເX' => 'é',
89              
90             'ແXະ' => 'è',
91             'ແXັ' => 'è',
92             'ແX' => 'è',
93             'ແXວ' => 'èo',
94              
95             'ໂXະ' => 'ô',
96             'Xົ' => 'ô',
97             'ໂX' => 'ô',
98             'ໂXຍ' => 'ôy', # TODO correct?
99              
100             'ເXາະ' => 'o',
101             'Xັອ' => 'o',
102             'Xໍ' => 'o',
103             'Xອ' => 'o',
104              
105             'ເXິ' => 'eu',
106             'ເXີ' => 'eu',
107             'ເXື' => 'eu', # TODO correct?
108              
109             'ເXັຍ' => 'ia', # /iə/
110             'Xັຽ' => 'ia', # /iə/
111             'ເXຍ' => 'ia', # /iːə/
112             'Xຽ' => 'ia', # /iːə/
113             'Xຽວ' => 'iao',
114              
115             'ເXຶອ' => 'ua',
116             'ເXືອ' => 'ua',
117              
118             'Xົວະ' => 'oua',
119             'Xັວ ' => 'oua',
120             'Xົວ' => 'oua',
121             'Xວ' => 'oua',
122             'Xວຍ' => 'ouai',
123              
124             'ໄX' => 'ai',
125             'ໃX' => 'ai',
126             'Xາຍ' => 'ay', # /aj/ - Actually short but counts as long for rules
127             'Xັຍ' => 'ay', # /aj/
128              
129             'ເXົາ' => 'ao',
130             'Xຳ' => 'am', # composed U+0EB3
131             'Xໍາ' => 'am',
132             );
133             {
134             # Replace "X" in %VOWELS keys with DOTTED CIRCLE. Makes code easier to edit.
135             my %v;
136             foreach my $v (keys %VOWELS) {
137             (my $w = $v) =~ s/X/\N{DOTTED CIRCLE}/;
138             $v{$w} = $VOWELS{$v};
139             }
140             %VOWELS = %v;
141             }
142              
143             sub new {
144 1     1 1 2 my $class = shift;
145             # Not calling SUPER::new on purpose!
146 1         2 return bless {}, $class;
147             }
148              
149             sub romanize_syllable {
150 29     29 1 25 my ($self, $syllable) = @_;
151 29         22 my ($consonant, $endcons, $result);
152 29         53 my $c = Lingua::LO::Transform::Analyze->new($syllable);
153 29         59 my $parse = $c->parse;
154 29         106 my $vowel = $c->vowel;
155            
156 29         85 my $cons = $c->consonant;
157 29         90 my $h = $c->h;
158 29         80 my $sv = $c->semivowel;
159 29 100 100     104 if($cons eq 'ຫ' and $sv) {
160             # ຫ with semivowel. Drop the ຫ and use the semivowel as consonant
161 2         7 $result = _consonant($sv, 0);
162             } else {
163             # The regular case
164 27         31 $result = _consonant($cons, 0);
165 27 100       49 $result .= _consonant($sv, 1) if $sv;
166             }
167              
168 29         45 $endcons = $c->end_consonant;
169 29 100       81 if(defined $endcons) {
170 14 100       18 if(exists $CONS_VOWELS{ $endcons }) {
171 3         5 $vowel .= $endcons; # consonant can be used as a vowel
172 3         4 $endcons = '';
173             } else {
174 11         12 $endcons = _consonant($endcons, 1);
175             }
176             } else {
177 15         14 $endcons = ''; # avoid special-casing later
178             }
179              
180             # TODO remove debug
181 29 50       44 warn sprintf("Missing VOWELS def for `%s' in `%s'", $vowel, $c->syllable) unless defined $VOWELS{ $vowel };
182              
183 29         33 $result .= $VOWELS{ $vowel } . $endcons;
184 29 100 66     55 $result .= "-$result" if defined $parse->{extra} and $parse->{extra} eq 'ໆ'; # duplication sign
185 29         129 return $result;
186             }
187              
188             sub _consonant {
189 42     42   35 my ($cons, $position) = @_;
190 42         40 my $consdata = $CONSONANTS{ $cons };
191             #my $consref = ref $consdata or return $consdata;
192             #return $consdata->($position) if $consref eq 'CODE';
193             #return $consdata->[$position];
194 42 100       62 return ref $consdata ? $consdata->[$position] : $consdata;
195             }
196              
197             1;
198