/[suikacvs]/messaging/manakai/lib/Message/MIME/Charset/Jcode.pm
Suika

Contents of /messaging/manakai/lib/Message/MIME/Charset/Jcode.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations) (download)
Sun Jun 23 12:12:17 2002 UTC (24 years, 1 month ago) by wakaba
Branch: MAIN
Changes since 1.6: +19 -113 lines
2002-06-23  Wakaba <w@suika.fam.cx>

	* Jcode.pm: Remove name_minimumizers.  (Moved to
	Message::MIME::Charset.)
	* Jcode.pm: Give 'cte_7bit_preferred' property
	when make_charset of some charset.

1 wakaba 1.1
2     =head1 NAME
3    
4     Message::MIME::Charset::Jcode --- Japanese Coding Systems Support
5     with jcode.pl and/or Jcode.pm for Message::* Perl Modules
6    
7     =head1 DESCRIPTION
8    
9     Message::* therselves don't convert coding systems of parts of
10     messages, but have mechanism to define to call external functions.
11     This module provides such macros for Japanese coding systems,
12 wakaba 1.3 supported by jcode.pl, Jcode.pm and/or other modules.
13    
14     =head1 USAGE
15    
16     use Message::MIME::Charset::Jcode $module_name;
17    
18     where $module_name is name of module. List of it is shown below:
19    
20     =over 4
21    
22     =item 'jcode.pl'
23    
24     jcode.pl L<lt>http://srekcah.org/jcode/>
25    
26     =item 'Jcode' or 'Jcode.pm'
27    
28     Jcode.pm L<lt>http://openlab.ring.gr.jp/Jcode/index-j.html>
29    
30 wakaba 1.6 =item 'Kconv' or 'Kconv.pm'
31    
32     Kconv.pm L<lt>ftp://ftp.intec.co.jp/pub/utils/>
33    
34 wakaba 1.3 =item 'NKF' or 'NKF.pm'
35    
36     Network Kanji Filter (Perl module version)
37     L<lt>http://bw-www.ie.u-ryukyu.ac.jp/~kono/software.html>
38    
39     =item 'Unicode::Japanese' or 'Unicode::Japanese.pm'
40    
41     Unicode::Japanese L<lt>http://tech.ymirlink.co.jp/>
42    
43     =back
44    
45     When this module is C<use>d multiple times with different
46     conversion module name, latest one is used. For example,
47    
48     use Message::MIME::Charset::Jcode 'jcode.pl';
49     use Message::MIME::Charset::Jcode 'Jcode';
50    
51     results to instruct to use Jcode.pm.
52    
53     use Message::MIME::Charset::Jcode 'Jcode';
54     use Message::MIME::Charset::Jcode 'jcode.pl';
55    
56     This example code leads a bit different result. Jcode.pm can
57     treat UTF-8, but jcode.pl cann't. So convertion from/to UTF-8
58     is done by Jcode.pm. But between other coding systems such as EUC-JP
59     E<lt>-E<gt> Shift JIS, jcode.pl is used.
60    
61     Note that this module does not support Encode modules available
62     with Perl 5.7 or later. It will be supported by
63     Message::MIME::Charset::Encode.
64 wakaba 1.1
65     =cut
66    
67     package Message::MIME::Charset::Jcode;
68     use strict;
69     use vars qw(%CODE $VERSION);
70 wakaba 1.7 $VERSION=do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
71 wakaba 1.1
72     require Message::MIME::Charset;
73    
74 wakaba 1.3 =head1 CODING SYSTEMS NAMES
75    
76     These names can be used as the value of L</VARIABLES>.
77     (These name are NOT same as MIME charset name, which is acutually
78     written down in message header fields.)
79 wakaba 1.1
80     =over 4
81    
82     =item C<euc>
83    
84     Japanese EUC. (MIME: euc-jp)
85    
86     =item C<jis>
87    
88     7bit ISO/IEC 2022, so-called junet code. ASCII, JIS X 0201 Roman,
89     JIS X 0201 Katakana, JIS X 0208, JIS X 0212 are supported by
90     jcode.pl and Jcode.pm. ISO-2022-JP, ISO-2022-JP-1 are subsets of
91     junet code.
92    
93     =item C<sjis>
94    
95     Shift JIS. (MIME: Shift_JIS)
96    
97     =item C<utf8>
98    
99 wakaba 1.3 UTF-8. (MIME: UTF-8) This coding system is not supported by jcode.pl
100     and NKF.pm.
101 wakaba 1.1
102     =item C<ucs2>
103    
104     UCS-2 (or Unicode without surrogate pairs) big endian (network
105 wakaba 1.3 byte order). This coding system is not supported by jcode.pl
106     and NKF.pm.
107 wakaba 1.1
108     =back
109    
110     =head1 VARIABLES
111    
112     =over 4
113    
114     =item $Messag::MIME::Charset::Jcode::CODE{internal}
115    
116     Internal coding system. You can get strings written in this
117     coding system from Message::* Perl modules. (Default: C<euc>)
118    
119     =item $Messag::MIME::Charset::Jcode::CODE{input}
120    
121     Coding system of input string. (Default: auto-detect)
122    
123     =item $Messag::MIME::Charset::Jcode::CODE{output}
124    
125     Coding system of output string. (Default: C<jis>)
126    
127     =back
128    
129     =cut
130    
131 wakaba 1.3 $CODE{internal} = 'euc'; ## default: 'euc' / 'utf8' (Unicode::Japanese)
132     $CODE{input} = ''; ## default: auto-detect
133     $CODE{output} = 'jis'; ## default: 'jis'
134 wakaba 1.1
135     sub import ($;%) {
136     shift;
137     for (@_) {
138     if ($_ eq 'jcode.pl') {
139     require 'jcode.pl';
140     Message::MIME::Charset::make_charset ('*default' =>
141 wakaba 1.6 encoder => sub { jcode::to ($CODE{output}, __jcode_pl_fw_to_hw ($_[1]), $CODE{internal}) },
142 wakaba 1.1 decoder => sub { jcode::to ($CODE{internal}, $_[1], $CODE{input}) },
143     mime_text => 1,
144     );
145     Message::MIME::Charset::make_charset ('iso-2022-jp' =>
146 wakaba 1.2 encoder => sub {
147 wakaba 1.6 my $s = jcode::jis (__jcode_pl_fw_to_hw ($_[1]), $CODE{internal});
148 wakaba 1.7 ($s, Message::MIME::Charset::_name_8bit_iso_2022 ('iso-2022-jp', $s));
149 wakaba 1.2 },
150 wakaba 1.1 decoder => sub { jcode::to ($CODE{internal}, $_[1], 'jis') },
151     mime_text => 1,
152     cte_7bit_preferred => 'base64',
153     );
154     Message::MIME::Charset::make_charset ('euc-jp' =>
155 wakaba 1.2 encoder => sub {
156     my $s = jcode::euc ($_[1], $CODE{internal});
157 wakaba 1.6 (__jcode_pl_fw_to_hw ($s), euc_japan_mime_charset_name ('euc-jp' => $s));
158 wakaba 1.2 },
159 wakaba 1.1 decoder => sub { jcode::to ($CODE{internal}, $_[1], 'euc') },
160     mime_text => 1,
161     );
162     Message::MIME::Charset::make_charset (shift_jis =>
163 wakaba 1.2 encoder => sub {
164 wakaba 1.6 my $s = jcode::sjis (__jcode_pl_fw_to_hw ($_[1]), $CODE{internal});
165 wakaba 1.5 ($s, shift_jis_mime_charset_name (shift_jis => $s));
166 wakaba 1.2 },
167 wakaba 1.1 decoder => sub { jcode::to ($CODE{internal}, $_[1], 'sjis') },
168     mime_text => 1,
169     );
170     } elsif ($_ eq 'Jcode' || $_ eq 'Jcode.pm') {
171     require Jcode;
172     Message::MIME::Charset::make_charset ('*default' =>
173     encoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{output}, $CODE{internal}); $s },
174     decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, $CODE{input}); $s },
175     mime_text => 1,
176     );
177     Message::MIME::Charset::make_charset ('iso-2022-jp' =>
178 wakaba 1.2 encoder => sub {
179 wakaba 1.3 my $s = Jcode->new ($_[1], $CODE{internal})->jis; ## ->iso_2022_jp;
180 wakaba 1.7 ($s, Message::MIME::Charset::_name_8bit_iso_2022 ('iso-2022-jp' => $s));
181 wakaba 1.2 },
182 wakaba 1.1 decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, 'jis'); $s },
183     mime_text => 1,
184     cte_7bit_preferred => 'base64',
185     );
186     Message::MIME::Charset::make_charset ('euc-jp' =>
187 wakaba 1.2 encoder => sub {
188     my $s = Jcode->new ($_[1], $CODE{internal})->euc;
189 wakaba 1.5 ($s, euc_japan_mime_charset_name ('euc-jp' => $s));
190 wakaba 1.2 },
191 wakaba 1.1 decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, 'euc'); $s },
192     mime_text => 1,
193     );
194     Message::MIME::Charset::make_charset (shift_jis =>
195 wakaba 1.2 encoder => sub {
196     my $s = Jcode->new ($_[1], $CODE{internal})->sjis;
197 wakaba 1.5 ($s, shift_jis_mime_charset_name (shift_jis => $s));
198 wakaba 1.2 },
199 wakaba 1.1 decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, 'sjis'); $s },
200     mime_text => 1,
201     );
202     Message::MIME::Charset::make_charset ('utf-8' =>
203     encoder => sub { Jcode->new ($_[1], $CODE{internal})->utf8 },
204     decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, 'utf8'); $s },
205     mime_text => 1,
206     );
207     Message::MIME::Charset::make_charset ('ucs-2be' =>
208     encoder => sub { Jcode->new ($_[1], $CODE{internal})->ucs2 },
209     decoder => sub { my $s = $_[1]; Jcode::convert (\$s, $CODE{internal}, 'ucs2'); $s },
210 wakaba 1.7 cte_7bit_preferred => 'base64',
211 wakaba 1.1 );
212     Message::MIME::Charset::make_charset ('ucs-2' => alias_of => 'ucs-2be');
213     Message::MIME::Charset::make_charset ('utf-16' => alias_of => 'ucs-2');
214     Message::MIME::Charset::make_charset ('utf-16be' => alias_of => 'ucs-2be');
215 wakaba 1.3 } elsif ($_ eq 'NKF' || $_ eq 'NKF.pm') {
216     unless ($NKF::VERSION) {
217     eval { use NKF } or Carp::croak ("Message::MIME::Charset::Jcode: NKF: $@");
218     }
219     Message::MIME::Charset::make_charset ('*default' =>
220     encoder => sub { nkf ( "-". substr ($CODE{output}, 0, 1)
221     . " -".uc (substr ($CODE{internal}, 0, 1)), $_[1] ) },
222     decoder => sub { nkf ( "-". substr ($CODE{internal}, 0, 1)
223     . " -".uc (substr ($CODE{input}, 0, 1)), $_[1] ) },
224     mime_text => 1,
225     );
226     Message::MIME::Charset::make_charset ('iso-2022-jp' =>
227     encoder => sub {
228     my $s = nkf ( "-j -".uc (substr ($CODE{internal}, 0, 1)), $_[1] );
229 wakaba 1.7 ($s, Message::MIME::Charset::_name_8bit_iso_2022 ('iso-2022-jp' => $s));
230 wakaba 1.3 },
231     decoder => sub { nkf ( "-". substr ($CODE{internal}, 0, 1) . " -J", $_[1] ) },
232     mime_text => 1,
233     cte_7bit_preferred => 'base64',
234     );
235     Message::MIME::Charset::make_charset ('euc-jp' =>
236     encoder => sub {
237     my $s = nkf ( "-e -".uc (substr ($CODE{internal}, 0, 1)), $_[1] );
238 wakaba 1.5 ($s, euc_japan_mime_charset_name ('euc-jp' => $s));
239 wakaba 1.3 },
240     decoder => sub { nkf ( "-". substr ($CODE{internal}, 0, 1) . " -E", $_[1] ) },
241     mime_text => 1,
242     );
243     Message::MIME::Charset::make_charset (shift_jis =>
244     encoder => sub {
245     my $s = nkf ( "-s -".uc (substr ($CODE{internal}, 0, 1)), $_[1] );
246 wakaba 1.5 ($s, shift_jis_mime_charset_name (shift_jis => $s));
247 wakaba 1.3 },
248     decoder => sub { nkf ( "-". substr ($CODE{internal}, 0, 1) . " -S", $_[1] ) },
249     mime_text => 1,
250     );
251     } elsif ($_ eq 'Unicode::Japanese' || $_ eq 'Unicode::Japanese.pm') {
252     require Unicode::Japanese;
253     $CODE{internal} = 'utf8';
254     Message::MIME::Charset::make_charset ('*default' =>
255     ## Very tricky:-)
256     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->conv ($CODE{output}) },
257     decoder => sub { Unicode::Japanese->new ($_[1], $CODE{input} || 'auto')->conv ($CODE{internal}) },
258     mime_text => 1,
259     );
260     Message::MIME::Charset::make_charset ('iso-2022-jp' =>
261     encoder => sub {
262     my $s = Unicode::Japanese->new ($_[1], $CODE{internal})->jis;
263 wakaba 1.7 ($s, Message::MIME::Charset::_name_8bit_iso_2022 ('iso-2022-jp' => $s));
264 wakaba 1.3 },
265     decoder => sub { Unicode::Japanese->new ($_[1], 'jis')->conv ($CODE{internal}) },
266     mime_text => 1,
267     cte_7bit_preferred => 'base64',
268     );
269     Message::MIME::Charset::make_charset ('euc-jp' =>
270     encoder => sub {
271     my $s = Unicode::Japanese->new ($_[1], $CODE{internal})->euc;
272 wakaba 1.5 ($s, euc_japan_mime_charset_name ('euc-jp' => $s));
273 wakaba 1.3 },
274     decoder => sub { Unicode::Japanese->new ($_[1], 'euc')->conv ($CODE{internal}) },
275     mime_text => 1,
276     );
277     Message::MIME::Charset::make_charset (shift_jis =>
278     encoder => sub {
279     my $s = Unicode::Japanese->new ($_[1], $CODE{internal})->sjis;
280 wakaba 1.5 ($s, shift_jis_mime_charset_name (shift_jis => $s));
281 wakaba 1.3 },
282     decoder => sub { Unicode::Japanese->new ($_[1], 'sjis')->conv ($CODE{internal}) },
283     mime_text => 1,
284     );
285     Message::MIME::Charset::make_charset ('utf-8' =>
286     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->utf8 },
287     decoder => sub { Unicode::Japanese->new ($_[1], 'utf8')->conv ($CODE{internal}) },
288     mime_text => 1,
289     );
290     Message::MIME::Charset::make_charset ('ucs-2' =>
291     encoder => sub { "\xFF\xFE".Unicode::Japanese->new ($_[1], $CODE{internal})->ucs2 },
292     decoder => sub { Unicode::Japanese->new ($_[1], 'ucs2')->conv ($CODE{internal}) },
293 wakaba 1.7 cte_7bit_preferred => 'base64',
294 wakaba 1.3 );
295     Message::MIME::Charset::make_charset ('ucs-2be' =>
296     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->ucs2 },
297     decoder => sub { Unicode::Japanese->new ($_[1], 'ucs2')->conv ($CODE{internal}) },
298 wakaba 1.7 cte_7bit_preferred => 'base64',
299 wakaba 1.3 );
300     Message::MIME::Charset::make_charset ('utf-16' =>
301     encoder => sub { "\xFF\xFE".Unicode::Japanese->new ($_[1], $CODE{internal})->utf16 },
302     decoder => sub { Unicode::Japanese->new ($_[1], 'utf16')->conv ($CODE{internal}) },
303 wakaba 1.7 cte_7bit_preferred => 'base64',
304 wakaba 1.3 );
305     Message::MIME::Charset::make_charset ('utf-16be' =>
306     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->utf16 },
307     decoder => sub { Unicode::Japanese->new ($_[1], 'utf16-ge')->conv ($CODE{internal}) },
308 wakaba 1.7 cte_7bit_preferred => 'base64',
309 wakaba 1.3 );
310     Message::MIME::Charset::make_charset ('utf-16le' =>
311     #encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->utf16 },
312     decoder => sub { Unicode::Japanese->new ($_[1], 'utf16-le')->conv ($CODE{internal}) },
313 wakaba 1.7 cte_7bit_preferred => 'base64',
314 wakaba 1.3 );
315     Message::MIME::Charset::make_charset ('ucs-2le' => alias_of => 'utf-16le');
316     Message::MIME::Charset::make_charset ('utf-32' =>
317     encoder => sub { "\x00\x00\xFF\xFE".Unicode::Japanese->new ($_[1], $CODE{internal})->ucs4 },
318     decoder => sub { Unicode::Japanese->new ($_[1], 'utf32')->conv ($CODE{internal}) },
319 wakaba 1.7 cte_7bit_preferred => 'base64',
320 wakaba 1.3 );
321     Message::MIME::Charset::make_charset ('ucs-4' =>
322     encoder => sub { "\x00\x00\xFF\xFE".Unicode::Japanese->new ($_[1], $CODE{internal})->ucs4 },
323     decoder => sub { Unicode::Japanese->new ($_[1], 'ucs4')->conv ($CODE{internal}) },
324 wakaba 1.7 cte_7bit_preferred => 'base64',
325 wakaba 1.3 );
326     Message::MIME::Charset::make_charset ('utf-32be' =>
327     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->ucs4 },
328     decoder => sub { Unicode::Japanese->new ($_[1], 'utf32-ge')->conv ($CODE{internal}) },
329 wakaba 1.7 cte_7bit_preferred => 'base64',
330 wakaba 1.3 );
331     Message::MIME::Charset::make_charset ('ucs-4be' =>
332     encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->ucs4 },
333     decoder => sub { Unicode::Japanese->new ($_[1], 'ucs4')->conv ($CODE{internal}) },
334 wakaba 1.7 cte_7bit_preferred => 'base64',
335 wakaba 1.3 );
336     Message::MIME::Charset::make_charset ('utf-32le' =>
337     #encoder => sub { Unicode::Japanese->new ($_[1], $CODE{internal})->utf32 },
338     decoder => sub { Unicode::Japanese->new ($_[1], 'utf32-le')->conv ($CODE{internal}) },
339 wakaba 1.7 cte_7bit_preferred => 'base64',
340 wakaba 1.3 );
341     Message::MIME::Charset::make_charset ('ucs-4le' => alias_of => 'utf-32le');
342 wakaba 1.6 } elsif ($_ eq 'Kconv' || $_ eq 'Kconv.pm') {
343     unless ($Kconv::VERSION) {
344     eval { require Kconv } or Carp::croak ("Message::MIME::Charset::Jcode: Kconv: $@");
345     }
346     Message::MIME::Charset::make_charset ('*default' =>
347     encoder => sub { kconv ($_[1], __kconv_code_name ($CODE{output}),
348     __kconv_code_name ($CODE{internal})) },
349     decoder => sub { kconv ($_[1], __kconv_code_name ($CODE{internal}),
350     __kconv_code_name ($CODE{input})) },
351     mime_text => 1,
352     );
353     Message::MIME::Charset::make_charset ('iso-2022-jp' =>
354     encoder => sub {
355     my $s = kconv ($_[1], &_JIS, __kconv_code_name ($CODE{internal}));
356 wakaba 1.7 ($s, Message::MIME::Charset::_name_8bit_iso_2022 ('iso-2022-jp' => $s));
357 wakaba 1.6 },
358     decoder => sub { kconv ($_[1], __kconv_code_name ($CODE{internal}), &_JIS) },
359     mime_text => 1,
360     cte_7bit_preferred => 'base64',
361     );
362     Message::MIME::Charset::make_charset ('euc-jp' =>
363     encoder => sub {
364     my $s = kconv ($_[1], &_EUC, __kconv_code_name ($CODE{internal}));
365     ($s, euc_japan_mime_charset_name ('euc-jp' => $s));
366     },
367     decoder => sub { kconv ($_[1], __kconv_code_name ($CODE{internal}), &_EUC) },
368     mime_text => 1,
369     );
370     Message::MIME::Charset::make_charset (shift_jis =>
371     encoder => sub {
372     my $s = kconv ($_[1], &_SJIS, __kconv_code_name ($CODE{internal}));
373     ($s, shift_jis_mime_charset_name (shift_jis => $s));
374     },
375     decoder => sub { kconv ($_[1], __kconv_code_name ($CODE{internal}), &_SJIS) },
376     mime_text => 1,
377     );
378 wakaba 1.1 } else {
379     Carp::croak "Jcode: $_: Module not supported";
380     }
381 wakaba 1.3 ## Defines common alias names
382 wakaba 1.1 Message::MIME::Charset::make_charset (jis => alias_of => 'iso-2022-jp');
383 wakaba 1.2 Message::MIME::Charset::make_charset (junet => alias_of => 'iso-2022-jp');
384 wakaba 1.4 Message::MIME::Charset::make_charset ('junet-code' => alias_of => 'iso-2022-jp');
385 wakaba 1.1 Message::MIME::Charset::make_charset ('iso-2022-jp-1' => alias_of => 'iso-2022-jp');
386     Message::MIME::Charset::make_charset ('iso-2022-jp-3' => alias_of => 'iso-2022-jp');
387     Message::MIME::Charset::make_charset ('x-iso-2022-jp-3' => alias_of => 'iso-2022-jp-3');
388     Message::MIME::Charset::make_charset ('iso-2022-jp-3-plane1' => alias_of => 'iso-2022-jp-3');
389     Message::MIME::Charset::make_charset (euc => alias_of => 'euc-jp');
390     Message::MIME::Charset::make_charset (euc_jp => alias_of => 'euc-jp');
391     Message::MIME::Charset::make_charset ('x-euc' => alias_of => 'euc-jp');
392     Message::MIME::Charset::make_charset ('x-euc-jp' => alias_of => 'euc-jp');
393     Message::MIME::Charset::make_charset ('euc-jisx0213' => alias_of => 'euc-jp');
394     Message::MIME::Charset::make_charset ('x-euc-jisx0213' => alias_of => 'euc-jisx0213');
395     Message::MIME::Charset::make_charset ('euc-jisx0213-plane1' => alias_of => 'euc-jisx0213');
396 wakaba 1.4 Message::MIME::Charset::make_charset ('x-euc-jisx0213-packed' => alias_of => 'euc-jisx0213');
397 wakaba 1.1 Message::MIME::Charset::make_charset (sjis => alias_of => 'shift_jis');
398     Message::MIME::Charset::make_charset ('shift-jis' => alias_of => 'shift_jis');
399     Message::MIME::Charset::make_charset ('x-sjis' => alias_of => 'shift_jis');
400     Message::MIME::Charset::make_charset (shift_jisx0213 => alias_of => 'shift_jis');
401     Message::MIME::Charset::make_charset ('shift-jisx0213' => alias_of => 'shift_jisx0213');
402     Message::MIME::Charset::make_charset ('x-shift_jisx0213' => alias_of => 'shift_jisx0213');
403     Message::MIME::Charset::make_charset ('x-shift-jisx0213' => alias_of => 'shift_jisx0213');
404     Message::MIME::Charset::make_charset ('shift_jisx0213-plane1' => alias_of => 'shift_jisx0213');
405 wakaba 1.2 Message::MIME::Charset::make_charset (jis_x0201 => alias_of => 'shift_jis');
406     Message::MIME::Charset::make_charset (x0201 => alias_of => 'jis_x0201');
407 wakaba 1.1 }
408     }
409    
410 wakaba 1.5 sub unimport ($) {
411 wakaba 1.7 for (qw/euc euc-jisx0213 euc-jisx0213-plane1 euc-jp euc_jp iso-2022-jp iso-2022-jp-1 iso-2022-jp-3 iso-2022-jp-3-plane1 jis jis_x0201 junet junet-code shift-jis shift_jis shift-jisx0213 shift_jisx0213 shift_jisx0213-plane1 sjis ucs-2 ucs-2be ucs-2le ucs-4 ucs-4be ucs-4le utf-8 utf-16 utf-16be utf-16le utf-32 utf-32be utf-32le x0201 x-euc x-euc-jisx0213 x-euc-jisx0213-packed x-euc-jisx0213-plane1 x-euc-jp x-iso-2022-jp-3 x-shift-jisx0213 x-shift_jisx0213 x-sjis/) {
412 wakaba 1.5 delete $Message::MIME::Charset::CHARSET{$_};
413     }
414     Message::MIME::Charset::make_charset ('*default' =>
415     encoder => sub { $_[1] },
416     decoder => sub { $_[1] },
417     mime_text => 1,
418     );
419     }
420    
421 wakaba 1.6 sub __jcode_pl_fw_to_hw ($) {
422     my $s = shift;
423     return $s unless $CODE{internal} eq 'euc';
424     jcode::tr(\$s, "\xa3\xb0-\xa3\xb9\xa3\xc1-\xa3\xda\xa3\xe1-\xa3\xfa\xa1\xf5".
425     "\xa1\xa4\xa1\xa5\xa1\xa7\xa1\xa8\xa1\xa9\xa1\xaa\xa1\xae".
426     "\xa1\xb0\xa1\xb2\xa1\xbf\xa1\xc3\xa1\xca\xa1\xcb\xa1\xce".
427     "\xa1\xcf\xa1\xd0\xa1\xd1\xa1\xdc\xa1\xf0\xa1\xf3\xa1\xf4".
428     "\xa1\xf6\xa1\xf7\xa1\xe1\xa2\xaf\xa2\xb0\xa2\xb2\xa2\xb1".
429     "\xa1\xe4\xa1\xe3\xA1\xC0\xA1\xA1" =>
430     '0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=\'"~-><\\ ');
431     $s;
432     }
433    
434     sub __kconv_code_name ($) {
435     my $c = shift;
436     $c eq 'sjis'? &_SJIS:
437     $c eq 'euc' ? &_EUC:
438     $c eq 'jis' ? &_JIS:
439     &_AUTO;
440     }
441    
442 wakaba 1.1 =head1 EXAMPLE
443    
444     ## Uses jcode.pl. Input is euc-japan, output is junet.
445     use Message::MIME::Charset::Jcode 'jcode.pl';
446     ## You don't have to do {require 'jcode.pl'}.
447     $Message::MIME::Charset::Jcode::CODE{input} = 'euc';
448     $Message::MIME::Charset::Jcode::CODE{output} = 'jis';
449     require Message::Entity;
450     #...
451    
452     ## Uses Jcode.pm.
453     use Message::MIME::Charset::Jcode 'Jcode';
454     require Message::Entity;
455     #...
456    
457     ## Uses jcode.pl, but also Jcode.pm for Unicode encodings.
458     ## Internal code is UTF-8.
459     use Message::MIME::Charset::Jcode 'Jcode';
460     use Message::MIME::Charset::Jcode 'jcode.pl';
461     $Message::MIME::Charset::Jcode::CODE{internal} = 'utf-8';
462     require Message::Entity;
463     #...
464    
465     =head1 SEE ALSO
466    
467     Message::MIME::Charset
468    
469     Message::Entity
470    
471     jcode.pl
472    
473     Jcode.pm
474    
475     =head1 LICENSE
476    
477     Copyright 2002 wakaba E<lt>[email protected]<gt>.
478    
479     This program is free software; you can redistribute it and/or modify
480     it under the terms of the GNU General Public License as published by
481     the Free Software Foundation; either version 2 of the License, or
482     (at your option) any later version.
483    
484     This program is distributed in the hope that it will be useful,
485     but WITHOUT ANY WARRANTY; without even the implied warranty of
486     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
487     GNU General Public License for more details.
488    
489     You should have received a copy of the GNU General Public License
490     along with this program; see the file COPYING. If not, write to
491     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
492     Boston, MA 02111-1307, USA.
493    
494     =head1 CHANGE
495    
496     See F<ChangeLog>.
497 wakaba 1.7 $Date: 2002/06/16 10:45:54 $
498 wakaba 1.1
499     =cut
500    
501     1;

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24