File Coverage

blib/lib/AozoraBunko/Checkerkun.pm
Criterion Covered Total %
statement 132 132 100.0
branch 110 132 83.3
condition 43 57 75.4
subroutine 16 16 100.0
pod 2 2 100.0
total 303 339 89.3


line stmt bran cond sub pod time code
1             package AozoraBunko::Checkerkun;
2             our $VERSION = "0.12";
3              
4 8     8   11852 use 5.008001;
  8         27  
5 8     8   39 use strict;
  8         13  
  8         199  
6 8     8   45 use warnings;
  8         12  
  8         189  
7 8     8   937 use utf8;
  8         23  
  8         33  
8              
9 8     8   179 use Carp qw//;
  8         12  
  8         171  
10 8     8   6280 use File::ShareDir qw//;
  8         48931  
  8         184  
11 8     8   7432 use YAML::Tiny qw//;
  8         47633  
  8         207  
12 8     8   7372 use Encode qw//;
  8         92151  
  8         223  
13 8     8   6102 use Lingua::JA::Halfwidth::Katakana;
  8         1700  
  8         10372  
14              
15             my $YAML_FILE = File::ShareDir::dist_file('AozoraBunko-Checkerkun', 'hiden_no_tare.yml');
16             my $YAML = YAML::Tiny->read($YAML_FILE)->[0];
17             my $ENC = Encode::find_encoding("Shift_JIS");
18              
19             my %VALID_OUTPUT_FORMAT;
20             @VALID_OUTPUT_FORMAT{qw/plaintext html/} = ();
21              
22             # [78hosetsu_tekiyo] 78互換包摂の対象となる不要な外字注記をチェックする
23             our $KUTENMEN_78HOSETSU_TEKIYO = $YAML->{'kutenmen_78hosetsu_tekiyo'};
24              
25             # [hosetsu_tekiyo] 包摂の対象となる不要な外字注記をチェックする
26             our $KUTENMEN_HOSETSU_TEKIYO = $YAML->{'kutenmen_hosetsu_tekiyo'};
27              
28             # 新JIS漢字で包摂基準の適用除外となる104字
29             our $JYOGAI = $YAML->{'jyogai'};
30              
31             # 78互換文字
32             our $J78 = $YAML->{'j78'};
33              
34             # 間違えやすい文字
35             # かとうかおりさんの「誤認識されやすい文字リスト」から
36             # http://plaza.users.to/katokao/digipr/digipr_charlist.html
37             our $GONIN1 = $YAML->{'gonin1'};
38              
39             # 誤認2
40             our $GONIN2 = $YAML->{'gonin2'};
41              
42             # 誤認3
43             # (砂場清隆さんの入力による)
44             our $GONIN3 = $YAML->{'gonin3'};
45              
46             # 新字体・旧字体対応リスト
47             our $KYUJI = $YAML->{'kyuji'};
48              
49             # 異体字
50             our $ITAIJI = $YAML->{'itaiji'};
51              
52             sub _default_options
53             {
54             return {
55 70     70   528 'gaiji' => 1, # JIS外字をチェックする
56             'hansp' => 1, # 半角スペースをチェックする
57             'hanpar' => 1, # 半角カッコをチェックする
58             'zensp' => 0, # 全角スペースをチェックする
59             'zentilde' => 1, # 全角チルダをチェックする
60             '78hosetsu_tekiyo' => 1, # 78互換包摂の対象となる不要な外字注記をチェックする
61             'hosetsu_tekiyo' => 1, # 包摂の対象となる不要な外字注記をチェックする
62             '78' => 0, # 78互換包摂29字をチェックする
63             'jyogai' => 0, # 新JIS漢字で包摂規準の適用除外となる104字をチェックする
64             'gonin1' => 0, # 誤認しやすい文字をチェックする(1)
65             'gonin2' => 0, # 誤認しやすい文字をチェックする(2)
66             'gonin3' => 0, # 誤認しやすい文字をチェックする(3)
67             'simplesp' => 0, # 半角スペースは「_」で、全角スペースは「□」で出力する
68             'kouetsukun' => 0, # 旧字体置換可能チェッカー「校閲君」を有効にする
69             'output_format' => 'plaintext', # plaintext または html
70             };
71             }
72              
73             sub new
74             {
75 70     70 1 50168 my $class = shift;
76 70 100       214 my %args = (ref $_[0] eq 'HASH' ? %{$_[0]} : @_);
  64         450  
77              
78 70         233 my $options = $class->_default_options;
79              
80 70         247 for my $key (keys %args)
81             {
82 967 100       1641 if ( ! exists $options->{$key} ) { Carp::croak "Unknown option: '$key'"; }
  2         331  
83             else
84             {
85 965 100       1917 if ($key eq 'output_format')
86             {
87 65 100       283 Carp::croak "Output format option must be 'plaintext' or 'html'" unless exists $VALID_OUTPUT_FORMAT{ $args{$key} };
88             }
89              
90 964         1740 $options->{$key} = $args{$key};
91             }
92             }
93              
94 67         393 bless $options, $class;
95             }
96              
97             sub _tag_html
98             {
99 4054     4054   6952 my ($plaintext, $tag_name, $msg) = @_;
100              
101 4054 100       7375 return qq|$plaintext| unless defined $msg;
102 4046         18664 return qq|$plaintext|;
103             }
104              
105             # 例:
106             #
107             # ※[#「口+亞」、第3水準1-15-8、144-上-9]
108             # が
109             # ※[#「口+亞」、第3水準1-15-8、144-上-9]→[78hosetsu_tekiyo]【唖】
110             # に変換され、
111             #
112             # ※[#「にんべん+曾」、第3水準1-14-41、144-上-9]
113             # が
114             # ※[#「にんべん+曾」、第3水準1-14-41、144-上-9]→[hosetsu_tekiyo]【僧】
115             # に変換される。
116             #
117             sub _check_all_hosetsu_tekiyo
118             {
119 4008     4008   5961 my ($self, $chars_ref, $index) = @_;
120              
121 4008         4751 my ($replace, $usedlen);
122              
123 4008         5157 my $rear_index = $index + 80;
124 4008 100       4666 $rear_index = $#{$chars_ref} if $rear_index > $#{$chars_ref};
  14         24  
  4008         8927  
125              
126 4008 50       10273 if ( join("", @{$chars_ref}[$index .. $rear_index]) =~ /^(※[#.*?水準(\d+\-\d+\-\d+).*?])/ )
  4008         43120  
127             {
128 4008         8715 my ($match, $kutenmen) = ($1, $2);
129              
130 4008 100 66     19242 if ( $self->{'78hosetsu_tekiyo'} && exists $KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen} )
    50 33        
131             {
132 2004 100       4896 if ($self->{'output_format'} eq 'plaintext')
    50          
133             {
134 1002         2513 $replace = "$match→[78hosetsu_tekiyo]【$KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen}】";
135             }
136             elsif ($self->{'output_format'} eq 'html')
137             {
138 1002         2394 $replace = _tag_html($match, '78hosetsuTekiyo', $KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen});
139             }
140              
141 2004         4536 $usedlen = length $match;
142             }
143             elsif ( $self->{'hosetsu_tekiyo'} && exists $KUTENMEN_HOSETSU_TEKIYO->{$kutenmen} )
144             {
145 2004 100       5125 if ($self->{'output_format'} eq 'plaintext')
    50          
146             {
147 1002         2401 $replace = "$match→[hosetsu_tekiyo]【$KUTENMEN_HOSETSU_TEKIYO->{$kutenmen}】";
148             }
149             elsif ($self->{'output_format'} eq 'html')
150             {
151 1002         2466 $replace = _tag_html($match, 'hosetsuTekiyo', $KUTENMEN_HOSETSU_TEKIYO->{$kutenmen});
152             }
153              
154 2004         4652 $usedlen = length $match;
155             }
156             }
157              
158 4008         16689 return ($replace, $usedlen);
159             }
160              
161             sub _is_gaiji
162             {
163 4020     4020   7585 my $char = shift; # コピーしないと元の文字が消失するので
164              
165             # UTF-8からSJISに変換できなければ JIX X 0208:1997 外字と判定
166 4020 100       25522 return length $ENC->encode($char, Encode::FB_QUIET) ? 0 : 1;
167             }
168              
169             sub check
170             {
171 63     63 1 282 my ($self, $text) = @_;
172              
173 63 100       196 return undef unless defined $text;
174              
175 62         106 my $output_format = $self->{'output_format'};
176              
177 62         18125 my @chars = split(//, $text);
178              
179 62         106 my $checked_text = '';
180              
181 62         176 for (my $i = 0; $i < @chars; $i++)
182             {
183 8724         12264 my $char = $chars[$i];
184              
185 8724 100 100     17958 if ( $self->{simplesp} && ($char eq "\x{0020}" || $char eq "\x{3000}") )
      66        
186             {
187 16 100       41 if ($output_format eq 'plaintext')
    50          
188             {
189 8 100       20 if ($char eq "\x{0020}") { $checked_text .= '_'; }
  4 50       8  
190 4         5 elsif ($char eq "\x{3000}") { $checked_text .= '□'; }
191             }
192             elsif ($output_format eq 'html')
193             {
194 8 100       44 if ($char eq "\x{0020}") { $checked_text .= _tag_html('_', 'simplesp'); }
  4 50       7  
195 4         7 elsif ($char eq "\x{3000}") { $checked_text .= _tag_html('□', 'simplesp'); }
196             }
197              
198 16         49 next;
199             }
200              
201 8708 100 100     95466 if ($char =~ /[\x{0000}-\x{0009}\x{000B}\x{000C}\x{000E}-\x{001F}\x{007F}-\x{009F}]/)
    100 100        
    100 100        
    100 100        
    100 66        
    100 66        
    100 66        
202             {
203             # 改行は含まない
204              
205 8 100       42 if ($output_format eq 'plaintext')
    50          
206             {
207 4         37 $checked_text .= $char . '[ctrl](' . sprintf("U+%04X", ord $char) . ')';
208             }
209             elsif ($output_format eq 'html')
210             {
211 4         21 $checked_text .= _tag_html($char, 'ctrl', sprintf("U+%04X", ord $char));
212             }
213             }
214 8     8   122 elsif ($char =~ /\p{InHalfwidthKatakana}/)
  8         15  
  8         121  
215             {
216 8 100       28 if ($output_format eq 'plaintext')
    50          
217             {
218 4         20 $checked_text .= $char . '[hankata]';
219             }
220             elsif ($output_format eq 'html')
221             {
222 4         11 $checked_text .= _tag_html($char, 'hankata', '半角カタカナ');
223             }
224             }
225             elsif ($self->{'hansp'} && $char eq "\x{0020}")
226             {
227 4 100       14 if ($output_format eq 'plaintext')
    50          
228             {
229 2         9 $checked_text .= $char . '[hansp]';
230             }
231             elsif ($output_format eq 'html')
232             {
233 2         6 $checked_text .= _tag_html($char, 'hansp', '半角スペース');
234             }
235             }
236             elsif ($self->{'zensp'} && $char eq "\x{3000}")
237             {
238 4 100       14 if ($output_format eq 'plaintext')
    50          
239             {
240 2         9 $checked_text .= $char . '[zensp]';
241             }
242             elsif ($output_format eq 'html')
243             {
244 2         4 $checked_text .= _tag_html($char, 'zensp', '全角スペース');
245             }
246             }
247             elsif ($self->{'zentilde'} && $char eq "\x{FF5E}")
248             {
249 4 100       14 if ($output_format eq 'plaintext')
    50          
250             {
251 2         8 $checked_text .= $char . '[zentilde]';
252             }
253             elsif ($output_format eq 'html')
254             {
255 2         5 $checked_text .= _tag_html($char, 'zentilde', '全角チルダ');
256             }
257             }
258             elsif ( $self->{hanpar} && ($char eq '(' || $char eq ')') )
259             {
260 8 100       21 if ($output_format eq 'plaintext')
    50          
261             {
262 4         17 $checked_text .= $char . '[hanpar]';
263             }
264             elsif ($output_format eq 'html')
265             {
266 4         9 $checked_text .= _tag_html($char, 'hanpar', '半角括弧');
267             }
268             }
269             elsif ( $char eq '※' && ($self->{'78hosetsu_tekiyo'} || $self->{'hosetsu_tekiyo'}) )
270             {
271 4008         8699 my ($replace, $usedlen) = $self->_check_all_hosetsu_tekiyo(\@chars, $i);
272              
273 4008 50       9256 if ($replace)
274             {
275 4008         6590 $checked_text .= $replace;
276 4008         5229 $i += ($usedlen - 1);
277 4008         11252 next;
278             }
279             }
280             else
281             {
282             # 秘伝のタレによるチェック
283             #  複数のタグに該当する文字でも↓のif文で真っ先にマッチした1つのタグしかつかないことに注意。
284             #  複数タグに対応してもいいが、複数タグに該当する文字は9字で、その9字のためにコードと出力結果を複雑化させるのも微妙なところ。
285             #
286 4664 100 66     60005 if ($self->{'78'} && $J78->{$char})
    100 66        
    100 66        
    100 66        
    100 66        
    100 66        
    100 66        
    100 100        
287             {
288 4 100       15 if ($output_format eq 'plaintext')
    50          
289             {
290 2         39 $checked_text .= $char . '[78](' . $J78->{$char} . ')';
291             }
292             elsif ($output_format eq 'html')
293             {
294 2         6 $checked_text .= _tag_html($char, '78', $J78->{$char});
295             }
296             }
297             elsif ($self->{'jyogai'} && $JYOGAI->{$char})
298             {
299 4 100       16 if ($output_format eq 'plaintext')
    50          
300             {
301 2         9 $checked_text .= $char . '[jyogai]';
302             }
303             elsif ($output_format eq 'html')
304             {
305 2         5 $checked_text .= _tag_html($char, 'jyogai', '新JIS漢字で包摂規準の適用除外となる');
306             }
307             }
308             elsif ($self->{'kouetsukun'} && $KYUJI->{$char})
309             {
310 8 100       20 if ($output_format eq 'plaintext')
    50          
311             {
312 4         17 $checked_text .= "▼$char$KYUJI->{$char}▲";
313             }
314             elsif ($output_format eq 'html')
315             {
316 4         9 $checked_text .= _tag_html($char, 'kyuji', $KYUJI->{$char});
317             }
318             }
319             elsif ($self->{'kouetsukun'} && $ITAIJI->{$char})
320             {
321 4 100       11 if ($output_format eq 'plaintext')
    50          
322             {
323 2         11 $checked_text .= "▼$char$ITAIJI->{$char}▲";
324             }
325             elsif ($output_format eq 'html')
326             {
327 2         6 $checked_text .= _tag_html($char, 'itaiji', $ITAIJI->{$char});
328             }
329             }
330             elsif ($self->{'gonin1'} && $GONIN1->{$char})
331             {
332 8 100       26 if ($output_format eq 'plaintext')
    50          
333             {
334 4         18 $checked_text .= $char . '[gonin1](' . $GONIN1->{$char} . ')';
335             }
336             elsif ($output_format eq 'html')
337             {
338 4         11 $checked_text .= _tag_html($char, 'gonin1', $GONIN1->{$char});
339             }
340             }
341             elsif ($self->{'gonin2'} && $GONIN2->{$char})
342             {
343 8 100       24 if ($output_format eq 'plaintext')
    50          
344             {
345 4         18 $checked_text .= $char . '[gonin2](' . $GONIN2->{$char} . ')';
346             }
347             elsif ($output_format eq 'html')
348             {
349 4         13 $checked_text .= _tag_html($char, 'gonin2', $GONIN2->{$char});
350             }
351             }
352             elsif ($self->{'gonin3'} && $GONIN3->{$char})
353             {
354 8 100       22 if ($output_format eq 'plaintext')
    50          
355             {
356 4         19 $checked_text .= $char . '[gonin3](' . $GONIN3->{$char} . ')';
357             }
358             elsif ($output_format eq 'html')
359             {
360 4         12 $checked_text .= _tag_html($char, 'gonin3', $GONIN3->{$char});
361             }
362             }
363             elsif ( $self->{'gaiji'} && _is_gaiji($char) )
364             {
365             # 秘伝のタレに外字が含まれていないことがテストで保証されているのでこの位置で問題ない
366             # コントロール文字に外字があるが、コントロール文字なら必ず 'ctrl' とタグ付けされるのでそれで良しとする。
367 4004 100       9606 if ($output_format eq 'plaintext')
    50          
368             {
369 2002         8192 $checked_text .= $char . '[gaiji]';
370             }
371             elsif ($output_format eq 'html')
372             {
373 2002         3851 $checked_text .= _tag_html($char, 'gaiji', 'JIS外字');
374             }
375             }
376 616         1794 else { $checked_text .= $char; }
377             }
378             }
379              
380 62         8567 return $checked_text;
381             }
382              
383             1;
384              
385             __END__