File Coverage

blib/lib/AozoraBunko/Tools/Checkerkun.pm
Criterion Covered Total %
statement 126 126 100.0
branch 95 114 83.3
condition 36 48 75.0
subroutine 16 16 100.0
pod 2 2 100.0
total 275 306 89.8


line stmt bran cond sub pod time code
1             package AozoraBunko::Tools::Checkerkun;
2             our $VERSION = "0.06";
3              
4 4     4   5559 use 5.008001;
  4         12  
5 4     4   20 use strict;
  4         7  
  4         82  
6 4     4   26 use warnings;
  4         7  
  4         97  
7 4     4   1013 use utf8;
  4         16  
  4         18  
8              
9 4     4   91 use Carp qw//;
  4         8  
  4         82  
10 4     4   28019 use File::ShareDir qw//;
  4         42579  
  4         136  
11 4     4   4837 use YAML::Tiny qw//;
  4         24251  
  4         149  
12 4     4   132685 use Encode qw//;
  4         49640  
  4         102  
13 4     4   3057 use Lingua::JA::Halfwidth::Katakana;
  4         835  
  4         5161  
14              
15             my $YAML_FILE = File::ShareDir::dist_file('AozoraBunko-Tools-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             sub _default_options
47             {
48             return {
49 64     64   438 'gaiji' => 1, # JIS外字をチェックする
50             'hansp' => 1, # 半角スペースをチェックする
51             'hanpar' => 1, # 半角カッコをチェックする
52             'zensp' => 0, # 全角スペースをチェックする
53             '78hosetsu_tekiyo' => 1, # 78互換包摂の対象となる不要な外字注記をチェックする
54             'hosetsu_tekiyo' => 1, # 包摂の対象となる不要な外字注記をチェックする
55             '78' => 0, # 78互換包摂29字をチェックする
56             'jyogai' => 0, # 新JIS漢字で包摂規準の適用除外となる104字をチェックする
57             'gonin1' => 0, # 誤認しやすい文字をチェックする(1)
58             'gonin2' => 0, # 誤認しやすい文字をチェックする(2)
59             'gonin3' => 0, # 誤認しやすい文字をチェックする(3)
60             'simplesp' => 0, # 半角スペースは「_」で、全角スペースは「□」で出力する
61             'output_format' => 'plaintext', # plaintext または html
62             };
63             }
64              
65             sub new
66             {
67 64     64 1 43455 my $class = shift;
68 64 100       194 my %args = (ref $_[0] eq 'HASH' ? %{$_[0]} : @_);
  58         380  
69              
70 64         219 my $options = $class->_default_options;
71              
72 64         222 for my $key (keys %args)
73             {
74 752 100       1374 if ( ! exists $options->{$key} ) { Carp::croak "Unknown option: '$key'"; }
  2         337  
75             else
76             {
77 750 100       1407 if ($key eq 'output_format')
78             {
79 58 100       267 Carp::croak "Output format option must be 'plaintext' or 'html'" unless exists $VALID_OUTPUT_FORMAT{ $args{$key} };
80             }
81              
82 749         1313 $options->{$key} = $args{$key};
83             }
84             }
85              
86 61         321 bless $options, $class;
87             }
88              
89             sub _tag_html
90             {
91 4042     4042   6848 my ($plaintext, $tag_name, $msg) = @_;
92              
93 4042 100       7413 return qq|$plaintext| unless defined $msg;
94 4034         17922 return qq|$plaintext|;
95             }
96              
97             # 例:
98             #
99             # ※[#「口+亞」、第3水準1-15-8、144-上-9]
100             # が
101             # ※[#「口+亞」、第3水準1-15-8、144-上-9] → [78hosetsu_tekiyo]【唖】
102             # に変換され、
103             #
104             # ※[#「にんべん+曾」、第3水準1-14-41、144-上-9]
105             # が
106             # ※[#「にんべん+曾」、第3水準1-14-41、144-上-9]→[hosetsu_tekiyo]【僧】
107             # に変換される。
108             #
109             sub _check_all_hosetsu_tekiyo
110             {
111 4008     4008   5850 my ($self, $chars_ref, $index) = @_;
112              
113 4008         4577 my ($replace, $usedlen);
114              
115 4008         5036 my $rear_index = $index + 80;
116 4008 100       4471 $rear_index = $#{$chars_ref} if $rear_index > $#{$chars_ref};
  14         23  
  4008         9430  
117              
118 4008 50       10982 if ( join("", @{$chars_ref}[$index .. $rear_index]) =~ /^(※[#.*?水準(\d+\-\d+\-\d+).*?])/ )
  4008         43239  
119             {
120 4008         9136 my ($match, $kutenmen) = ($1, $2);
121              
122 4008 100 66     19960 if ( $self->{'78hosetsu_tekiyo'} && exists $KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen} )
    50 33        
123             {
124 2004 100       4895 if ($self->{'output_format'} eq 'plaintext')
    50          
125             {
126 1002         2615 $replace = "$match→[78hosetsu_tekiyo]【$KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen}】";
127             }
128             elsif ($self->{'output_format'} eq 'html')
129             {
130 1002         2526 $replace = _tag_html($match, '78hosetsuTekiyo', $KUTENMEN_78HOSETSU_TEKIYO->{$kutenmen});
131             }
132              
133 2004         4681 $usedlen = length $match;
134             }
135             elsif ( $self->{'hosetsu_tekiyo'} && exists $KUTENMEN_HOSETSU_TEKIYO->{$kutenmen} )
136             {
137 2004 100       5191 if ($self->{'output_format'} eq 'plaintext')
    50          
138             {
139 1002         2708 $replace = "$match→[hosetsu_tekiyo]【$KUTENMEN_HOSETSU_TEKIYO->{$kutenmen}】";
140             }
141             elsif ($self->{'output_format'} eq 'html')
142             {
143 1002         2504 $replace = _tag_html($match, 'hosetsuTekiyo', $KUTENMEN_HOSETSU_TEKIYO->{$kutenmen});
144             }
145              
146 2004         4704 $usedlen = length $match;
147             }
148             }
149              
150 4008         16943 return ($replace, $usedlen);
151             }
152              
153             sub _is_gaiji
154             {
155 4016     4016   5438 my $char = shift; # コピーしないと、encode のタイミングで元の文字が消失してしまう。
156              
157             # UTF-8からSJISに変換できなければ外字と判定
158 4016         5049 eval { $ENC->encode($char, Encode::FB_CROAK) };
  4016         28005  
159 4016 100       20291 return 1 if $@;
160 12         76 return 0;
161             }
162              
163             sub check
164             {
165 57     57 1 256 my ($self, $text) = @_;
166              
167 57 100       142 return undef unless defined $text;
168              
169 56         117 my $output_format = $self->{'output_format'};
170              
171 56         18479 my @chars = split(//, $text);
172              
173 56         87 my $checked_text = '';
174              
175 56         165 for (my $i = 0; $i < @chars; $i++)
176             {
177 8620         12700 my $char = $chars[$i];
178              
179 8620 100 100     19639 if ( $self->{simplesp} && ($char eq "\x{0020}" || $char eq "\x{3000}") )
      66        
180             {
181 16 100       40 if ($output_format eq 'plaintext')
    50          
182             {
183 8 100       21 if ($char eq "\x{0020}") { $checked_text .= '_'; }
  4 50       8  
184 4         6 elsif ($char eq "\x{3000}") { $checked_text .= '□'; }
185             }
186             elsif ($output_format eq 'html')
187             {
188 8 100       21 if ($char eq "\x{0020}") { $checked_text .= _tag_html('_', 'simplesp'); }
  4 50       9  
189 4         7 elsif ($char eq "\x{3000}") { $checked_text .= _tag_html('□', 'simplesp'); }
190             }
191              
192 16         49 next;
193             }
194              
195 8604 100 100     87008 if ($char =~ /[\x{0000}-\x{0009}\x{000B}\x{000C}\x{000E}-\x{001F}\x{007F}-\x{009F}]/)
    100 100        
    100 100        
    100 66        
    100 66        
    100 66        
196             {
197             # 改行は含まない
198              
199 4 100       14 if ($output_format eq 'plaintext')
    50          
200             {
201 2         15 $checked_text .= $char . '[ctrl](' . sprintf("U+%04X", ord $char) . ')';
202             }
203             elsif ($output_format eq 'html')
204             {
205 2         13 $checked_text .= _tag_html($char, 'ctrl', sprintf("U+%04X", ord $char));
206             }
207             }
208 4     4   58 elsif ($char =~ /\p{InHalfwidthKatakana}/)
  4         8  
  4         59  
209             {
210 4 100       15 if ($output_format eq 'plaintext')
    50          
211             {
212 2         10 $checked_text .= $char . '[hankata]';
213             }
214             elsif ($output_format eq 'html')
215             {
216 2         5 $checked_text .= _tag_html($char, 'hankata', '半角カタカナ');
217             }
218             }
219             elsif ($self->{'hansp'} && $char eq "\x{0020}")
220             {
221 4 100       17 if ($output_format eq 'plaintext')
    50          
222             {
223 2         9 $checked_text .= $char . '[hansp]';
224             }
225             elsif ($output_format eq 'html')
226             {
227 2         4 $checked_text .= _tag_html($char, 'hansp', '半角スペース');
228             }
229             }
230             elsif ($self->{'zensp'} && $char eq "\x{3000}")
231             {
232 4 100       15 if ($output_format eq 'plaintext')
    50          
233             {
234 2         9 $checked_text .= $char . '[zensp]';
235             }
236             elsif ($output_format eq 'html')
237             {
238 2         6 $checked_text .= _tag_html($char, 'zensp', '全角スペース');
239             }
240             }
241             elsif ( $self->{hanpar} && ($char eq '(' || $char eq ')') )
242             {
243 8 100       23 if ($output_format eq 'plaintext')
    50          
244             {
245 4         16 $checked_text .= $char . '[hanpar]';
246             }
247             elsif ($output_format eq 'html')
248             {
249 4         8 $checked_text .= _tag_html($char, 'hanpar', '半角括弧');
250             }
251             }
252             elsif ( $char eq '※' && ($self->{'78hosetsu_tekiyo'} || $self->{'hosetsu_tekiyo'}) )
253             {
254 4008         9380 my ($replace, $usedlen) = $self->_check_all_hosetsu_tekiyo(\@chars, $i);
255              
256 4008 50       9239 if ($replace)
257             {
258 4008         6549 $checked_text .= $replace;
259 4008         5231 $i += ($usedlen - 1);
260 4008         11364 next;
261             }
262             }
263             else
264             {
265 4572 100 66     47323 if ($self->{'78'} && $J78->{$char})
    100 66        
    100 66        
    100 66        
    100 66        
    100 100        
266             {
267 4 100       14 if ($output_format eq 'plaintext')
    50          
268             {
269 2         11 $checked_text .= $char . '[78](' . $J78->{$char} . ')';
270             }
271             elsif ($output_format eq 'html')
272             {
273 2         6 $checked_text .= _tag_html($char, '78', $J78->{$char});
274             }
275             }
276             elsif ($self->{'jyogai'} && $JYOGAI->{$char})
277             {
278 4 100       15 if ($output_format eq 'plaintext')
    50          
279             {
280 2         10 $checked_text .= $char . '[jyogai]';
281             }
282             elsif ($output_format eq 'html')
283             {
284 2         5 $checked_text .= _tag_html($char, 'jyogai', '新JIS漢字で包摂規準の適用除外となる');
285             }
286             }
287             elsif ($self->{'gonin1'} && $GONIN1->{$char})
288             {
289 8 100       25 if ($output_format eq 'plaintext')
    50          
290             {
291 4         17 $checked_text .= $char . '[gonin1](' . $GONIN1->{$char} . ')';
292             }
293             elsif ($output_format eq 'html')
294             {
295 4         10 $checked_text .= _tag_html($char, 'gonin1', $GONIN1->{$char});
296             }
297             }
298             elsif ($self->{'gonin2'} && $GONIN2->{$char})
299             {
300 8 100       24 if ($output_format eq 'plaintext')
    50          
301             {
302 4         20 $checked_text .= $char . '[gonin2](' . $GONIN2->{$char} . ')';
303             }
304             elsif ($output_format eq 'html')
305             {
306 4         9 $checked_text .= _tag_html($char, 'gonin2', $GONIN2->{$char});
307             }
308             }
309             elsif ($self->{'gonin3'} && $GONIN3->{$char})
310             {
311 8 100       24 if ($output_format eq 'plaintext')
    50          
312             {
313 4         19 $checked_text .= $char . '[gonin3](' . $GONIN3->{$char} . ')';
314             }
315             elsif ($output_format eq 'html')
316             {
317 4         12 $checked_text .= _tag_html($char, 'gonin3', $GONIN3->{$char});
318             }
319             }
320             elsif ( $self->{'gaiji'} && _is_gaiji($char) )
321             {
322 4004 100       9736 if ($output_format eq 'plaintext')
    50          
323             {
324 2002         7945 $checked_text .= $char . '[gaiji]';
325             }
326             elsif ($output_format eq 'html')
327             {
328 2002         3736 $checked_text .= _tag_html($char, 'gaiji', 'JIS外字');
329             }
330             }
331 536         1594 else { $checked_text .= $char; }
332             }
333             }
334              
335 56         8379 return $checked_text;
336             }
337              
338             1;
339              
340             __END__