[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package Encode::JP::JIS7; 2 use strict; 3 use warnings; 4 our $VERSION = do { my @r = ( q$Revision: 2.3 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; 5 6 use Encode qw(:fallbacks); 7 8 for my $name ( '7bit-jis', 'iso-2022-jp', 'iso-2022-jp-1' ) { 9 my $h2z = ( $name eq '7bit-jis' ) ? 0 : 1; 10 my $jis0212 = ( $name eq 'iso-2022-jp' ) ? 0 : 1; 11 12 $Encode::Encoding{$name} = bless { 13 Name => $name, 14 h2z => $h2z, 15 jis0212 => $jis0212, 16 } => __PACKAGE__; 17 } 18 19 use base qw(Encode::Encoding); 20 21 # we override this to 1 so PerlIO works 22 sub needs_lines { 1 } 23 24 use Encode::CJKConstants qw(:all); 25 26 # 27 # decode is identical for all 2022 variants 28 # 29 30 sub decode($$;$) { 31 my ( $obj, $str, $chk ) = @_; 32 my $residue = ''; 33 if ($chk) { 34 $str =~ s/([^\x00-\x7f].*)$//so and $residue = $1; 35 } 36 $residue .= jis_euc( \$str ); 37 $_[1] = $residue if $chk; 38 return Encode::decode( 'euc-jp', $str, FB_PERLQQ ); 39 } 40 41 # 42 # encode is different 43 # 44 45 sub encode($$;$) { 46 require Encode::JP::H2Z; 47 my ( $obj, $utf8, $chk ) = @_; 48 49 # empty the input string in the stack so perlio is ok 50 $_[1] = '' if $chk; 51 my ( $h2z, $jis0212 ) = @$obj{qw(h2z jis0212)}; 52 my $octet = Encode::encode( 'euc-jp', $utf8, $chk ); 53 $h2z and &Encode::JP::H2Z::h2z( \$octet ); 54 euc_jis( \$octet, $jis0212 ); 55 return $octet; 56 } 57 58 # 59 # cat_decode 60 # 61 my $re_scan_jis_g = qr{ 62 \G ( ($RE{JIS_0212}) | $RE{JIS_0208} | 63 ($RE{ISO_ASC}) | ($RE{JIS_KANA}) | ) 64 ([^\e]*) 65 }x; 66 67 sub cat_decode { # ($obj, $dst, $src, $pos, $trm, $chk) 68 my ( $obj, undef, undef, $pos, $trm ) = @_; # currently ignores $chk 69 my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ]; 70 local ${^ENCODING}; 71 use bytes; 72 my $opos = pos($$rsrc); 73 pos($$rsrc) = $pos; 74 while ( $$rsrc =~ /$re_scan_jis_g/gc ) { 75 my ( $esc, $esc_0212, $esc_asc, $esc_kana, $chunk ) = 76 ( $1, $2, $3, $4, $5 ); 77 78 unless ($chunk) { $esc or last; next; } 79 80 if ( $esc && !$esc_asc ) { 81 $chunk =~ tr/\x21-\x7e/\xa1-\xfe/; 82 if ($esc_kana) { 83 $chunk =~ s/([\xa1-\xdf])/\x8e$1/og; 84 } 85 elsif ($esc_0212) { 86 $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og; 87 } 88 $chunk = Encode::decode( 'euc-jp', $chunk, 0 ); 89 } 90 elsif ( ( my $npos = index( $chunk, $trm ) ) >= 0 ) { 91 $$rdst .= substr( $chunk, 0, $npos + length($trm) ); 92 $$rpos += length($esc) + $npos + length($trm); 93 pos($$rsrc) = $opos; 94 return 1; 95 } 96 $$rdst .= $chunk; 97 $$rpos = pos($$rsrc); 98 } 99 $$rpos = pos($$rsrc); 100 pos($$rsrc) = $opos; 101 return ''; 102 } 103 104 # JIS<->EUC 105 my $re_scan_jis = qr{ 106 (?:($RE{JIS_0212})|$RE{JIS_0208}|($RE{ISO_ASC})|($RE{JIS_KANA}))([^\e]*) 107 }x; 108 109 sub jis_euc { 110 local ${^ENCODING}; 111 my $r_str = shift; 112 $$r_str =~ s($re_scan_jis) 113 { 114 my ($esc_0212, $esc_asc, $esc_kana, $chunk) = 115 ($1, $2, $3, $4); 116 if (!$esc_asc) { 117 $chunk =~ tr/\x21-\x7e/\xa1-\xfe/; 118 if ($esc_kana) { 119 $chunk =~ s/([\xa1-\xdf])/\x8e$1/og; 120 } 121 elsif ($esc_0212) { 122 $chunk =~ s/([\xa1-\xfe][\xa1-\xfe])/\x8f$1/og; 123 } 124 } 125 $chunk; 126 }geox; 127 my ($residue) = ( $$r_str =~ s/(\e.*)$//so ); 128 return $residue; 129 } 130 131 sub euc_jis { 132 no warnings qw(uninitialized); 133 my $r_str = shift; 134 my $jis0212 = shift; 135 $$r_str =~ s{ 136 ((?:$RE{EUC_C})+|(?:$RE{EUC_KANA})+|(?:$RE{EUC_0212})+) 137 }{ 138 my $chunk = $1; 139 my $esc = 140 ( $chunk =~ tr/\x8E//d ) ? $ESC{KANA} : 141 ( $chunk =~ tr/\x8F//d ) ? $ESC{JIS_0212} : 142 $ESC{JIS_0208}; 143 if ($esc eq $ESC{JIS_0212} && !$jis0212){ 144 # fallback to '?' 145 $chunk =~ tr/\xA1-\xFE/\x3F/; 146 }else{ 147 $chunk =~ tr/\xA1-\xFE/\x21-\x7E/; 148 } 149 $esc . $chunk . $ESC{ASC}; 150 }geox; 151 $$r_str =~ s/\Q$ESC{ASC}\E 152 (\Q$ESC{KANA}\E|\Q$ESC{JIS_0212}\E|\Q$ESC{JIS_0208}\E)/$1/gox; 153 $$r_str; 154 } 155 156 1; 157 __END__ 158 159 160 =head1 NAME 161 162 Encode::JP::JIS7 -- internally used by Encode::JP 163 164 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |