/[suikacvs]/markup/html/whatpm/Whatpm/Charset/DecodeHandle.pm
Suika

Contents of /markup/html/whatpm/Whatpm/Charset/DecodeHandle.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (hide annotations) (download)
Sun Sep 14 11:57:41 2008 UTC (16 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.16: +3 -1 lines
++ whatpm/Whatpm/ChangeLog	14 Sep 2008 11:56:24 -0000
	* HTML.pm.src: Use |read| instead of |getc|.  |set_inner_html|
	would report character error from now.

2008-09-14  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/Charset/ChangeLog	14 Sep 2008 11:57:38 -0000
	* DecodeHandle.pm (CharString onerror): New method.

	* UnicodeString.pm (read): New.
	(getc): Removed.
	(manakai_read_until): Checking operation implemented.

2008-09-14  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.1 package Whatpm::Charset::DecodeHandle;
2     use strict;
3    
4 wakaba 1.9 ## NOTE: |Message::Charset::Info| uses this module without calling
5     ## the constructor.
6 wakaba 1.15 use Message::Charset::Info;
7 wakaba 1.9
8 wakaba 1.1 my $XML_AUTO_CHARSET = q<http://suika.fam.cx/www/2006/03/xml-entity/>;
9     my $IANA_CHARSET = q<urn:x-suika-fam-cx:charset:>;
10     my $PERL_CHARSET = q<http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.>;
11     my $XML_CHARSET = q<http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.>;
12    
13     ## ->create_decode_handle ($charset_uri, $byte_stream, $onerror)
14     sub create_decode_handle ($$$;$) {
15     my $csdef = $Whatpm::Charset::CharsetDef->{$_[1]};
16     my $obj = {
17 wakaba 1.15 category => 0,
18 wakaba 1.9 char_buffer => \(my $s = ''),
19 wakaba 1.11 char_buffer_pos => 0,
20 wakaba 1.1 character_queue => [],
21     filehandle => $_[2],
22     charset => $_[1],
23     byte_buffer => '',
24     onerror => $_[3] || sub {},
25     };
26     if ($csdef->{uri}->{$XML_AUTO_CHARSET} or
27     $obj->{charset} eq $XML_AUTO_CHARSET) {
28     my $b = ''; # UTF-8 w/o BOM
29     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
30 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
31 wakaba 1.1 if (read $obj->{filehandle}, $b, 256) {
32     no warnings "substr";
33     no warnings "uninitialized";
34     if (substr ($b, 0, 1) eq "<") {
35     if (substr ($b, 1, 1) eq "?") { # ASCII8
36     if ($b =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
37     encoding\s*=\s*["']([^"']*)/x) {
38 wakaba 1.2 $obj->{input_encoding} = $1;
39 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
40     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
41     if (not $csdef->{ascii8} or $csdef->{bom_required}) {
42     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
43     charset_uri => $uri,
44     charset_name => $obj->{input_encoding});
45     }
46     } else {
47     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
48 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
49 wakaba 1.1 }
50     if (defined $csdef->{no_bom_variant}) {
51     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant}};
52     }
53     } elsif (substr ($b, 1, 1) eq "\x00") {
54     if (substr ($b, 2, 2) eq "?\x00") { # ASCII16LE
55     my $c = $b; $c =~ tr/\x00//d;
56     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
57     encoding\s*=\s*["']([^"']*)/x) {
58 wakaba 1.2 $obj->{input_encoding} = $1;
59 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
60     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
61     if (not $csdef->{ascii16} or $csdef->{ascii16be} or
62     $csdef->{bom_required}) {
63     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
64     charset_uri => $uri,
65     charset_name => $obj->{input_encoding});
66     }
67     } else {
68     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
69 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
70 wakaba 1.1 }
71     if (defined $csdef->{no_bom_variant16le}) {
72     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant16le}};
73     }
74     } elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian4321
75     my $c = $b; $c =~ tr/\x00//d;
76     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
77     encoding\s*=\s*["']([^"']*)/x) {
78 wakaba 1.2 $obj->{input_encoding} = $1;
79 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
80     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
81     if (not $csdef->{ascii32} or
82     $csdef->{ascii32endian1234} or
83     $csdef->{ascii32endian2143} or
84     $csdef->{ascii32endian3412} or
85     $csdef->{bom_required}) {
86     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
87     charset_uri => $uri,
88     charset_name => $obj->{input_encoding});
89     }
90     } else {
91     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
92 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
93 wakaba 1.1 }
94     if (defined $csdef->{no_bom_variant32endian4321}) {
95     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian4321}};
96     }
97     }
98     }
99     } elsif (substr ($b, 0, 3) eq "\xEF\xBB\xBF") { # UTF8
100     $obj->{has_bom} = 1;
101     substr ($b, 0, 3) = '';
102     my $c = $b;
103     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
104     encoding\s*=\s*["']([^"']*)/x) {
105 wakaba 1.2 $obj->{input_encoding} = $1;
106 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
107     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
108     if (not $csdef->{utf8_encoding_scheme} or
109     not $csdef->{bom_allowed}) {
110     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
111     charset_uri => $uri,
112     charset_name => $obj->{input_encoding});
113     }
114     } else {
115     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
116 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
117 wakaba 1.1 }
118     if (defined $csdef->{no_bom_variant}) {
119     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant}};
120     }
121     } elsif (substr ($b, 0, 2) eq "\x00<") {
122     if (substr ($b, 2, 2) eq "\x00?") { # ASCII16BE
123     my $c = $b; $c =~ tr/\x00//d;
124     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
125     encoding\s*=\s*["']([^"']*)/x) {
126 wakaba 1.2 $obj->{input_encoding} = $1;
127 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
128     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
129     if (not $csdef->{ascii16} or $csdef->{ascii16le} or
130     $csdef->{bom_required}) {
131     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
132     charset_uri => $uri,
133     charset_name => $obj->{input_encoding});
134     }
135     } else {
136     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
137 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
138 wakaba 1.1 }
139     if (defined $csdef->{no_bom_variant16be}) {
140     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant16be}};
141     }
142     } elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian3412
143     my $c = $b; $c =~ tr/\x00//d;
144     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
145     encoding\s*=\s*["']([^"']*)/x) {
146 wakaba 1.2 $obj->{input_encoding} = $1;
147 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
148     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
149     if (not $csdef->{ascii32} or
150     $csdef->{ascii32endian1234} or
151     $csdef->{ascii32endian2143} or
152     $csdef->{ascii32endian4321} or
153     $csdef->{bom_required}) {
154     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
155     charset_uri => $uri,
156     charset_name => $obj->{input_encoding});
157     }
158     } else {
159     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
160 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
161 wakaba 1.1 }
162     if (defined $csdef->{no_bom_variant32endian3412}) {
163     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian3412}};
164     }
165     }
166     } elsif (substr ($b, 0, 2) eq "\xFE\xFF") {
167     if (substr ($b, 2, 2) eq "\x00<") { # ASCII16BE
168     $obj->{has_bom} = 1;
169     substr ($b, 0, 2) = '';
170     my $c = $b; $c =~ tr/\x00//d;
171     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
172     encoding\s*=\s*["']([^"']*)/x) {
173 wakaba 1.2 $obj->{input_encoding} = $1;
174 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
175     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
176     if (not $csdef->{ascii16} or
177     $csdef->{ascii16le} or
178     not $csdef->{bom_allowed}) {
179     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
180     charset_uri => $uri,
181     charset_name => $obj->{input_encoding});
182     }
183     } else {
184     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
185 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
186 wakaba 1.1 }
187     if (defined $csdef->{no_bom_variant16be}) {
188     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant16be}};
189     }
190     } elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian3412
191     $obj->{has_bom} = 1;
192     substr ($b, 0, 4) = '';
193     my $c = $b; $c =~ tr/\x00//d;
194     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
195     encoding\s*=\s*["']([^"']*)/x) {
196 wakaba 1.2 $obj->{input_encoding} = $1;
197 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
198     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
199     if (not $csdef->{ascii32} or
200     $csdef->{ascii32endian1234} or
201     $csdef->{ascii32endian2143} or
202     $csdef->{ascii32endian4321} or
203     not $csdef->{bom_allowed}) {
204     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
205     charset_uri => $uri,
206     charset_name => $obj->{input_encoding});
207     }
208     } else {
209     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
210 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
211 wakaba 1.1 $obj->{byte_buffer} .= "\x00\x00";
212     }
213     if (defined $csdef->{no_bom_variant32endian3412}) {
214     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian3412}};
215     }
216     } else {
217     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
218 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
219 wakaba 1.1 substr ($b, 0, 2) = '';
220     $obj->{has_bom} = 1;
221     }
222     } elsif (substr ($b, 0, 2) eq "\xFF\xFE") {
223     if (substr ($b, 2, 2) eq "<\x00") { # ASCII16LE
224     $obj->{has_bom} = 1;
225     substr ($b, 0, 2) = '';
226     my $c = $b; $c =~ tr/\x00//d;
227     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
228     encoding\s*=\s*["']([^"']*)/x) {
229 wakaba 1.2 $obj->{input_encoding} = $1;
230 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
231     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
232     if (not $csdef->{ascii16} or
233     $csdef->{ascii16be} or
234     not $csdef->{bom_allowed}) {
235     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
236     charset_uri => $uri,
237     charset_name => $obj->{input_encoding});
238     }
239     } else {
240     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16le'};
241 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
242 wakaba 1.1 }
243     if (defined $csdef->{no_bom_variant16le}) {
244     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant16le}};
245     }
246     } elsif (substr ($b, 2, 2) eq "\x00\x00") { # ASCII32Endian4321
247     $obj->{has_bom} = 1;
248     substr ($b, 0, 4) = '';
249     my $c = $b; $c =~ tr/\x00//d;
250     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
251     encoding\s*=\s*["']([^"']*)/x) {
252 wakaba 1.2 $obj->{input_encoding} = $1;
253 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
254     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
255     if (not $csdef->{ascii32} or
256     $csdef->{ascii32endian1234} or
257     $csdef->{ascii32endian2143} or
258     $csdef->{ascii32endian3412} or
259     not $csdef->{bom_allowed}) {
260     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
261     charset_uri => $uri,
262     charset_name => $obj->{input_encoding});
263     }
264     } else {
265     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16le'};
266 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
267 wakaba 1.1 $obj->{byte_buffer} .= "\x00\x00";
268     }
269     if (defined $csdef->{no_bom_variant32endian4321}) {
270     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian4321}};
271     }
272     } else {
273     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16le'};
274 wakaba 1.2 $obj->{input_encoding} = 'UTF-16';
275 wakaba 1.1 substr ($b, 0, 2) = '';
276     $obj->{has_bom} = 1;
277     }
278     } elsif (substr ($b, 0, 2) eq "\x00\x00") {
279     if (substr ($b, 2, 2) eq "\x00<") { # ASCII32Endian1234
280     my $c = $b; $c =~ tr/\x00//d;
281     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
282     encoding\s*=\s*["']([^"']*)/x) {
283 wakaba 1.2 $obj->{input_encoding} = $1;
284 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
285     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
286     if (not $csdef->{ascii32} or
287     $csdef->{ascii32endian2143} or
288     $csdef->{ascii32endian3412} or
289     $csdef->{ascii32endian4321} or
290     $csdef->{bom_required}) {
291     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
292     charset_uri => $uri,
293     charset_name => $obj->{input_encoding});
294     }
295     } else {
296     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
297 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
298 wakaba 1.1 }
299     if (defined $csdef->{no_bom_variant32endian1234}) {
300     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian1234}};
301     }
302     } elsif (substr ($b, 2, 2) eq "<\x00") { # ASCII32Endian2143
303     my $c = $b; $c =~ tr/\x00//d;
304     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
305     encoding\s*=\s*["']([^"']*)/x) {
306 wakaba 1.2 $obj->{input_encoding} = $1;
307 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
308     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
309     if (not $csdef->{ascii32} or
310     $csdef->{ascii32endian1234} or
311     $csdef->{ascii32endian3412} or
312     $csdef->{ascii32endian4321} or
313     $csdef->{bom_required}) {
314     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
315     charset_uri => $uri,
316     charset_name => $obj->{input_encoding});
317     }
318     } else {
319     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
320 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
321 wakaba 1.1 }
322     if (defined $csdef->{no_bom_variant32endian2143}) {
323     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian2143}};
324     }
325     } elsif (substr ($b, 2, 2) eq "\xFE\xFF") { # ASCII32Endian1234
326     $obj->{has_bom} = 1;
327     substr ($b, 0, 4) = '';
328     my $c = $b; $c =~ tr/\x00//d;
329     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
330     encoding\s*=\s*["']([^"']*)/x) {
331 wakaba 1.2 $obj->{input_encoding} = $1;
332 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
333     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
334     if (not $csdef->{ascii32} or
335     $csdef->{ascii32endian2143} or
336     $csdef->{ascii32endian3412} or
337     $csdef->{ascii32endian4321} or
338     $csdef->{bom_required}) {
339     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
340     charset_uri => $uri,
341     charset_name => $obj->{input_encoding});
342     }
343     } else {
344     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
345 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
346 wakaba 1.1 $obj->{has_bom} = 0;
347     $obj->{byte_buffer} .= "\x00\x00\xFE\xFF";
348     }
349     if (defined $csdef->{no_bom_variant32endian1234}) {
350     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian1234}};
351     }
352     } elsif (substr ($b, 2, 2) eq "\xFF\xFE") { # ASCII32Endian2143
353     $obj->{has_bom} = 1;
354     substr ($b, 0, 4) = '';
355     my $c = $b; $c =~ tr/\x00//d;
356     if ($c =~ /^<\?xml\s+(?:version\s*=\s*["'][^"']*["']\s*)?
357     encoding\s*=\s*["']([^"']*)/x) {
358 wakaba 1.2 $obj->{input_encoding} = $1;
359 wakaba 1.1 my $uri = name_to_uri (undef, 'xml', $obj->{input_encoding});
360     $csdef = $Whatpm::Charset::CharsetDef->{$uri};
361     if (not $csdef->{ascii32} or
362     $csdef->{ascii32endian1234} or
363     $csdef->{ascii32endian3412} or
364     $csdef->{ascii32endian4321} or
365     $csdef->{bom_required}) {
366     $obj->{onerror}->(undef, 'charset-name-mismatch-error',
367     charset_uri => $uri,
368     charset_name => $obj->{input_encoding});
369     }
370     } else {
371     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'};
372 wakaba 1.2 $obj->{input_encoding} = 'UTF-8';
373 wakaba 1.1 $obj->{has_bom} = 0;
374     $obj->{byte_buffer} .= "\x00\x00\xFF\xFE";
375     }
376     if (defined $csdef->{no_bom_variant32endian2143}) {
377     $csdef = $Whatpm::Charset::CharsetDef->{$csdef->{no_bom_variant32endian2143}};
378     }
379     }
380     # \x4C\x6F\xA7\x94 EBCDIC
381     } # buffer
382     $obj->{byte_buffer} .= $b;
383     } # read
384     } elsif ($csdef->{uri}->{$XML_CHARSET.'utf-8'}) {
385     ## BOM is optional.
386     my $b = '';
387     if (read $obj->{filehandle}, $b, 3) {
388     if ($b eq "\xEF\xBB\xBF") {
389     $obj->{has_bom} = 1;
390     } else {
391     $obj->{byte_buffer} .= $b;
392     }
393     }
394     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-8'}; # UTF-8 w/o BOM
395     } elsif ($csdef->{uri}->{$XML_CHARSET.'utf-16'}) {
396     ## BOM is mandated.
397     my $b = '';
398     if (read $obj->{filehandle}, $b, 2) {
399     if ($b eq "\xFE\xFF") {
400     $obj->{has_bom} = 1; # UTF-16BE w/o BOM
401     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
402     } elsif ($b eq "\xFF\xFE") {
403     $obj->{has_bom} = 1; # UTF-16LE w/o BOM
404     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16le'};
405     } else {
406     $obj->{onerror}->(undef, 'no-bom-error', charset_uri => $obj->{charset});
407     $obj->{has_bom} = 0;
408     $obj->{byte_buffer} .= $b; # UTF-16BE w/o BOM
409     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
410     }
411     } else {
412     $obj->{onerror}->(undef, 'no-bom-error', charset_uri => $obj->{charset});
413     $obj->{has_bom} = 0; # UTF-16BE w/o BOM
414     $csdef = $Whatpm::Charset::CharsetDef->{$PERL_CHARSET.'utf-16be'};
415     }
416     }
417    
418     if ($csdef->{uri}->{$XML_CHARSET.'iso-2022-jp'}) {
419     $obj->{state_2440} = 'gl-jis-1997-swapped';
420     $obj->{state_2442} = 'gl-jis-1997';
421     $obj->{state} = 'state_2842';
422     require Encode::GLJIS1997Swapped;
423     require Encode::GLJIS1997;
424     if (Encode::find_encoding ($obj->{state_2440}) and
425     Encode::find_encoding ($obj->{state_2442})) {
426     return bless $obj, 'Whatpm::Charset::DecodeHandle::ISO2022JP';
427     }
428     } elsif ($csdef->{uri}->{$IANA_CHARSET.'iso-2022-jp'}) {
429     $obj->{state_2440} = 'gl-jis-1978';
430     $obj->{state_2442} = 'gl-jis-1983';
431     $obj->{state} = 'state_2842';
432     require Encode::GLJIS1978;
433     require Encode::GLJIS1983;
434     if (Encode::find_encoding ($obj->{state_2440}) and
435     Encode::find_encoding ($obj->{state_2442})) {
436     return bless $obj, 'Whatpm::Charset::DecodeHandle::ISO2022JP';
437     }
438     } elsif (defined $csdef->{perl_name}->[0]) {
439     if ($csdef->{uri}->{$XML_CHARSET.'euc-jp'} or
440     $csdef->{uri}->{$IANA_CHARSET.'euc-jp'}) {
441     $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
442     require Encode::EUCJP1997;
443     if (Encode::find_encoding ($obj->{perl_encoding_name})) {
444 wakaba 1.15 $obj->{category} |= Message::Charset::Info::CHARSET_CATEGORY_EUCJP;
445     return bless $obj, 'Whatpm::Charset::DecodeHandle::Encode';
446 wakaba 1.1 }
447     } elsif ($csdef->{uri}->{$XML_CHARSET.'shift_jis'} or
448     $csdef->{uri}->{$IANA_CHARSET.'shift_jis'}) {
449     $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
450     require Encode::ShiftJIS1997;
451     if (Encode::find_encoding ($obj->{perl_encoding_name})) {
452 wakaba 1.16 return bless $obj, 'Whatpm::Charset::DecodeHandle::Encode';
453 wakaba 1.1 }
454     } elsif ($csdef->{is_block_safe}) {
455     $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
456     require Encode;
457     if (Encode::find_encoding ($obj->{perl_encoding_name})) {
458     return bless $obj, 'Whatpm::Charset::DecodeHandle::Encode';
459     }
460     }
461     }
462    
463     $obj->{onerror}->(undef, 'charset-not-supported-error',
464     charset_uri => $obj->{charset});
465     return undef;
466     } # create_decode_handle
467    
468     sub name_to_uri ($$$) {
469     my $domain = $_[1];
470     my $name = lc $_[2];
471    
472     if ($domain eq 'ietf') {
473     return $IANA_CHARSET . $name;
474     } elsif ($domain eq 'xml') {
475     if ({
476     'utf-8' => 1,
477     'utf-16' => 1,
478     'iso-10646-ucs-2' => 1,
479     'iso-10646-ucs-4' => 1,
480     'iso-8859-1' => 1,
481     'iso-8859-2' => 1,
482     'iso-8859-3' => 1,
483     'iso-8859-4' => 1,
484     'iso-8859-5' => 1,
485     'iso-8859-6' => 1,
486     'iso-8859-7' => 1,
487     'iso-8859-8' => 1,
488     'iso-8859-9' => 1,
489     'iso-8859-10' => 1,
490     'iso-8859-11' => 1,
491     'iso-8859-13' => 1,
492     'iso-8859-14' => 1,
493     'iso-8859-15' => 1,
494     'iso-8859-16' => 1,
495     'iso-2022-jp' => 1,
496     'shift_jis' => 1,
497     'euc-jp' => 1,
498     }->{$name}) {
499     return $XML_CHARSET . $name;
500     }
501    
502     my $uri = $IANA_CHARSET . $name;
503     return $uri if $Whatpm::Charset::CharsetDef->{$uri};
504    
505     return $XML_CHARSET . $name;
506     } else {
507     return undef;
508     }
509     } # name_to_uri
510    
511     sub uri_to_name ($$$) {
512     my (undef, $domain, $uri) = @_;
513 wakaba 1.2
514     if ($domain eq 'xml') {
515     my $v = $Whatpm::Charset::CharsetDef->{$uri}->{xml_name};
516     return $v if defined $v;
517    
518     if (substr ($uri, 0, length $XML_CHARSET) eq $XML_CHARSET) {
519     return substr ($uri, length $XML_CHARSET);
520     }
521    
522     $domain = 'ietf'; ## TODO: XML encoding name has smaller range
523     }
524    
525     if ($domain eq 'ietf') {
526     my $v = $Whatpm::Charset::CharsetDef->{$uri}->{iana_name};
527     return $v->[0] if defined $v;
528    
529     if (substr ($uri, 0, length $IANA_CHARSET) eq $IANA_CHARSET) {
530 wakaba 1.1 return substr ($uri, length $IANA_CHARSET);
531     }
532     }
533    
534     return undef;
535     } # uri_to_name
536    
537 wakaba 1.3 require IO::Handle;
538    
539     package Whatpm::Charset::DecodeHandle::ByteBuffer;
540    
541 wakaba 1.7 ## NOTE: Provides a byte buffer wrapper object.
542    
543 wakaba 1.3 sub new ($$) {
544     my $self = bless {
545     buffer => '',
546     }, shift;
547     $self->{filehandle} = shift;
548     return $self;
549     } # new
550    
551     sub read {
552     my $self = shift;
553     my $pos = length $self->{buffer};
554     my $r = $self->{filehandle}->read ($self->{buffer}, $_[1], $pos);
555     substr ($_[0], $_[2]) = substr ($self->{buffer}, $pos);
556 wakaba 1.8 ## NOTE: This would do different behavior from Perl's standard
557     ## |read| when $pos points beyond the end of the string.
558 wakaba 1.3 return $r;
559     } # read
560    
561     sub close { $_[0]->{filehandle}->close }
562    
563 wakaba 1.11 package Whatpm::Charset::DecodeHandle::CharString;
564    
565     ## NOTE: Same as Perl's standard |open $handle, '<', \$char_string|,
566     ## but supports |ungetc| and other extensions.
567    
568     sub new ($$) {
569     my $self = bless {pos => 0}, shift;
570     $self->{string} = shift; # must be a scalar ref
571     return $self;
572     } # new
573    
574     sub getc ($) {
575     my $self = shift;
576     if ($self->{pos} < length ${$self->{string}}) {
577     return substr ${$self->{string}}, $self->{pos}++, 1;
578     } else {
579     return undef;
580     }
581     } # getc
582    
583     sub read ($$$$) {
584     #my ($self, $scalar, $length, $offset) = @_;
585     my $self = $_[0];
586     my $length = $_[2] || 0;
587     my $offset = $_[3];
588     ## NOTE: We don't support standard Perl semantics if $offset is
589     ## greater than the length of $scalar.
590     substr ($_[1], $offset) = substr (${$self->{string}}, $self->{pos}, $length);
591     my $count = (length $_[1]) - $offset;
592     $self->{pos} += $count;
593     return $count;
594     } # read
595    
596 wakaba 1.12 sub manakai_read_until ($$$;$) {
597     #my ($self, $scalar, $pattern, $offset) = @_;
598     my $self = $_[0];
599 wakaba 1.11 pos (${$self->{string}}) = $self->{pos};
600 wakaba 1.12 if (${$self->{string}} =~ /\G(?>$_[2])+/) {
601     substr ($_[1], $_[3]) = substr (${$self->{string}}, $-[0], $+[0] - $-[0]);
602 wakaba 1.11 $self->{pos} += $+[0] - $-[0];
603 wakaba 1.12 return $+[0] - $-[0];
604 wakaba 1.11 } else {
605 wakaba 1.12 return 0;
606 wakaba 1.11 }
607 wakaba 1.12 } # manakai_read_until
608 wakaba 1.11
609     sub ungetc ($$) {
610     my $self = shift;
611     ## Ignore second parameter.
612     $self->{pos}-- if $self->{pos} > 0;
613     } # ungetc
614    
615     sub close ($) { }
616    
617 wakaba 1.17 sub onerror ($;$) { }
618    
619 wakaba 1.1 package Whatpm::Charset::DecodeHandle::Encode;
620    
621 wakaba 1.7 ## NOTE: Provides a Perl |Encode| module wrapper object.
622    
623 wakaba 1.1 sub charset ($) { $_[0]->{charset} }
624    
625 wakaba 1.3 sub close ($) { $_[0]->{filehandle}->close }
626 wakaba 1.1
627     sub getc ($) {
628 wakaba 1.9 my $c = '';
629     my $l = $_[0]->read ($c, 1);
630     if ($l) {
631     return $c;
632     } else {
633     return undef;
634     }
635     } # getc
636    
637     sub read ($$$;$) {
638 wakaba 1.1 my $self = $_[0];
639 wakaba 1.14 #my $scalar = $_[1];
640     my $length = $_[2];
641     my $offset = $_[3] || 0;
642     my $count = 0;
643     my $eof;
644     ## NOTE: It is incompatible with the standard Perl semantics
645     ## if $offset is greater than the length of $scalar.
646    
647     A: {
648     return $count if $length < 1;
649    
650     if (my $l = (length ${$self->{char_buffer}}) - $self->{char_buffer_pos}) {
651     if ($l >= $length) {
652     substr ($_[1], $offset)
653     = substr (${$self->{char_buffer}}, $self->{char_buffer_pos},
654     $length);
655     $count += $length;
656     $self->{char_buffer_pos} += $length;
657     $length = 0;
658     return $count;
659     } else {
660     substr ($_[1], $offset)
661     = substr (${$self->{char_buffer}}, $self->{char_buffer_pos});
662     $count += $l;
663     $length -= $l;
664     ${$self->{char_buffer}} = '';
665     $self->{char_buffer_pos} = 0;
666     }
667     $offset = length $_[1];
668     }
669 wakaba 1.1
670 wakaba 1.14 if ($eof) {
671     return $count;
672 wakaba 1.1 }
673 wakaba 1.14
674     my $error;
675     if ($self->{continue}) {
676     if ($self->{filehandle}->read ($self->{byte_buffer}, 256,
677     length $self->{byte_buffer})) {
678     #
679     } else {
680     $error = 1;
681     }
682     $self->{continue} = 0;
683     } elsif (512 > length $self->{byte_buffer}) {
684     if ($self->{filehandle}->read ($self->{byte_buffer}, 256,
685     length $self->{byte_buffer})) {
686     #
687     } else {
688     $eof = 1;
689 wakaba 1.1 }
690 wakaba 1.14 }
691    
692     unless ($error) {
693 wakaba 1.15 if (not $self->{bom_checked}) {
694     if (defined $self->{bom_pattern}) {
695     if ($self->{byte_buffer} =~ s/^$self->{bom_pattern}//) {
696     $self->{has_bom} = 1;
697     }
698     }
699     $self->{bom_checked} = 1;
700     }
701    
702 wakaba 1.14 my $string = Encode::decode ($self->{perl_encoding_name},
703     $self->{byte_buffer},
704     Encode::FB_QUIET ());
705     if (length $string) {
706     $self->{char_buffer} = \$string;
707     $self->{char_buffer_pos} = 0;
708     if (length $self->{byte_buffer}) {
709     $self->{continue} = 1;
710     }
711 wakaba 1.1 } else {
712 wakaba 1.14 if (length $self->{byte_buffer}) {
713     $error = 1;
714     } else {
715     ## NOTE: No further input.
716     redo A;
717     }
718 wakaba 1.1 }
719     }
720    
721 wakaba 1.14 if ($error) {
722     my $r = substr $self->{byte_buffer}, 0, 1, '';
723 wakaba 1.15 my $fallback;
724 wakaba 1.14 my $etype = 'illegal-octets-error';
725 wakaba 1.15 my %earg;
726     if ($self->{category}
727 wakaba 1.16 & Message::Charset::Info::CHARSET_CATEGORY_SJIS) {
728     if ($r =~ /^[\x81-\x9F\xE0-\xFC]/) {
729     if ($self->{byte_buffer} =~ s/(.)//s) {
730     $r .= $1; # not limited to \x40-\xFC - \x7F
731     $etype = 'unassigned-code-point-error';
732     }
733     ## NOTE: Range [\xF0-\xFC] is unassigned and may be used as a
734     ## single-byte character or as the first-byte of a double-byte
735     ## character, according to JIS X 0208:1997 Appendix 1. However, the
736     ## current practice is using the range as first-bytes of double-byte
737     ## characters.
738     } elsif ($r =~ /^[\x80\xA0\xFD-\xFF]/) {
739     $etype = 'unassigned-code-point-error';
740     }
741     } elsif ($self->{category}
742     & Message::Charset::Info::CHARSET_CATEGORY_EUCJP) {
743 wakaba 1.15 if ($r =~ /^[\xA1-\xFE]/) {
744     if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {
745     $r .= $1;
746     $etype = 'unassigned-code-point-error';
747     }
748     } elsif ($r eq "\x8F") {
749     if ($self->{byte_buffer} =~ s/^([\xA1-\xFE][\xA1-\xFE]?)//) {
750     $r .= $1;
751     $etype = 'unassigned-code-point-error' if length $1 == 2;
752     }
753     } elsif ($r eq "\x8E") {
754     if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {
755     $r .= $1;
756     $etype = 'unassigned-code-point-error';
757     }
758     } elsif ($r eq "\xA0" or $r eq "\xFF") {
759 wakaba 1.14 $etype = 'unassigned-code-point-error';
760     }
761 wakaba 1.15 } else {
762     $fallback = $self->{fallback}->{$r};
763     if (defined $fallback) {
764     ## NOTE: This is an HTML5 parse error.
765     $etype = 'fallback-char-error';
766     $earg{char} = \$fallback;
767     } elsif (exists $self->{fallback}->{$r}) {
768     ## NOTE: This is an HTML5 parse error. In addition, the octet
769     ## is not assigned with a character.
770     $etype = 'fallback-unassigned-error';
771 wakaba 1.14 }
772 wakaba 1.1 }
773 wakaba 1.15
774 wakaba 1.14 ## NOTE: Fixup line/column number by counting the number of
775     ## lines/columns in the string that is to be retuend by this
776     ## method call.
777     my $line_diff = 0;
778     my $col_diff = 0;
779     my $set_col;
780     for (my $i = 0; $i < $count; $i++) {
781     my $s = substr $_[1], $i - $count, 1;
782     if ($s eq "\x0D") {
783     $line_diff++;
784     $col_diff = 0;
785     $set_col = 1;
786     $i++ if substr ($_[1], $i - $count + 1, 1) eq "\x0A";
787     } elsif ($s eq "\x0A") {
788     $line_diff++;
789     $col_diff = 0;
790     $set_col = 1;
791     } else {
792     $col_diff++;
793     }
794     }
795     my $i = $self->{char_buffer_pos};
796     if ($count and substr (${$self->{char_buffer}}, -1, 1) eq "\x0D") {
797     if (substr (${$self->{char_buffer}}, $i, 1) eq "\x0A") {
798     $i++;
799     }
800 wakaba 1.1 }
801 wakaba 1.14 my $cb_length = length ${$self->{char_buffer}};
802     for (; $i < $cb_length; $i++) {
803     my $s = substr $_[1], $i, 1;
804     if ($s eq "\x0D") {
805     $line_diff++;
806     $col_diff = 0;
807     $set_col = 1;
808     $i++ if substr ($_[1], $i + 1, 1) eq "\x0A";
809     } elsif ($s eq "\x0A") {
810     $line_diff++;
811     $col_diff = 0;
812     $set_col = 1;
813     } else {
814     $col_diff++;
815     }
816 wakaba 1.1 }
817 wakaba 1.15 $self->{onerror}->($self, $etype, octets => \$r, %earg,
818 wakaba 1.14 level => $self->{level}->{$self->{error_level}->{$etype}},
819     line_diff => $line_diff,
820     ($set_col ? (column => 1) : ()),
821     column_diff => $col_diff);
822     ## NOTE: Error handler may modify |octets| parameter, which
823     ## would be returned as part of the output. Note that what
824     ## is returned would affect what |manakai_read_until| returns.
825 wakaba 1.15 ${$self->{char_buffer}} .= defined $fallback ? $fallback : $r;
826 wakaba 1.1 }
827    
828 wakaba 1.14 redo A;
829     } # A
830 wakaba 1.9 } # read
831    
832 wakaba 1.15 sub manakai_read_until ($$$;$) {
833     #my ($self, $scalar, $pattern, $offset) = @_;
834     my $self = $_[0];
835     my $s = '';
836     $self->read ($s, 255);
837     if ($s =~ /^(?>$_[2])+/) {
838     my $rem_length = (length $s) - $+[0];
839     if ($rem_length) {
840     if ($self->{char_buffer_pos} > $rem_length) {
841     $self->{char_buffer_pos} -= $rem_length;
842     } else {
843     substr (${$self->{char_buffer}}, 0, $self->{char_buffer_pos})
844     = substr ($s, $+[0]);
845     $self->{char_buffer_pos} = 0;
846     }
847     }
848     substr ($_[1], $_[3]) = substr ($s, $-[0], $+[0] - $-[0]);
849     return $+[0];
850     } elsif (length $s) {
851     if ($self->{char_buffer_pos} > length $s) {
852     $self->{char_buffer_pos} -= length $s;
853     } else {
854     substr (${$self->{char_buffer}}, 0, $self->{char_buffer_pos}) = $s;
855     $self->{char_buffer_pos} = 0;
856     }
857     }
858     return 0;
859     } # manakai_read_until
860    
861     sub has_bom ($) { $_[0]->{has_bom} }
862    
863     sub input_encoding ($) {
864     my $v = $_[0]->{input_encoding};
865     return $v if defined $v;
866    
867     my $uri = $_[0]->{charset};
868     if (defined $uri) {
869     return Whatpm::Charset::DecodeHandle->uri_to_name (xml => $uri);
870     }
871    
872     return undef;
873     } # input_encoding
874    
875     sub onerror ($;$) {
876     if (@_ > 1) {
877     $_[0]->{onerror} = $_[1];
878     }
879    
880     return $_[0]->{onerror};
881     } # onerror
882    
883     sub ungetc ($$) {
884     unshift @{$_[0]->{character_queue}}, chr int ($_[1] or 0);
885     } # ungetc
886    
887 wakaba 1.1 package Whatpm::Charset::DecodeHandle::ISO2022JP;
888     push our @ISA, 'Whatpm::Charset::DecodeHandle::Encode';
889    
890     sub getc ($) {
891     my $self = $_[0];
892     return shift @{$self->{character_queue}} if @{$self->{character_queue}};
893    
894     my $r;
895     A: {
896     my $error;
897     if ($self->{continue}) {
898 wakaba 1.3 if ($self->{filehandle}->read ($self->{byte_buffer}, 256,
899     length $self->{byte_buffer})) {
900 wakaba 1.1 #
901     } else {
902     $error = 1;
903     }
904     $self->{continue} = 0;
905     } elsif (512 > length $self->{byte_buffer}) {
906 wakaba 1.3 $self->{filehandle}->read ($self->{byte_buffer}, 256,
907     length $self->{byte_buffer});
908 wakaba 1.1 }
909    
910     unless ($error) {
911     if ($self->{byte_buffer} =~ s/^\x1B(\x24[\x40\x42]|\x28[\x42\x4A])//) {
912     $self->{state} = {
913     "\x24\x40" => 'state_2440',
914     "\x24\x42" => 'state_2442',
915     "\x28\x42" => 'state_2842',
916     "\x28\x4A" => 'state_284A',
917     }->{$1};
918     redo A;
919     } elsif ($self->{state} eq 'state_2842') { # IRV
920     if ($self->{byte_buffer} =~ s/^([\x00-\x0D\x10-\x1A\x1C-\x7F]+)//) {
921     push @{$self->{character_queue}}, split //, $1;
922     $r = shift @{$self->{character_queue}};
923     } else {
924     if (length $self->{byte_buffer}) {
925     $error = 1;
926     } else {
927     $r = undef;
928     }
929     }
930     } elsif ($self->{state} eq 'state_284A') { # 0201
931     if ($self->{byte_buffer} =~ s/^([\x00-\x0D\x10-\x1A\x1C-\x7F]+)//) {
932     my $v = $1;
933     $v =~ tr/\x5C\x7E/\xA5\x{203E}/;
934     push @{$self->{character_queue}}, split //, $v;
935     $r = shift @{$self->{character_queue}};
936     } else {
937     if (length $self->{byte_buffer}) {
938     $error = 1;
939     } else {
940     $r = undef;
941     $self->{onerror}->($self, 'invalid-state-error',
942 wakaba 1.7 state => $self->{state},
943     level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
944 wakaba 1.1 }
945     }
946     } elsif ($self->{state} eq 'state_2442') { # 1983
947     my $v = Encode::decode ($self->{state_2442},
948     $self->{byte_buffer},
949     Encode::FB_QUIET ());
950     if (length $v) {
951     push @{$self->{character_queue}}, split //, $v;
952     $r = shift @{$self->{character_queue}};
953     } else {
954     if (length $self->{byte_buffer}) {
955     $error = 1;
956     } else {
957     $r = undef;
958     $self->{onerror}->($self, 'invalid-state-error',
959 wakaba 1.7 state => $self->{state},
960     level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
961 wakaba 1.1 }
962     }
963     } elsif ($self->{state} eq 'state_2440') { # 1978
964     my $v = Encode::decode ($self->{state_2440},
965     $self->{byte_buffer},
966     Encode::FB_QUIET ());
967     if (length $v) {
968     push @{$self->{character_queue}}, split //, $v;
969     $r = shift @{$self->{character_queue}};
970     } else {
971     if (length $self->{byte_buffer}) {
972     $error = 1;
973     } else {
974     $r = undef;
975     $self->{onerror}->($self, 'invalid-state-error',
976 wakaba 1.7 state => $self->{state},
977     level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
978 wakaba 1.1 }
979     }
980     } else {
981     $error = 1;
982     }
983     }
984    
985     if ($error) {
986     $r = substr $self->{byte_buffer}, 0, 1, '';
987     my $etype = 'illegal-octets-error';
988     if (($self->{state} eq 'state_2442' or
989     $self->{state} eq 'state_2440') and
990     $r =~ /^[\x21-\x7E]/ and
991     $self->{byte_buffer} =~ s/^([\x21-\x7E])//) {
992     $r .= $1;
993     $etype = 'unassigned-code-point-error';
994     } elsif ($r eq "\x1B" and
995     $self->{byte_buffer} =~ s/^\(H//) { # Old 0201
996     $r .= "(H";
997     $self->{state} = 'state_284A';
998     }
999 wakaba 1.7 $self->{onerror}->($self, $etype, octets => \$r,
1000     level => $self->{level}->{$self->{error_level}->{$etype}});
1001 wakaba 1.1 }
1002     } # A
1003    
1004     return $r;
1005     } # getc
1006    
1007 wakaba 1.9 ## TODO: This is not good for performance. Should be replaced
1008     ## by read-centric implementation.
1009     sub read ($$$;$) {
1010     #my ($self, $scalar, $length, $offset) = @_;
1011     my $length = $_[2];
1012     my $r = '';
1013     while ($length > 0) {
1014     my $c = $_[0]->getc;
1015     last unless defined $c;
1016     $r .= $c;
1017     $length--;
1018     }
1019     substr ($_[1], $_[3]) = $r;
1020     ## NOTE: This would do different thing from what Perl's |read| do
1021     ## if $offset points beyond the end of the $scalar.
1022     return length $r;
1023     } # read
1024    
1025 wakaba 1.12 sub manakai_read_until ($$$;$) {
1026     #my ($self, $scalar, $pattern, $offset) = @_;
1027     my $self = $_[0];
1028 wakaba 1.11 my $c = $self->getc;
1029 wakaba 1.12 if ($c =~ /^$_[2]/) {
1030     substr ($_[1], $_[3]) = $c;
1031     return 1;
1032 wakaba 1.11 } elsif (defined $c) {
1033     $self->ungetc (ord $c);
1034 wakaba 1.12 return 0;
1035 wakaba 1.11 } else {
1036 wakaba 1.12 return 0;
1037 wakaba 1.11 }
1038 wakaba 1.12 } # manakai_read_until
1039 wakaba 1.11
1040 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us-ascii'} =
1041     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us'} =
1042     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso646-us'} =
1043     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:cp367'} =
1044     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:ibm367'} =
1045     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:ansi_x3.4-1986'} =
1046     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:ansi_x3.4-1968'} =
1047     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso-ir-6'} =
1048     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:csascii'} =
1049     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso_646.irv:1991'} =
1050     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:ascii'} = {ascii8 =>
1051     '1',
1052     is_block_safe =>
1053     '1',
1054     ietf_name =>
1055     ['ansi_x3.4-1968',
1056     'ansi_x3.4-1986',
1057     'ascii',
1058     'cp367',
1059     'csascii',
1060     'ibm367',
1061     'iso-ir-6',
1062     'iso646-us',
1063     'iso_646.irv:1991',
1064     'us',
1065     'us-ascii',
1066     'us-ascii'],
1067     mime_name =>
1068     'us-ascii',
1069     perl_name =>
1070     ['ascii',
1071     'iso-646-us',
1072     'us-ascii'],
1073     utf8_encoding_scheme =>
1074     '1',
1075     'uri',
1076     {'urn:x-suika-fam-cx:charset:ansi_x3.4-1968',
1077     '1',
1078     'urn:x-suika-fam-cx:charset:ansi_x3.4-1986',
1079     '1',
1080     'urn:x-suika-fam-cx:charset:ascii',
1081     '1',
1082     'urn:x-suika-fam-cx:charset:cp367',
1083     '1',
1084     'urn:x-suika-fam-cx:charset:csascii',
1085     '1',
1086     'urn:x-suika-fam-cx:charset:ibm367',
1087     '1',
1088     'urn:x-suika-fam-cx:charset:iso-ir-6',
1089     '1',
1090     'urn:x-suika-fam-cx:charset:iso646-us',
1091     '1',
1092     'urn:x-suika-fam-cx:charset:iso_646.irv:1991',
1093     '1',
1094     'urn:x-suika-fam-cx:charset:us',
1095     '1',
1096     'urn:x-suika-fam-cx:charset:us-ascii',
1097     '1'},
1098 wakaba 1.2 };
1099    
1100 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ascii-ctrl'} = {perl_name =>
1101     ['ascii-ctrl'],
1102     'uri',
1103     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ascii-ctrl',
1104     '1'}};
1105     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.null'} = {perl_name =>
1106     ['null'],
1107     'uri',
1108     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.null',
1109     '1'}};
1110     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.utf-8'} = {ascii8 =>
1111     '1',
1112     bom_allowed =>
1113     '1',
1114     no_bom_variant =>
1115     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf8',
1116     utf8_encoding_scheme =>
1117     '1',
1118     'uri',
1119     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.utf-8',
1120     '1'},
1121 wakaba 1.2 xml_name => 'UTF-8',
1122     };
1123    
1124 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/UTF-8.RFC2279'} = {ascii8 =>
1125     '1',
1126     bom_allowed =>
1127     '1',
1128     no_bom_variant =>
1129     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf8',
1130     utf8_encoding_scheme =>
1131     '1',
1132     'uri',
1133     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/UTF-8.RFC2279',
1134     '1'}};
1135     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-8'} = {
1136     ascii8 => 1,
1137     is_block_safe =>
1138     '1',
1139     perl_name =>
1140     ['utf-8'],
1141     utf8_encoding_scheme =>
1142     '1',
1143     'uri',
1144     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-8',
1145     '1'}};
1146     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:utf-8'} = {
1147     ascii8 => 1,
1148     bom_allowed =>
1149     '1',
1150     no_bom_variant =>
1151     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-8',
1152     ietf_name =>
1153     ['utf-8'],
1154     mime_name =>
1155     'utf-8',
1156     utf8_encoding_scheme =>
1157     '1',
1158     'uri',
1159     {'urn:x-suika-fam-cx:charset:utf-8',
1160     '1'},
1161 wakaba 1.2 };
1162    
1163 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf8'} = {ascii8 =>
1164     '1',
1165     is_block_safe =>
1166     '1',
1167     perl_name =>
1168     ['utf8'],
1169     utf8_encoding_scheme =>
1170     '1',
1171     'uri',
1172     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf8',
1173     '1'}};
1174     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.utf-16'} = {
1175     ascii16 => 1,
1176     bom_allowed =>
1177     '1',
1178     bom_required =>
1179     '1',
1180     no_bom_variant =>
1181     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1182     no_bom_variant16be =>
1183     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be',
1184     no_bom_variant16le =>
1185     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1186     perl_name =>
1187     ['utf-16'],
1188     'uri',
1189     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.utf-16',
1190     '1'},
1191 wakaba 1.2 xml_name => 'UTF-16',
1192     };
1193    
1194 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:utf-16'} = {
1195     ascii16 => 1,
1196     bom_allowed =>
1197     '1',
1198     no_bom_variant =>
1199     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1200     no_bom_variant16be =>
1201     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be',
1202     no_bom_variant16le =>
1203     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1204     ietf_name =>
1205     ['utf-16'],
1206     mime_name =>
1207     'utf-16',
1208     'uri',
1209     {'urn:x-suika-fam-cx:charset:utf-16',
1210     '1'},
1211 wakaba 1.2 };
1212    
1213 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:utf-16be'} = {
1214     ascii16 => 1,
1215     ascii16be => 1,
1216     bom_allowed =>
1217     '1',
1218     no_bom_variant =>
1219     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be',
1220     no_bom_variant16be =>
1221     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be',
1222     ietf_name =>
1223     ['utf-16be'],
1224     mime_name =>
1225     'utf-16be',
1226     'uri',
1227     {'urn:x-suika-fam-cx:charset:utf-16be',
1228     '1'},
1229 wakaba 1.2 };
1230    
1231 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:utf-16le'} = {
1232     ascii16 => 1,
1233     ascii16le => 1,
1234     bom_allowed =>
1235     '1',
1236     no_bom_variant =>
1237     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1238     no_bom_variant16le =>
1239     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1240     ietf_name =>
1241     ['utf-16le'],
1242     mime_name =>
1243     'utf-16le',
1244     'uri',
1245     {'urn:x-suika-fam-cx:charset:utf-16le',
1246     '1'},
1247 wakaba 1.2 };
1248    
1249 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be'} = {
1250     ascii16 => 1,
1251     ascii16be => 1,
1252     is_block_safe =>
1253     '1',
1254     perl_name =>
1255     ['utf-16be'],
1256     'uri',
1257     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16be',
1258     '1'}};
1259     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le'} = {
1260     ascii16 => 1,
1261     ascii16le => 1,
1262     is_block_safe =>
1263     '1',
1264     perl_name =>
1265     ['utf-16le'],
1266     'uri',
1267     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-16le',
1268     '1'}};
1269     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-10646-ucs-2'} = $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso-10646-ucs-2'} = {
1270     ascii16 => 1,
1271     bom_allowed =>
1272     '1',
1273     no_bom_variant =>
1274     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2le',
1275     no_bom_variant16be =>
1276     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2be',
1277     no_bom_variant16le =>
1278     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2le',
1279     ietf_name =>
1280     ['csunicode',
1281     'iso-10646-ucs-2'],
1282     mime_name =>
1283     'iso-10646-ucs-2',
1284     'uri',
1285     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-10646-ucs-2',
1286     '1',
1287     'urn:x-suika-fam-cx:charset:iso-10646-ucs-2',
1288     '1'},
1289 wakaba 1.2 xml_name => 'ISO-10646-UCS-2',
1290     };
1291    
1292 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2be'} = {
1293     ascii16 => 1,
1294     ascii16be => 1,
1295     is_block_safe =>
1296     '1',
1297     perl_name =>
1298     ['ucs-2be'],
1299     'uri',
1300     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2be',
1301     '1'}};
1302     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2le'} = {
1303     ascii16 => 1,
1304     ascii16le => 1,
1305     is_block_safe =>
1306     '1',
1307     perl_name =>
1308     ['ucs-2le'],
1309     'uri',
1310     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.ucs-2le',
1311     '1'}};
1312     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-10646-ucs-4'} = $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso-10646-ucs-4'} = {
1313     ascii32 => 1,
1314     bom_allowed =>
1315     '1',
1316     no_bom_variant =>
1317     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32le',
1318     no_bom_variant32endian1234 =>
1319     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32be',
1320     no_bom_variant32endian4321 =>
1321     'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32le',
1322     ietf_name =>
1323     ['csucs4',
1324     'iso-10646-ucs-4'],
1325     mime_name =>
1326     'iso-10646-ucs-4',
1327     'uri',
1328     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-10646-ucs-4',
1329     '1',
1330     'urn:x-suika-fam-cx:charset:iso-10646-ucs-4',
1331     '1'},
1332 wakaba 1.2 xml_name => 'ISO-10646-UCS-4',
1333     };
1334    
1335 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32be'} = {
1336     ascii32 => 1,
1337     ascii32endian1234 => 1,
1338     is_block_safe =>
1339     '1',
1340     perl_name =>
1341     ['ucs-4be',
1342     'utf-32be'],
1343     'uri',
1344     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32be',
1345     '1'}};
1346     $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32le'} = {
1347     ascii32 => 1,
1348     ascii32endian4321 => 1,
1349     is_block_safe =>
1350     '1',
1351     perl_name =>
1352     ['ucs-4le',
1353     'utf-32le'],
1354     'uri',
1355     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.utf-32le',
1356     '1'}};
1357     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso_8859-1:1987'} = $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-1'} = {ascii8 =>
1358     '1',
1359     is_block_safe =>
1360     '1',
1361     ietf_name =>
1362     ['cp819',
1363     'csisolatin1',
1364     'ibm819',
1365     'iso-8859-1',
1366     'iso-8859-1',
1367     'iso-ir-100',
1368     'iso_8859-1',
1369     'iso_8859-1:1987',
1370     'l1',
1371     'latin1'],
1372     mime_name =>
1373     'iso-8859-1',
1374     perl_name =>
1375     ['iso-8859-1',
1376     'latin1'],
1377     'uri',
1378     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-1',
1379     '1',
1380     'urn:x-suika-fam-cx:charset:iso_8859-1:1987',
1381     '1'},
1382 wakaba 1.2 xml_name => 'ISO-8859-1',
1383     };
1384    
1385 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-2'} = {ascii8 =>
1386     '1',
1387     is_block_safe =>
1388     '1',
1389     'uri',
1390     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-2',
1391     '1'},
1392 wakaba 1.2 xml_name => 'ISO-8859-2',
1393     };
1394    
1395 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-3'} = {ascii8 =>
1396     '1',
1397     is_block_safe =>
1398     '1',
1399     'uri',
1400     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-3',
1401     '1'},
1402 wakaba 1.2 xml_name => 'ISO-8859-3',
1403     };
1404    
1405 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-4'} = {ascii8 =>
1406     '1',
1407     is_block_safe =>
1408     '1',
1409     'uri',
1410     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-4',
1411     '1'},
1412 wakaba 1.2 xml_name => 'ISO-8859-4',
1413     };
1414    
1415 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-5'} = {ascii8 =>
1416     '1',
1417     is_block_safe =>
1418     '1',
1419     'uri',
1420     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-5',
1421     '1'},
1422 wakaba 1.2 xml_name => 'ISO-8859-5',
1423     };
1424    
1425 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-6'} = {ascii8 =>
1426     '1',
1427     is_block_safe =>
1428     '1',
1429     'uri',
1430     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-6',
1431     '1'},
1432 wakaba 1.2 xml_name => 'ISO-8859-6',
1433     };
1434    
1435 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-7'} = {ascii8 =>
1436     '1',
1437     is_block_safe =>
1438     '1',
1439     'uri',
1440     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-7',
1441     '1'},
1442 wakaba 1.2 xml_name => 'ISO-8859-7',
1443     };
1444    
1445 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-8'} = {ascii8 =>
1446     '1',
1447     is_block_safe =>
1448     '1',
1449     'uri',
1450     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-8',
1451     '1'},
1452 wakaba 1.2 xml_name => 'ISO-8859-8',
1453     };
1454    
1455 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-9'} = {ascii8 =>
1456     '1',
1457     is_block_safe =>
1458     '1',
1459     'uri',
1460     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-9',
1461     '1'},
1462 wakaba 1.2 xml_name => 'ISO-8859-9',
1463     };
1464    
1465 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-10'} = {ascii8 =>
1466     '1',
1467     is_block_safe =>
1468     '1',
1469     'uri',
1470     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-10',
1471     '1'},
1472 wakaba 1.2 xml_name => 'ISO-8859-10',
1473     };
1474    
1475 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-11'} = {ascii8 =>
1476     '1',
1477     is_block_safe =>
1478     '1',
1479     'uri',
1480     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-11',
1481     '1'},
1482 wakaba 1.2 xml_name => 'ISO-8859-11',
1483     };
1484    
1485 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-13'} = {ascii8 =>
1486     '1',
1487     is_block_safe =>
1488     '1',
1489     'uri',
1490     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-13',
1491     '1'},
1492 wakaba 1.2 xml_name => 'ISO-8859-13',
1493     };
1494    
1495 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-14'} = {ascii8 =>
1496     '1',
1497     is_block_safe =>
1498     '1',
1499     'uri',
1500     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-14',
1501     '1'},
1502 wakaba 1.2 xml_name => 'ISO-8859-14',
1503     };
1504    
1505 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-15'} = {ascii8 =>
1506     '1',
1507     is_block_safe =>
1508     '1',
1509     'uri',
1510     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-15',
1511     '1'},
1512 wakaba 1.2 xml_name => 'ISO-8859-15',
1513     };
1514    
1515 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-16'} = {ascii8 =>
1516     '1',
1517     is_block_safe =>
1518     '1',
1519     'uri',
1520     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-8859-16',
1521     '1'},
1522 wakaba 1.2 xml_name => 'ISO-8859-16',
1523     };
1524    
1525 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-2022-jp'} = {ascii8 =>
1526     '1',
1527     'uri',
1528     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.iso-2022-jp',
1529     '1'},
1530 wakaba 1.2 xml_name => 'ISO-2022-JP',
1531     };
1532    
1533 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:iso-2022-jp'} = {ascii8 =>
1534     '1',
1535     ietf_name =>
1536     ['csiso2022jp',
1537     'iso-2022-jp',
1538     'iso-2022-jp'],
1539     mime_name =>
1540     'iso-2022-jp',
1541     'uri',
1542     {'urn:x-suika-fam-cx:charset:iso-2022-jp',
1543     '1'},
1544 wakaba 1.2 };
1545    
1546 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.iso-2022-jp'} = {ascii8 =>
1547     '1',
1548     perl_name =>
1549     ['iso-2022-jp'],
1550     'uri',
1551     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.iso-2022-jp',
1552     '1'}};
1553     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:shift_jis'} = $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.shift_jis'} = {ascii8 =>
1554     '1',
1555     is_block_safe =>
1556     '1',
1557     ietf_name =>
1558     ['csshiftjis',
1559     'ms_kanji',
1560     'shift_jis',
1561     'shift_jis'],
1562     mime_name =>
1563     'shift_jis',
1564     perl_name =>
1565     ['shift-jis-1997'],
1566     'uri',
1567     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.shift_jis',
1568     '1',
1569     'urn:x-suika-fam-cx:charset:shift_jis',
1570     '1'},
1571 wakaba 1.2 xml_name => 'Shift_JIS',
1572     };
1573    
1574 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.shiftjis'} = {ascii8 =>
1575     '1',
1576     is_block_safe =>
1577     '1',
1578     perl_name =>
1579     ['shiftjis',
1580     'sjis'],
1581     'uri',
1582     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.shiftjis',
1583     '1'}};
1584     $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:euc-jp'} = $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.euc-jp'} = $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:extended_unix_code_packed_format_for_japanese'} = {ascii8 =>
1585     '1',
1586     is_block_safe =>
1587     '1',
1588     ietf_name =>
1589     ['cseucpkdfmtjapanese',
1590     'euc-jp',
1591     'euc-jp',
1592     'extended_unix_code_packed_format_for_japanese'],
1593     mime_name =>
1594     'euc-jp',
1595     perl_name =>
1596     ['euc-jp-1997'],
1597     'uri',
1598     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/XML.euc-jp',
1599     '1',
1600     'urn:x-suika-fam-cx:charset:euc-jp',
1601     '1',
1602     'urn:x-suika-fam-cx:charset:extended_unix_code_packed_format_for_japanese',
1603     '1'},
1604 wakaba 1.2 xml_name => 'EUC-JP',
1605     };
1606    
1607 wakaba 1.1 $Whatpm::Charset::CharsetDef->{'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.euc-jp'} = {ascii8 =>
1608     '1',
1609     is_block_safe =>
1610     '1',
1611     perl_name =>
1612     ['euc-jp',
1613     'ujis'],
1614     'uri',
1615     {'http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.euc-jp',
1616     '1'}};
1617    
1618     1;
1619 wakaba 1.17 ## $Date: 2008/09/14 07:19:47 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24