Support building nonxs extensions from cpan/ on Unix.
[perl.git] / ext / Encode / lib / Encode / GSM0338.pm
1 #
2 # $Id: GSM0338.pm,v 2.1 2008/05/07 20:56:05 dankogai Exp $
3 #
4 package Encode::GSM0338;
5
6 use strict;
7 use warnings;
8 use Carp;
9
10 use vars qw($VERSION);
11 $VERSION = do { my @r = ( q$Revision: 2.1 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
12
13 use Encode qw(:fallbacks);
14
15 use base qw(Encode::Encoding);
16 __PACKAGE__->Define('gsm0338');
17
18 sub needs_lines { 1 }
19 sub perlio_ok   { 0 }
20
21 use utf8;
22 our %UNI2GSM = (
23     "\x{0040}" => "\x00",        # COMMERCIAL AT
24     "\x{000A}" => "\x0A",        # LINE FEED
25     "\x{000C}" => "\x1B\x0A",    # FORM FEED
26     "\x{000D}" => "\x0D",        # CARRIAGE RETURN
27     "\x{0020}" => "\x20",        # SPACE
28     "\x{0021}" => "\x21",        # EXCLAMATION MARK
29     "\x{0022}" => "\x22",        # QUOTATION MARK
30     "\x{0023}" => "\x23",        # NUMBER SIGN
31     "\x{0024}" => "\x02",        # DOLLAR SIGN
32     "\x{0025}" => "\x25",        # PERCENT SIGN
33     "\x{0026}" => "\x26",        # AMPERSAND
34     "\x{0027}" => "\x27",        # APOSTROPHE
35     "\x{0028}" => "\x28",        # LEFT PARENTHESIS
36     "\x{0029}" => "\x29",        # RIGHT PARENTHESIS
37     "\x{002A}" => "\x2A",        # ASTERISK
38     "\x{002B}" => "\x2B",        # PLUS SIGN
39     "\x{002C}" => "\x2C",        # COMMA
40     "\x{002D}" => "\x2D",        # HYPHEN-MINUS
41     "\x{002E}" => "\x2E",        # FULL STOP
42     "\x{002F}" => "\x2F",        # SOLIDUS
43     "\x{0030}" => "\x30",        # DIGIT ZERO
44     "\x{0031}" => "\x31",        # DIGIT ONE
45     "\x{0032}" => "\x32",        # DIGIT TWO
46     "\x{0033}" => "\x33",        # DIGIT THREE
47     "\x{0034}" => "\x34",        # DIGIT FOUR
48     "\x{0035}" => "\x35",        # DIGIT FIVE
49     "\x{0036}" => "\x36",        # DIGIT SIX
50     "\x{0037}" => "\x37",        # DIGIT SEVEN
51     "\x{0038}" => "\x38",        # DIGIT EIGHT
52     "\x{0039}" => "\x39",        # DIGIT NINE
53     "\x{003A}" => "\x3A",        # COLON
54     "\x{003B}" => "\x3B",        # SEMICOLON
55     "\x{003C}" => "\x3C",        # LESS-THAN SIGN
56     "\x{003D}" => "\x3D",        # EQUALS SIGN
57     "\x{003E}" => "\x3E",        # GREATER-THAN SIGN
58     "\x{003F}" => "\x3F",        # QUESTION MARK
59     "\x{0041}" => "\x41",        # LATIN CAPITAL LETTER A
60     "\x{0042}" => "\x42",        # LATIN CAPITAL LETTER B
61     "\x{0043}" => "\x43",        # LATIN CAPITAL LETTER C
62     "\x{0044}" => "\x44",        # LATIN CAPITAL LETTER D
63     "\x{0045}" => "\x45",        # LATIN CAPITAL LETTER E
64     "\x{0046}" => "\x46",        # LATIN CAPITAL LETTER F
65     "\x{0047}" => "\x47",        # LATIN CAPITAL LETTER G
66     "\x{0048}" => "\x48",        # LATIN CAPITAL LETTER H
67     "\x{0049}" => "\x49",        # LATIN CAPITAL LETTER I
68     "\x{004A}" => "\x4A",        # LATIN CAPITAL LETTER J
69     "\x{004B}" => "\x4B",        # LATIN CAPITAL LETTER K
70     "\x{004C}" => "\x4C",        # LATIN CAPITAL LETTER L
71     "\x{004D}" => "\x4D",        # LATIN CAPITAL LETTER M
72     "\x{004E}" => "\x4E",        # LATIN CAPITAL LETTER N
73     "\x{004F}" => "\x4F",        # LATIN CAPITAL LETTER O
74     "\x{0050}" => "\x50",        # LATIN CAPITAL LETTER P
75     "\x{0051}" => "\x51",        # LATIN CAPITAL LETTER Q
76     "\x{0052}" => "\x52",        # LATIN CAPITAL LETTER R
77     "\x{0053}" => "\x53",        # LATIN CAPITAL LETTER S
78     "\x{0054}" => "\x54",        # LATIN CAPITAL LETTER T
79     "\x{0055}" => "\x55",        # LATIN CAPITAL LETTER U
80     "\x{0056}" => "\x56",        # LATIN CAPITAL LETTER V
81     "\x{0057}" => "\x57",        # LATIN CAPITAL LETTER W
82     "\x{0058}" => "\x58",        # LATIN CAPITAL LETTER X
83     "\x{0059}" => "\x59",        # LATIN CAPITAL LETTER Y
84     "\x{005A}" => "\x5A",        # LATIN CAPITAL LETTER Z
85     "\x{005F}" => "\x11",        # LOW LINE
86     "\x{0061}" => "\x61",        # LATIN SMALL LETTER A
87     "\x{0062}" => "\x62",        # LATIN SMALL LETTER B
88     "\x{0063}" => "\x63",        # LATIN SMALL LETTER C
89     "\x{0064}" => "\x64",        # LATIN SMALL LETTER D
90     "\x{0065}" => "\x65",        # LATIN SMALL LETTER E
91     "\x{0066}" => "\x66",        # LATIN SMALL LETTER F
92     "\x{0067}" => "\x67",        # LATIN SMALL LETTER G
93     "\x{0068}" => "\x68",        # LATIN SMALL LETTER H
94     "\x{0069}" => "\x69",        # LATIN SMALL LETTER I
95     "\x{006A}" => "\x6A",        # LATIN SMALL LETTER J
96     "\x{006B}" => "\x6B",        # LATIN SMALL LETTER K
97     "\x{006C}" => "\x6C",        # LATIN SMALL LETTER L
98     "\x{006D}" => "\x6D",        # LATIN SMALL LETTER M
99     "\x{006E}" => "\x6E",        # LATIN SMALL LETTER N
100     "\x{006F}" => "\x6F",        # LATIN SMALL LETTER O
101     "\x{0070}" => "\x70",        # LATIN SMALL LETTER P
102     "\x{0071}" => "\x71",        # LATIN SMALL LETTER Q
103     "\x{0072}" => "\x72",        # LATIN SMALL LETTER R
104     "\x{0073}" => "\x73",        # LATIN SMALL LETTER S
105     "\x{0074}" => "\x74",        # LATIN SMALL LETTER T
106     "\x{0075}" => "\x75",        # LATIN SMALL LETTER U
107     "\x{0076}" => "\x76",        # LATIN SMALL LETTER V
108     "\x{0077}" => "\x77",        # LATIN SMALL LETTER W
109     "\x{0078}" => "\x78",        # LATIN SMALL LETTER X
110     "\x{0079}" => "\x79",        # LATIN SMALL LETTER Y
111     "\x{007A}" => "\x7A",        # LATIN SMALL LETTER Z
112     "\x{000C}" => "\x1B\x0A",    # FORM FEED
113     "\x{005B}" => "\x1B\x3C",    # LEFT SQUARE BRACKET
114     "\x{005C}" => "\x1B\x2F",    # REVERSE SOLIDUS
115     "\x{005D}" => "\x1B\x3E",    # RIGHT SQUARE BRACKET
116     "\x{005E}" => "\x1B\x14",    # CIRCUMFLEX ACCENT
117     "\x{007B}" => "\x1B\x28",    # LEFT CURLY BRACKET
118     "\x{007C}" => "\x1B\x40",    # VERTICAL LINE
119     "\x{007D}" => "\x1B\x29",    # RIGHT CURLY BRACKET
120     "\x{007E}" => "\x1B\x3D",    # TILDE
121     "\x{00A0}" => "\x1B",        # NO-BREAK SPACE
122     "\x{00A1}" => "\x40",        # INVERTED EXCLAMATION MARK
123     "\x{00A3}" => "\x01",        # POUND SIGN
124     "\x{00A4}" => "\x24",        # CURRENCY SIGN
125     "\x{00A5}" => "\x03",        # YEN SIGN
126     "\x{00A7}" => "\x5F",        # SECTION SIGN
127     "\x{00BF}" => "\x60",        # INVERTED QUESTION MARK
128     "\x{00C4}" => "\x5B",        # LATIN CAPITAL LETTER A WITH DIAERESIS
129     "\x{00C5}" => "\x0E",        # LATIN CAPITAL LETTER A WITH RING ABOVE
130     "\x{00C6}" => "\x1C",        # LATIN CAPITAL LETTER AE
131     "\x{00C9}" => "\x1F",        # LATIN CAPITAL LETTER E WITH ACUTE
132     "\x{00D1}" => "\x5D",        # LATIN CAPITAL LETTER N WITH TILDE
133     "\x{00D6}" => "\x5C",        # LATIN CAPITAL LETTER O WITH DIAERESIS
134     "\x{00D8}" => "\x0B",        # LATIN CAPITAL LETTER O WITH STROKE
135     "\x{00DC}" => "\x5E",        # LATIN CAPITAL LETTER U WITH DIAERESIS
136     "\x{00DF}" => "\x1E",        # LATIN SMALL LETTER SHARP S
137     "\x{00E0}" => "\x7F",        # LATIN SMALL LETTER A WITH GRAVE
138     "\x{00E4}" => "\x7B",        # LATIN SMALL LETTER A WITH DIAERESIS
139     "\x{00E5}" => "\x0F",        # LATIN SMALL LETTER A WITH RING ABOVE
140     "\x{00E6}" => "\x1D",        # LATIN SMALL LETTER AE
141     "\x{00E7}" => "\x09",        # LATIN SMALL LETTER C WITH CEDILLA
142     "\x{00E8}" => "\x04",        # LATIN SMALL LETTER E WITH GRAVE
143     "\x{00E9}" => "\x05",        # LATIN SMALL LETTER E WITH ACUTE
144     "\x{00EC}" => "\x07",        # LATIN SMALL LETTER I WITH GRAVE
145     "\x{00F1}" => "\x7D",        # LATIN SMALL LETTER N WITH TILDE
146     "\x{00F2}" => "\x08",        # LATIN SMALL LETTER O WITH GRAVE
147     "\x{00F6}" => "\x7C",        # LATIN SMALL LETTER O WITH DIAERESIS
148     "\x{00F8}" => "\x0C",        # LATIN SMALL LETTER O WITH STROKE
149     "\x{00F9}" => "\x06",        # LATIN SMALL LETTER U WITH GRAVE
150     "\x{00FC}" => "\x7E",        # LATIN SMALL LETTER U WITH DIAERESIS
151     "\x{0393}" => "\x13",        # GREEK CAPITAL LETTER GAMMA
152     "\x{0394}" => "\x10",        # GREEK CAPITAL LETTER DELTA
153     "\x{0398}" => "\x19",        # GREEK CAPITAL LETTER THETA
154     "\x{039B}" => "\x14",        # GREEK CAPITAL LETTER LAMDA
155     "\x{039E}" => "\x1A",        # GREEK CAPITAL LETTER XI
156     "\x{03A0}" => "\x16",        # GREEK CAPITAL LETTER PI
157     "\x{03A3}" => "\x18",        # GREEK CAPITAL LETTER SIGMA
158     "\x{03A6}" => "\x12",        # GREEK CAPITAL LETTER PHI
159     "\x{03A8}" => "\x17",        # GREEK CAPITAL LETTER PSI
160     "\x{03A9}" => "\x15",        # GREEK CAPITAL LETTER OMEGA
161     "\x{20AC}" => "\x1B\x65",    # EURO SIGN
162 );
163 our %GSM2UNI = reverse %UNI2GSM;
164 our $ESC    = "\x1b";
165 our $ATMARK = "\x40";
166 our $FBCHAR = "\x3F";
167 our $NBSP   = "\x{00A0}";
168
169 #define ERR_DECODE_NOMAP "%s \"\\x%02" UVXf "\" does not map to Unicode"
170
171 sub decode ($$;$) {
172     my ( $obj, $bytes, $chk ) = @_;
173     my $str;
174     while ( length $bytes ) {
175         my $c = substr( $bytes, 0, 1, '' );
176         my $u;
177         if ( $c eq "\x00" ) {
178             my $c2 = substr( $bytes, 0, 1, '' );
179             $u =
180                 !length $c2 ? $ATMARK
181               : $c2 eq "\x00" ? "\x{0000}"
182               : exists $GSM2UNI{$c2} ? $ATMARK . $GSM2UNI{$c2}
183               : $chk
184               ? croak sprintf( "\\x%02X\\x%02X does not map to Unicode",
185                                ord($c), ord($c2) )
186               : $ATMARK . $FBCHAR;
187
188         }
189         elsif ( $c eq $ESC ) {
190             my $c2 = substr( $bytes, 0, 1, '' );
191             $u =
192                 exists $GSM2UNI{ $c . $c2 } ? $GSM2UNI{ $c . $c2 }
193               : exists $GSM2UNI{$c2}        ? $NBSP . $GSM2UNI{$c2}
194               : $chk
195               ? croak sprintf( "\\x%02X\\x%02X does not map to Unicode",
196                                ord($c), ord($c2) )
197               : $NBSP . $FBCHAR;
198         }
199         else {
200             $u =
201               exists $GSM2UNI{$c}
202               ? $GSM2UNI{$c}
203               : $chk ? ref $chk eq 'CODE'
204                   ? $chk->( ord $c )
205                   : croak sprintf( "\\x%02X does not map to Unicode", ord($c) )
206               : $FBCHAR;
207         }
208         $str .= $u;
209     }
210     $_[1] = $bytes if $chk;
211     return $str;
212 }
213
214 #define ERR_ENCODE_NOMAP "\"\\x{%04" UVxf "}\" does not map to %s"
215
216 sub encode($$;$) {
217     my ( $obj, $str, $chk ) = @_;
218     my $bytes;
219     while ( length $str ) {
220         my $u = substr( $str, 0, 1, '' );
221         my $c;
222         $bytes .=
223           exists $UNI2GSM{$u}
224           ? $UNI2GSM{$u}
225           : $chk ? ref $chk eq 'CODE'
226               ? $chk->( ord($u) )
227               : croak sprintf( "\\x{%04x} does not map to %s", 
228                                ord($u), $obj->name )
229           : $FBCHAR;
230     }
231     $_[1] = $str if $chk;
232     return $bytes;
233 }
234
235 1;
236 __END__
237
238 =head1 NAME
239
240 Encode::GSM0338 -- ESTI GSM 03.38 Encoding
241
242 =head1 SYNOPSIS
243
244   use Encode qw/encode decode/; 
245   $gsm0338 = encode("gsm0338", $utf8);    # loads Encode::GSM0338 implicitly
246   $utf8    = decode("gsm0338", $gsm0338); # ditto
247
248 =head1 DESCRIPTION
249
250 GSM0338 is for GSM handsets. Though it shares alphanumerals with ASCII,
251 control character ranges and other parts are mapped very differently,
252 mainly to store Greek characters.  There are also escape sequences
253 (starting with 0x1B) to cover e.g. the Euro sign.
254
255 This was once handled by L<Encode::Bytes> but because of all those
256 unusual specifications, Encode 2.20 has relocated the support to
257 this module.
258
259 =head1 NOTES
260
261 Unlike most other encodings,  the following aways croaks on error
262 for any $chk that evaluates to true.
263
264   $gsm0338 = encode("gsm0338", $utf8      $chk);
265   $utf8    = decode("gsm0338", $gsm0338,  $chk);
266
267 So if you want to check the validity of the encoding, surround the
268 expression with C<eval {}> block as follows;
269
270   eval {
271     $utf8    = decode("gsm0338", $gsm0338,  $chk);
272   };
273   if ($@){
274     # handle exception here
275   }
276
277 =head1 BUGS
278
279 ESTI GSM 03.38 Encoding itself.
280
281 Mapping \x00 to '@' causes too much pain everywhere.
282
283 Its use of \x1b (escape) is also very questionable.  
284
285 Because of those two, the code paging approach used use in ucm-based
286 Encoding SOMETIMES fails so this module was written.
287
288 =head1 SEE ALSO
289
290 L<Encode>
291
292 =cut