Message/MIME/Charset.pm


=head1 NAME

Message::MIME::Charset Perl module

=head1 DESCRIPTION

Perl module for MIME charset.

=cut

package Message::MIME::Charset;
use strict;
use vars qw(%ENCODER %DECODER %N11NTABLE %REG $VERSION);
$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

%ENCODER = (
  '*DEFAULT'    => sub {$_[1]},
  'us-ascii'    => sub {$_[1]},
  'unknown-8bit'        => sub {$_[1]},
);

%DECODER = (
  '*DEFAULT'    => sub {$_[1]},
  'us-ascii'    => sub {$_[1]},
  'unknown-8bit'        => sub {$_[1]},
);

## Charset name normalization
%N11NTABLE = (
  'euc' => 'euc-jp',    ## ...
  'jis' => 'iso-2022-jp',       ## Really?
  'shift-jis'   => 'shift_jis',
  'shift-jisx0213'      => 'shift_jisx0213',
  'x-big5'      => 'big5',
  'x-x-big5'    => 'big5',
  'x-euc'       => 'euc-jp',    ## ...
  'x-euc-jp'    => 'euc-jp',
  'x-gbk'       => 'gbk',
  'x-gbk2k'     => 'gb18030',
  'x-x-gbk'     => 'gbk',
  'x-sjis'      => 'shift_jis',
);

sub encode ($$) {
  my ($charset, $s) = (lc shift, shift);
  if (ref $ENCODER{$charset}) {
    return (&{$ENCODER{$charset}} ($charset, $s), 1);
  }
  ($s, 0);
}

sub decode ($$) {
  my ($charset, $s) = (lc shift, shift);
  if (ref $DECODER{$charset}) {
    return (&{$DECODER{$charset}} ($charset, $s), 1);
  }
  ($s, 0);
}

sub name_normalize ($) {
  my $name = lc shift;
  $N11NTABLE{$name} || $name;
}

=head1 LICENSE

Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=head1 CHANGE

See F<ChangeLog>.
$Date: 2002/04/19 12:00:36 $

=cut

1;
1
2	=head1 NAME
3
4	Message::MIME::Charset Perl module
5
6	=head1 DESCRIPTION
7
8	Perl module for MIME charset.
9
10	=cut
11
12	package Message::MIME::Charset;
13	use strict;
14	use vars qw(%ENCODER %DECODER %N11NTABLE %REG $VERSION);
15	$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
16
17	%ENCODER = (
18	'*DEFAULT' => sub {$_[1]},
19	'us-ascii' => sub {$_[1]},
20	'unknown-8bit' => sub {$_[1]},
21	);
22
23	%DECODER = (
24	'*DEFAULT' => sub {$_[1]},
25	'us-ascii' => sub {$_[1]},
26	'unknown-8bit' => sub {$_[1]},
27	);
28
29	## Charset name normalization
30	%N11NTABLE = (
31	'euc' => 'euc-jp', ## ...
32	'jis' => 'iso-2022-jp', ## Really?
33	'shift-jis' => 'shift_jis',
34	'shift-jisx0213' => 'shift_jisx0213',
35	'x-big5' => 'big5',
36	'x-x-big5' => 'big5',
37	'x-euc' => 'euc-jp', ## ...
38	'x-euc-jp' => 'euc-jp',
39	'x-gbk' => 'gbk',
40	'x-gbk2k' => 'gb18030',
41	'x-x-gbk' => 'gbk',
42	'x-sjis' => 'shift_jis',
43	);
44
45	sub encode ($$) {
46	my ($charset, $s) = (lc shift, shift);
47	if (ref $ENCODER{$charset}) {
48	return (&{$ENCODER{$charset}} ($charset, $s), 1);
49	}
50	($s, 0);
51	}
52
53	sub decode ($$) {
54	my ($charset, $s) = (lc shift, shift);
55	if (ref $DECODER{$charset}) {
56	return (&{$DECODER{$charset}} ($charset, $s), 1);
57	}
58	($s, 0);
59	}
60
61	sub name_normalize ($) {
62	my $name = lc shift;
63	$N11NTABLE{$name} \|\| $name;
64	}
65
66	=head1 LICENSE
67
68	Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
69
70	This program is free software; you can redistribute it and/or modify
71	it under the terms of the GNU General Public License as published by
72	the Free Software Foundation; either version 2 of the License, or
73	(at your option) any later version.
74
75	This program is distributed in the hope that it will be useful,
76	but WITHOUT ANY WARRANTY; without even the implied warranty of
77	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
78	GNU General Public License for more details.
79
80	You should have received a copy of the GNU General Public License
81	along with this program; see the file COPYING. If not, write to
82	the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83	Boston, MA 02111-1307, USA.
84
85	=head1 CHANGE
86
87	See F<ChangeLog>.
88	$Date: 2002/04/19 12:00:36 $
89
90	=cut
91
92	1;