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	wakaba	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	wakaba	1.3	$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
16	wakaba	1.1
17			%ENCODER = (
18			'*DEFAULT' => sub {$_[1]},
19			'us-ascii' => sub {$_[1]},
20	wakaba	1.3	'unknown-8bit' => sub {$_[1]},
21	wakaba	1.1	);
22
23			%DECODER = (
24			'*DEFAULT' => sub {$_[1]},
25			'us-ascii' => sub {$_[1]},
26	wakaba	1.3	'unknown-8bit' => sub {$_[1]},
27	wakaba	1.1	);
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	wakaba	1.2	($s, 0);
51	wakaba	1.1	}
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	wakaba	1.2	($s, 0);
59	wakaba	1.1	}
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	wakaba	1.3	$Date: 2002/04/19 12:00:36 $
89	wakaba	1.1
90			=cut
91
92			1;