Parent Directory
| 
Revision Log
| 
Patch
| revision 1.10 by wakaba, Wed Oct 16 10:39:35 2002 UTC | revision 1.15 by wakaba, Wed Dec 18 12:57:40 2002 UTC | |
|---|---|---|
| # | Line 342 sub internal_to_iso2022 ($;%) { | Line 342 sub internal_to_iso2022 ($;%) { |
| 342 | $C ||= &new_object; | $C ||= &new_object; |
| 343 | ||
| 344 | my $r = ''; | my $r = ''; |
| 345 | for my $c (split //, $s) { | my @c = split //, $s; |
| 346 | my $cc = ord $c; Encode::_utf8_off ($c); | for my $i (0..$#c) { |
| 347 | my $c = $c[$i]; my $cc = ord $c; Encode::_utf8_off ($c); | |
| 348 | my $t; | my $t; |
| 349 | if ($cc <= 0x1F) { | if ($cc <= 0x1F) { |
| 350 | $t = _i2c ($c, $C, type => 'C0', charset => '@'); | $t = _i2c ($c, $C, type => 'C0', charset => '@'); |
| # | Line 452 sub internal_to_iso2022 ($;%) { | Line 453 sub internal_to_iso2022 ($;%) { |
| 453 | ->[ ($cc / 0x10000) - 0x7042 ]->[ $c / 8836 ]); | ->[ ($cc / 0x10000) - 0x7042 ]->[ $c / 8836 ]); |
| 454 | } | } |
| 455 | if (defined $t) { | if (defined $t) { |
| 456 | ## Back to ISO/IEC 2022 if necessary | |
| 457 | $t = _i2o ($t, $C, cs_F => "\x40") | $t = _i2o ($t, $C, cs_F => "\x40") |
| 458 | if $C->{coding_system} ne $CODING_SYSTEM{"\x40"}; | if $C->{coding_system} ne $CODING_SYSTEM{"\x40"}; |
| 459 | } else { | } else { |
| 460 | ## Output in UCS-n or UTF-n if character can't be represented in ISO/IEC 2022 | |
| 461 | my $F; my @F = qw~G /G /H /I B /A /D /F~; | my $F; my @F = qw~G /G /H /I B /A /D /F~; |
| 462 | push @F, qw~/J /K /L~ if $cc <= 0x10FFFF; | push @F, qw~/J /K /L~ if $cc <= 0x10FFFF; |
| 463 | push @F, qw~/@ /C /E~ if $cc <= 0xFFFF; | push @F, qw~/@ /C /E~ if $cc <= 0xFFFF; |
| # | Line 468 sub internal_to_iso2022 ($;%) { | Line 471 sub internal_to_iso2022 ($;%) { |
| 471 | } | } |
| 472 | $t = _i2o ($c, $C, cs_F => $F) if $F; | $t = _i2o ($c, $C, cs_F => $F) if $F; |
| 473 | } | } |
| 474 | if (defined $t) { | if (defined $t) { ## Output the character itself |
| 475 | $r .= $t; | $r .= $t; |
| 476 | } elsif ($C->{option}->{fallback_from_ucs} =~ /quiet/) { | |
| 477 | $r .= _back2ascii ($C) if $C->{option}->{fallback_from_ucs} =~ /back/; | |
| 478 | return ($r, halfway => 1, converted_length => $i, | |
| 479 | warn => $C->{option}->{fallback_from_ucs} =~ /warn/ ? 1 : 0, | |
| 480 | reason => sprintf (q(U+%04X: There is no character mapped to), $cc)); | |
| 481 | } elsif ($C->{option}->{fallback_from_ucs} eq 'croak') { | |
| 482 | return ($r, halfway => 1, die => 1, | |
| 483 | reason => sprintf (q(U+%04X: There is no character mapped to), $cc)); | |
| 484 | } else { | } else { |
| 485 | unless ($C->{option}->{undef_char}->[0] eq "\x20") { | ## Try to output with fallback escape sequence (if specified) |
| 486 | $t = _i2g ($C->{option}->{undef_char}->[0], $C, | my $t = Encode::Charset->fallback_escape ($C, $c); |
| 487 | %{ $C->{option}->{undef_char}->[1] }); | &n |