File Coverage

blib/lib/Lingua/JA/Hepburn/Passport.pm
Criterion Covered Total %
statement 54 59 91.5
branch 32 38 84.2
condition 6 9 66.6
subroutine 7 7 100.0
pod 2 2 100.0
total 101 115 87.8


line stmt bran cond sub pod time code
1             package Lingua::JA::Hepburn::Passport;
2              
3 4     4   133977 use strict;
  4         15  
  4         210  
4             our $VERSION = '0.02';
5              
6 4     4   5449 use utf8;
  4         44  
  4         23  
7 4     4   140 use Carp;
  4         6  
  4         5413  
8              
9             our %Map = (
10             "あ", "A",
11             "い", "I",
12             "う", "U",
13             "え", "E",
14             "お", "O",
15             "か", "KA",
16             "き", "KI",
17             "く", "KU",
18             "け", "KE",
19             "こ", "KO",
20             "さ", "SA",
21             "し", "SHI",
22             "す", "SU",
23             "せ", "SE",
24             "そ", "SO",
25             "た", "TA",
26             "ち", "CHI",
27             "つ", "TSU",
28             "て", "TE",
29             "と", "TO",
30             "な", "NA",
31             "に", "NI",
32             "ぬ", "NU",
33             "ね", "NE",
34             "の", "NO",
35             "は", "HA",
36             "ひ", "HI",
37             "ふ", "FU",
38             "へ", "HE",
39             "ほ", "HO",
40             "ま", "MA",
41             "み", "MI",
42             "む", "MU",
43             "め", "ME",
44             "も", "MO",
45             "や", "YA",
46             "ゆ", "YU",
47             "よ", "YO",
48             "ら", "RA",
49             "り", "RI",
50             "る", "RU",
51             "れ", "RE",
52             "ろ", "RO",
53             "わ", "WA",
54             "ゐ", "I",
55             "ゑ", "E",
56             "を", "O",
57             "ん", "N",
58             "ぁ", "A",
59             "ぃ", "I",
60             "ぅ", "U",
61             "ぇ", "E",
62             "ぉ", "O",
63             "が", "GA",
64             "ぎ", "GI",
65             "ぐ", "GU",
66             "げ", "GE",
67             "ご", "GO",
68             "ざ", "ZA",
69             "じ", "JI",
70             "ず", "ZU",
71             "ぜ", "ZE",
72             "ぞ", "ZO",
73             "だ", "DA",
74             "ぢ", "JI",
75             "づ", "ZU",
76             "で", "DE",
77             "ど", "DO",
78             "ば", "BA",
79             "び", "BI",
80             "ぶ", "BU",
81             "べ", "BE",
82             "ぼ", "BO",
83             "ぱ", "PA",
84             "ぴ", "PI",
85             "ぷ", "PU",
86             "ぺ", "PE",
87             "ぽ", "PO",
88             "きゃ", "KYA",
89             "きゅ", "KYU",
90             "きょ", "KYO",
91             "しゃ", "SHA",
92             "しゅ", "SHU",
93             "しょ", "SHO",
94             "ちゃ", "CHA",
95             "ちゅ", "CHU",
96             "ちょ", "CHO",
97             "ちぇ", "CHE",
98             "にゃ", "NYA",
99             "にゅ", "NYU",
100             "にょ", "NYO",
101             "ひゃ", "HYA",
102             "ひゅ", "HYU",
103             "ひょ", "HYO",
104             "みゃ", "MYA",
105             "みゅ", "MYU",
106             "みょ", "MYO",
107             "りゃ", "RYA",
108             "りゅ", "RYU",
109             "りょ", "RYO",
110             "ぎゃ", "GYA",
111             "ぎゅ", "GYU",
112             "ぎょ", "GYO",
113             "じゃ", "JA",
114             "じゅ", "JU",
115             "じょ", "JO",
116             "びゃ", "BYA",
117             "びゅ", "BYU",
118             "びょ", "BYO",
119             "ぴゃ", "PYA",
120             "ぴゅ", "PYU",
121             "ぴょ", "PYO",
122             );
123              
124             sub new {
125 21     21 1 147 my($class, %opt) = @_;
126 21         175 bless { %opt }, $class;
127             }
128              
129             sub _hepburn_for {
130 69     69   104 my($string, $index) = @_;
131              
132 69         66 my($hepburn, $char);
133 69 100       222 if ($index + 1 < length $string) {
134 47         112 $char = substr $string, $index, 2;
135 47         100 $hepburn = $Map{$char};
136             }
137 69 100 66     283 if (!$hepburn && $index < length $string) {
138 61         104 $char = substr $string, $index, 1;
139 61         137 $hepburn = $Map{$char};
140             }
141              
142 69         256 return { char => $char, hepburn => $hepburn };
143             }
144              
145             sub romanize {
146 21     21 1 642 my($self, $string) = @_;
147              
148 21 50       75 unless (utf8::is_utf8($string)) {
149 0         0 croak "romanize(string): should be UTF-8 flagged string";
150             }
151              
152 4     4   28 $string =~ tr/ア-ン/あ-ん/;
  4         10  
  4         52  
  21         134  
153              
154 21 100       74 if ($self->{strict}) {
155 3 100       391 $string =~ /^\p{Hiragana}*$/
156             or croak "romanize(string): should be all Hiragana/Katakana";
157             }
158              
159 19         28 my $output;
160             my $last_hepburn;
161 0         0 my $last_char;
162 19         28 my $i = 0;
163              
164 19         63 while ($i < length $string) {
165 60         110 my $hr = _hepburn_for($string, $i);
166              
167             # 1.撥音 ヘボン式ではB ・M ・P の前に N の代わりに M をおく
168 60 100 100     586 if ($hr->{char} eq 'ん') {
    100          
    100          
    100          
169 3         9 my $next = _hepburn_for($string, $i + 1);
170 3 50 33     29 $hr->{hepburn} = $next->{hepburn} && $next->{hepburn} =~ /^[BMP]/
171             ? 'M' : 'N';
172             }
173              
174             # 2.促音 子音を重ねて示す
175             elsif ($hr->{char} eq 'っ') {
176 6         14 my $next = _hepburn_for($string, $i + 1);
177              
178             # チ(CH I)、チャ(CHA)、チュ(CHU)、チョ(CHO)音に限り、その前に T を加える。
179 6 50       18 if ($next->{hepburn}) {
180 6 100       37 $hr->{hepburn} = $next->{hepburn} =~ /^CH/
181             ? 'T' : substr($next->{hepburn}, 0, 1);
182             }
183             }
184              
185             # 3.長音 ヘボン式では長音を表記しない
186             elsif ($hr->{char} eq "ー") {
187 1         3 $hr->{hepburn} = "";
188             }
189              
190             # Japanese Passport table doesn't have entries for ぁ-ぉ
191             elsif ($hr->{char} =~ /[ぁ-ぉ]/ && $self->{strict}) {
192 1         148 croak "$hr->{char} is not allowed";
193             }
194              
195 59 50       115 if (defined $hr->{hepburn}) {
196 59 100       106 if ($last_hepburn) {
197 34         63 my $h_test = $last_hepburn . $hr->{hepburn};
198 34 100       73 if (length $h_test > 2) {
199 31         47 $h_test = substr $h_test, -2;
200             }
201              
202             # 3.長音 ヘボン式では長音を表記しない
203 34 100       130 if (grep $h_test eq $_, qw( AA II UU EE )) {
204 4         10 $hr->{hepburn} = '';
205             }
206              
207             # 氏名に「オウ」又は「オオ」の長音が含まれる場合、
208             # 「 O 」 か 「 OH 」 のいずれかの表記を選択することができる
209 34 100       94 if (grep $h_test eq $_, qw( OO OU )) {
210 6 100       18 $hr->{hepburn} = $self->{long_vowels_h} ? 'H' : '';
211             }
212             }
213              
214 59         90 $output .= $hr->{hepburn};
215             } else {
216 0 0       0 if ($self->{strict}) {
217 0         0 croak "Can't find hepburn replacement for $hr->{char}";
218             }
219 0         0 $output .= $hr->{char};
220             }
221              
222 59         82 $last_hepburn = $hr->{hepburn};
223 59         72 $last_char = $hr->{char};
224 59         232 $i += length $hr->{char};
225             }
226              
227 18         79 return $output;
228             }
229              
230             1;
231             __END__