| 66 |
### --- Encode::ISO2022 unique functions |
### --- Encode::ISO2022 unique functions |
| 67 |
*new_object = \&Encode::Charset::new_object; |
*new_object = \&Encode::Charset::new_object; |
| 68 |
|
|
| 69 |
sub iso2022_to_internal ($;\%) { |
sub iso2022_to_internal ($;%) { |
| 70 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
| 71 |
$C ||= &new_object; |
$C ||= &new_object; |
| 72 |
my $t = ''; |
my $t = ''; |
| 129 |
# when this unexpected behavior is fixed or someone finds |
# when this unexpected behavior is fixed or someone finds |
| 130 |
# better way to avoid it, we will rewrite this code. |
# better way to avoid it, we will rewrite this code. |
| 131 |
&_iso2022_to_internal (undef); |
&_iso2022_to_internal (undef); |
| 132 |
sub _iso2022_to_internal ($;\%) { |
sub _iso2022_to_internal ($;%) { |
| 133 |
eval q{ sub __iso2022_to_internal ($;\%) { 0 } }; |
eval q{ sub __iso2022_to_internal ($;%) { 0 } }; |
| 134 |
eval q{ |
eval q{ |
| 135 |
sub __iso2022_to_internal ($;\%) { |
sub __iso2022_to_internal ($;%) { |
| 136 |
use re 'eval'; |
use re 'eval'; |
| 137 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
| 138 |
my %_GB_to_GN = ( |
my %_GB_to_GN = ( |
| 206 |
$c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m; |
$c = $c * $C->{$C->{GL}}->{chars} + unpack ('C', $_) - $m; |
| 207 |
} |
} |
| 208 |
chr ($C->{$C->{GL}}->{ucs} + $c); |
chr ($C->{$C->{GL}}->{ucs} + $c); |
|
## Control, SP, or broken data |
|
|
## TODO: support control sets other than ISO/IEC 6429's |
|
|
} elsif (defined $misc) { |
|
|
$misc; |
|
| 209 |
## GR graphic character |
## GR graphic character |
| 210 |
} elsif ($gr) { |
} elsif ($gr) { |
| 211 |
my $c = 0; |
my $c = 0; |
| 214 |
$c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m; |
$c = $c * $C->{$C->{GR}}->{chars} + unpack ('C', $_) - $m; |
| 215 |
} |
} |
| 216 |
chr ($C->{$C->{GR}}->{ucs} + $c); |
chr ($C->{$C->{GR}}->{ucs} + $c); |
| 217 |
|
## Control, SP, or broken data |
| 218 |
|
## TODO: support control sets other than ISO/IEC 6429's |
| 219 |
|
} elsif (defined $misc) { |
| 220 |
|
$misc; |
| 221 |
## Graphic character with SS2 |
## Graphic character with SS2 |
| 222 |
} elsif ($ss2) { |
} elsif ($ss2) { |
| 223 |
$ss2 =~ tr/\x80-\xFF/\x00-\x7F/; |
$ss2 =~ tr/\x80-\xFF/\x00-\x7F/; |
| 236 |
chr ($C->{G3}->{ucs} + $c); |
chr ($C->{G3}->{ucs} + $c); |
| 237 |
## Escape sequence |
## Escape sequence |
| 238 |
} elsif ($esc) { |
} elsif ($esc) { |
| 239 |
## IRR (revision number) |
if ($esc =~ /\x1B\x26([\x40-\x7E])/) { ## 6F (IRR) = ESC 02/06 Ft |
|
if ($esc =~ /\x1B\x26([\x40-\x7E])/) { |
|
| 240 |
$C->{_irr} = $1; $esc = ''; |
$C->{_irr} = $1; $esc = ''; |
| 241 |
} else { |
} else { |
| 242 |
$esc =~ s{ |
$esc =~ s{ |
| 260 |
$CZD, $C1D, $Fs, $sI, $sF,$ACS) |
$CZD, $C1D, $Fs, $sI, $sF,$ACS) |
| 261 |
= ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15); |
= ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12,$13,$14,$15); |
| 262 |
my $rev = $C->{_irr} || ''; |
my $rev = $C->{_irr} || ''; |
| 263 |
if ($g94_g) { |
my $f2s = $C->{option}->{final_to_set}; |
| 264 |
$C->{ $_GB_to_GN{ $g94_g } } = $CHARSET{G94}->{ $g94_f.$rev } |
if ($g94_g) { ## ESC 02/08 [I] F |
| 265 |
|| $CHARSET{G94}->{ $g94_f } |
$C->{ $_GB_to_GN{ $g94_g } } |
| 266 |
|| $CHARSET{G94}->{ "\x7E" }; ''; |
= $CHARSET{G94}->{ $f2s->{G94}->{$g94_f.$rev} || $g94_f.$rev } |
| 267 |
} elsif (defined $g94n_f) { |
|| $CHARSET{G94}->{ $f2s->{G94}->{$g94_f} || $g94_f } |
| 268 |
$C->{ $_GB_to_GN{ $g94n_g } || 'G0' } = $CHARSET{G94n}->{ $g94n_f.$rev } |
|| $CHARSET{G94}->{ "\x7E" }; ''; |
| 269 |
|| $CHARSET{G94n}->{ $g94n_f } |
} elsif (defined $g94n_f) { ## ESC 02/04 [02/08..11] [I] F |
| 270 |
|| $CHARSET{G94n}->{ "\x7E" }; ''; |
$C->{ $_GB_to_GN{ $g94n_g } || 'G0' } |
| 271 |
} elsif ($g96_g) { |
= $CHARSET{G94n}->{ $f2s->{G94n}->{$g94n_f.$rev} || $g94n_f.$rev } |
| 272 |
$C->{ $_GB_to_GN{ $g96_g } } = $CHARSET{G96}->{ $g96_f.$rev } |
|| $CHARSET{G94n}->{ $f2s->{G94n}->{$g94n_f} || $g94n_f } |
| 273 |
|| $CHARSET{G96}->{ $g96_f } |
|| $CHARSET{G94n}->{ "\x7E" }; ''; |
| 274 |
|| $CHARSET{G96}->{ "\x7E" }; ''; |
} elsif ($g96_g) { ## ESC 02/12..15 [I] F |
| 275 |
} elsif (defined $g96n_f) { |
$C->{ $_GB_to_GN{ $g96_g } } |
| 276 |
$C->{ $_GB_to_GN{ $g96n_g } } = $CHARSET{G96n}->{ $g96n_f.$rev } |
= $CHARSET{G96}->{ $f2s->{G96}->{$g96_f.$rev} || $g96_f.$rev } |
| 277 |
|| $CHARSET{G96n}->{ $g96n_f } |
|| $CHARSET{G96}->{ $f2s->{G96}->{$g96_f} || $g96_f } |
| 278 |
|| $CHARSET{G96n}->{ "\x7E" }; ''; |
|| $CHARSET{G96}->{ "\x7E" }; ''; |
| 279 |
} elsif ($Fe) { ## ESC Fe => C1 |
} elsif ($g96n_g) { ## ESC 02/04 02/12..15 [I] F |
| 280 |
|
$C->{ $_GB_to_GN{ $g96n_g } } |
| 281 |
|
= $CHARSET{G96n}->{ $f2s->{G96n}->{$g96n_f.$rev} || $g96n_f.$rev } |
| 282 |
|
|| $CHARSET{G96n}->{ $f2s->{G96n}->{$g96n_f} || $g96n_f } |
| 283 |
|
|| $CHARSET{G96n}->{ "\x7E" }; ''; |
| 284 |
|
} elsif ($Fe) { ## ESC Fe = C1 |
| 285 |
chr ($C->{ $C->{ESC_Fe} }->{ucs} + (ord ($Fe) - 0x40)); |
chr ($C->{ $C->{ESC_Fe} }->{ucs} + (ord ($Fe) - 0x40)); |
| 286 |
} elsif ($CZD) { |
} elsif (defined $Fs) { ## ESC Fs |
|
$C->{C0} = $CHARSET{C0}->{ $CZD.$rev } |
|
|
|| $CHARSET{C0}->{ $CZD } || $CHARSET{C0}->{ "\x7E" }; ''; |
|
|
} elsif ($C1D) { |
|
|
$C->{C1} = $CHARSET{C1}->{ $C1D.$rev } |
|
|
|| $CHARSET{C1}->{ $C1D } || $CHARSET{C1}->{ "\x7E" }; ''; |
|
|
} elsif ($Fs) { |
|
| 287 |
if ($Fs eq "\x6E") { ## LS2 |
if ($Fs eq "\x6E") { ## LS2 |
| 288 |
$C->{GL} = 'G2'; ''; |
$C->{GL} = 'G2'; ''; |
| 289 |
} elsif ($Fs eq "\x6F") { ## LS3 |
} elsif ($Fs eq "\x6F") { ## LS3 |
| 297 |
} else { |
} else { |
| 298 |
chr ($CHARSET{single_control}->{Fs}->{ucs} + (ord ($Fs) - 0x60)); |
chr ($CHARSET{single_control}->{Fs}->{ucs} + (ord ($Fs) - 0x60)); |
| 299 |
} |
} |
| 300 |
} elsif ($sI) { |
} elsif (defined $CZD) { ## 1F (CZD) = ESC 02/01 [I] F |
| 301 |
|
$C->{C0} = $CHARSET{C0}->{ $f2s->{C0}->{$CZD.$rev} || $CZD.$rev } |
| 302 |
|
|| $CHARSET{C0}->{ $f2s->{C0}->{$CZD} || $CZD } |
| 303 |
|
|| $CHARSET{C0}->{ "\x7E" }; ''; |
| 304 |
|
} elsif (defined $C1D) { ## 2F (C1D) = ESC 02/02 [I] F |
| 305 |
|
$C->{C1} = $CHARSET{C1}->{ $f2s->{C1}->{$C1D.$rev} || $C1D.$rev } |
| 306 |
|
|| $CHARSET{C1}->{ $f2s->{C1}->{$C1D} || $C1D } |
| 307 |
|
|| $CHARSET{C1}->{ "\x7E" }; ''; |
| 308 |
|
} elsif ($sI) { ## 3F = ESC 02/03 [I] F |
| 309 |
chr ($CHARSET{single_control}->{'3F'.$sI}->{ucs} + (ord ($sF) - 0x30)); |
chr ($CHARSET{single_control}->{'3F'.$sI}->{ucs} + (ord ($sF) - 0x30)); |
| 310 |
} elsif ($ACS) { ## Announcer |
} elsif ($ACS) { ## 0F (Announcer) = ESC 02/00 F |
| 311 |
if ($ACS eq "\x4A") { $C->{bit} = 7 } |
if ($ACS eq "\x4A") { $C->{bit} = 7 } |
| 312 |
elsif ($ACS eq "\x4B") { $C->{bit} = 8 } |
elsif ($ACS eq "\x4B") { $C->{bit} = 8 } |
| 313 |
''; |
''; |
| 316 |
$C->{_irr} = undef; |
$C->{_irr} = undef; |
| 317 |
} |
} |
| 318 |
$esc; |
$esc; |
| 319 |
## Locking shifts |
} elsif ($ls) { ## Locking shifts = LS0 / LS1 |
|
} elsif ($ls) { |
|
| 320 |
if ($ls eq $C->{$C->{CL}}->{LS0}) { |
if ($ls eq $C->{$C->{CL}}->{LS0}) { |
| 321 |
$C->{GL} = 'G0'; ''; |
$C->{GL} = 'G0'; ''; |
| 322 |
} elsif ($ls eq $C->{$C->{CL}}->{LS1}) { |
} elsif ($ls eq $C->{$C->{CL}}->{LS1}) { |
| 323 |
$C->{GL} = 'G1'; ''; |
$C->{GL} = 'G1'; ''; |
| 324 |
} |
} |
| 325 |
## Control sequence |
} elsif ($csi) { ## Control sequence = CSI [P..] [I] F |
|
} elsif ($csi) { |
|
| 326 |
$csi =~ tr/\xA0-\xFF/\x20-\x7F/d; |
$csi =~ tr/\xA0-\xFF/\x20-\x7F/d; |
| 327 |
$csi =~ s/$C->{$C->{CL}}->{LS0}//g if $C->{$C->{CL}}->{LS0}; |
$csi =~ s/$C->{$C->{CL}}->{LS0}//g if $C->{$C->{CL}}->{LS0}; |
| 328 |
$csi =~ s/$C->{$C->{CL}}->{LS1}//g if $C->{$C->{CL}}->{LS1}; |
$csi =~ s/$C->{$C->{CL}}->{LS1}//g if $C->{$C->{CL}}->{LS1}; |
| 337 |
|
|
| 338 |
} # _iso2022_to_internal |
} # _iso2022_to_internal |
| 339 |
|
|
| 340 |
sub internal_to_iso2022 ($\%) { |
sub internal_to_iso2022 ($;%) { |
| 341 |
my ($s, $C) = @_; |
my ($s, $C) = @_; |
| 342 |
$C ||= &new_object; |
$C ||= &new_object; |
| 343 |
|
|
| 352 |
} elsif ($cc < 0x7F) { |
} elsif ($cc < 0x7F) { |
| 353 |
$t = _i2g ($c, $C, type => 'G94', charset => 'B'); |
$t = _i2g ($c, $C, type => 'G94', charset => 'B'); |
| 354 |
} elsif ($cc <= 0x9F) { |
} elsif ($cc <= 0x9F) { |
| 355 |
$t = _i2c ($c, $C, type => 'C1', charset_id => '64291991C1', |
$t = _i2c (pack ('C', $cc), $C, type => 'C1', charset_id => '64291991C1', |
| 356 |
charset => $C->{option}->{private_set}->{XC1}->{'64291991C1'}); |
charset => $C->{option}->{private_set}->{XC1}->{'64291991C1'}); |
| 357 |
} elsif ($cc <= 0xFF) { |
} elsif ($cc <= 0xFF) { |
| 358 |
$t = _i2g (chr($cc-0x80), $C, type => 'G96', charset => 'A'); |
$t = _i2g (pack ('C', $cc-0x80), $C, type => 'G96', charset => 'A'); |
| 359 |
} elsif ($cc <= 0x24FF) { |
} elsif ($cc <= 0x24FF) { |
| 360 |
my $c = $cc - 0x100; |
my $c = $cc - 0x100; |
| 361 |
my $final = $C->{option}->{private_set}->{U96n}->[0]; |
my $final = $C->{option}->{private_set}->{U96n}->[0]; |
| 524 |
} |
} |
| 525 |
$r .= _back2ascii ($C, reset_all => $C->{C1}->{reset_all}->{$s}); |
$r .= _back2ascii ($C, reset_all => $C->{C1}->{reset_all}->{$s}); |
| 526 |
unless ($C->{option}->{C1invoke_to_right}) { ## ESC Fe |
unless ($C->{option}->{C1invoke_to_right}) { ## ESC Fe |
| 527 |
$s =~ s/([\x80-\x9F])/"\x1B" . chr (ord ($1) - 0x40)/ge; |
$s =~ s/([\x80-\x9F])/"\x1B" . pack ('C', ord ($1) - 0x40)/ge; |
| 528 |
} |
} |
| 529 |
return $r . $s; |
return $r . $s; |
| 530 |
} |
} |