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 | 1.6 | my ($f, $s) = (ord substr ($c2, 0, 1), ord substr ($c2, 1, 1)); |
| 56 | if ($C->{G3}->{Csjis_kuE}) { ## 94^2 set with first-byte->ku mapping | ||
| 57 | my $F = $s > 0x9E ? $C->{G3}->{Csjis_kuE}->{ $f }: ## ku of even number | ||
| 58 | $C->{G3}->{Csjis_kuO}->{ $f }; ## ku of odd number | ||
| 59 | if (defined $F) { | ||
| 60 | $s -= ($s > 0x9E ? 0x9F : $s > 0x7F ? 0x41 : 0x40); | ||
| 61 | chr ($C->{G3}->{ucs} + $F * 94 + $s); | ||
| 62 | } else { ## Mapping is not defined | ||
| 63 | $f -= 0xF0; $s -= 0x40 + ($s > 0x7F); | ||
| 64 | chr ($Encode::Charset::CHARSET{G94n}->{"\x20\x40"}->{ucs} + $f * 188 + $s); | ||
| 65 | } | ||
| 66 | } elsif ($C->{G3}->{Csjis_ku}) { ## n^2 set with first-byte->ku mapping | ||
| 67 | if (defined $C->{G3}->{Csjis_ku}->{ $f }) { | ||
| 68 | $f = $C->{G3}->{Csjis_ku}->{ $f }; | ||
| 69 | $s -= ($s > 0x9E ? 0x9F : $s > 0x7F ? 0x41 : 0x40); | ||
| 70 | chr ($C->{G3}->{ucs} + $f * $C->{G3}->{chars} + $s); | ||
| 71 | } else { ## Mapping is not defined | ||
| 72 | $f -= 0xF0; $s -= 0x40 + ($s > 0x7F); | ||
| 73 | chr ($Encode::Charset::CHARSET{G94n}->{"\x20\x40"}->{ucs} + $f * 188 + $s); | ||
| 74 | } | ||
| 75 | } else { ## 94^2 set without special mapping information | ||
| 76 | wakaba | 1.1 | $f -= 0xF0; $s -= 0x40 + ($s > 0x7F); |
| 77 | chr ($C->{G3}->{ucs} + $f * 188 + $s); | ||
| 78 | } | ||
| 79 | } | ||
| 80 | } elsif ($c1) { ## ESC Fe | ||
| 81 | chr ($C->{ $C->{ESC_Fe} }->{ucs} + ord ($c1) - 0x40); | ||
| 82 | } else { # $C8 | ||
| 83 | $C->{Gsmap}->{ $c8 } || $c8; | ||
| 84 | } | ||
| 85 | }gex; | ||
| 86 | </ |