Parent Directory
| 
Revision Log
*** empty log message ***
| 1 | wakaba | 1.1 | |
| 2 | =head1 NAME | ||
| 3 | |||
| 4 | Encode::SJIS --- Shift JIS coding systems encoder and decoder | ||
| 5 | |||
| 6 | =head1 ENCODINGS | ||
| 7 | |||
| 8 | wakaba | 1.5 | This module defines encoding engine for Shift JIS coding systems. |
| 9 | This module only provides general en/decoding parts. Actual profiles | ||
| 10 | for Shift JISes are included in Encode::SJIS::*. | ||
| 11 | wakaba | 1.1 | |
| 12 | =over 4 | ||
| 13 | |||
| 14 | =cut | ||
| 15 | |||
| 16 | package Encode::SJIS; | ||
| 17 | use 5.7.3; | ||
| 18 | use strict; | ||
| 19 | wakaba | 1.6 | our $VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
| 20 | wakaba | 1.1 | require Encode::Charset; |
| 21 | wakaba | 1.2 | use base qw(Encode::Encoding); |
| 22 | wakaba | 1.1 | |
| 23 | wakaba | 1.5 | *new_object = \&Encode::Charset::new_object_sjis; |
| 24 | wakaba | 1.1 | |
| 25 | wakaba | 1.5 | ## Code extention escape sequence defined by ISO/IEC 2022 is |
| 26 | ## not supported in this version of this module. | ||
| 27 | wakaba | 1.1 | |
| 28 | sub sjis_to_internal ($$) { | ||
| 29 | my ($s, $C) = @_; | ||
| 30 | $C ||= &new_object; | ||
| 31 | $s =~ s{ | ||
| 32 | ([\x00-\x7F\xA1-\xDF]) | ||
| 33 | # ([\xA1-\xDF]) | ||
| 34 | |([\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]) | ||
| 35 | |\x1B([\x40-\x5F]) | ||
| 36 | |([\x80-\xFF]) ## Broken or supplemental 1-byte character | ||
| 37 | }{ | ||
| 38 | my ($c7, $c2, $c1, $c8) = ($1, $2, $3, $4); | ||
| 39 | if (defined $c7) { | ||
| 40 | if ($c7 =~ /([\x21-\x7E])/) { | ||
| 41 | chr ($C->{ $C->{GL} }->{ucs} + ord ($1) - 0x21); | ||
| 42 | } elsif ($c7 =~ /([\x00-\x1F])/) { | ||
| 43 | chr ($C->{ $C->{CL} }->{ucs} + ord ($1)); | ||
| 44 | } elsif ($C->{GR} && $c7 =~ /([\xA1-\xDF])/) { | ||
| 45 | chr ($C->{ $C->{GR} }->{ucs} + ord ($1) - 0xA1); | ||
| 46 | } else { ## 0x20, 0x7F | ||
| 47 | $C->{Gsmap}->{ $c7 } || $c7; | ||
| 48 | } | ||
| 49 | } elsif ($c2) { | ||
| 50 | if ($c2 =~ /([\x81-\xEF])(.)/) { | ||
| 51 | my ($f, $s) = (ord $1, ord $2); | ||
| 52 | $f -= $f < 0xA0 ? 0x81 : 0xC1; $s -= 0x40 + ($s > 0x7F); | ||
| 53 | chr ($C->{G1}->{ucs} + $f * 188 + $s); | ||
| 54 | } else { ## [\xF0-\xFC]. | ||
| 55 | wakaba |