/[suikacvs]/markup/html/whatpm/Whatpm/Charset/DecodeHandle.pm
Suika

Diff of /markup/html/whatpm/Whatpm/Charset/DecodeHandle.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by wakaba, Sun May 18 04:15:52 2008 UTC revision 1.16 by wakaba, Sun Sep 14 07:19:47 2008 UTC
# Line 1  Line 1 
1  package Whatpm::Charset::DecodeHandle;  package Whatpm::Charset::DecodeHandle;
2  use strict;  use strict;
3    
4    ## NOTE: |Message::Charset::Info| uses this module without calling
5    ## the constructor.
6    use Message::Charset::Info;
7    
8  my $XML_AUTO_CHARSET = q<http://suika.fam.cx/www/2006/03/xml-entity/>;  my $XML_AUTO_CHARSET = q<http://suika.fam.cx/www/2006/03/xml-entity/>;
9  my $IANA_CHARSET = q<urn:x-suika-fam-cx:charset:>;  my $IANA_CHARSET = q<urn:x-suika-fam-cx:charset:>;
10  my $PERL_CHARSET = q<http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.>;  my $PERL_CHARSET = q<http://suika.fam.cx/~wakaba/archive/2004/dis/Charset/Perl.>;
# Line 10  my $XML_CHARSET = q<http://suika.fam.cx/ Line 14  my $XML_CHARSET = q<http://suika.fam.cx/
14  sub create_decode_handle ($$$;$) {  sub create_decode_handle ($$$;$) {
15    my $csdef = $Whatpm::Charset::CharsetDef->{$_[1]};    my $csdef = $Whatpm::Charset::CharsetDef->{$_[1]};
16    my $obj = {    my $obj = {
17                 category => 0,
18                 char_buffer => \(my $s = ''),
19                 char_buffer_pos => 0,
20               character_queue => [],               character_queue => [],
21               filehandle => $_[2],               filehandle => $_[2],
22               charset => $_[1],               charset => $_[1],
# Line 434  sub create_decode_handle ($$$;$) { Line 441  sub create_decode_handle ($$$;$) {
441        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
442        require Encode::EUCJP1997;        require Encode::EUCJP1997;
443        if (Encode::find_encoding ($obj->{perl_encoding_name})) {        if (Encode::find_encoding ($obj->{perl_encoding_name})) {
444          return bless $obj, 'Whatpm::Charset::DecodeHandle::EUCJP';          $obj->{category} |= Message::Charset::Info::CHARSET_CATEGORY_EUCJP;
445            return bless $obj, 'Whatpm::Charset::DecodeHandle::Encode';
446        }        }
447      } elsif ($csdef->{uri}->{$XML_CHARSET.'shift_jis'} or      } elsif ($csdef->{uri}->{$XML_CHARSET.'shift_jis'} or
448               $csdef->{uri}->{$IANA_CHARSET.'shift_jis'}) {               $csdef->{uri}->{$IANA_CHARSET.'shift_jis'}) {
449        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
450        require Encode::ShiftJIS1997;        require Encode::ShiftJIS1997;
451        if (Encode::find_encoding ($obj->{perl_encoding_name})) {        if (Encode::find_encoding ($obj->{perl_encoding_name})) {
452          return bless $obj, 'Whatpm::Charset::DecodeHandle::ShiftJIS';          return bless $obj, 'Whatpm::Charset::DecodeHandle::Encode';
453        }        }
454      } elsif ($csdef->{is_block_safe}) {      } elsif ($csdef->{is_block_safe}) {
455        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];        $obj->{perl_encoding_name} = $csdef->{perl_name}->[0];
# Line 530  require IO::Handle; Line 538  require IO::Handle;
538    
539  package Whatpm::Charset::DecodeHandle::ByteBuffer;  package Whatpm::Charset::DecodeHandle::ByteBuffer;
540    
541    ## NOTE: Provides a byte buffer wrapper object.
542    
543  sub new ($$) {  sub new ($$) {
544    my $self = bless {    my $self = bless {
545      buffer => '',      buffer => '',
# Line 543  sub read { Line 553  sub read {
553    my $pos = length $self->{buffer};    my $pos = length $self->{buffer};
554    my $r = $self->{filehandle}->read ($self->{buffer}, $_[1], $pos);    my $r = $self->{filehandle}->read ($self->{buffer}, $_[1], $pos);
555    substr ($_[0], $_[2]) = substr ($self->{buffer}, $pos);    substr ($_[0], $_[2]) = substr ($self->{buffer}, $pos);
556          ## NOTE: This would do different behavior from Perl's standard
557          ## |read| when $pos points beyond the end of the string.
558    return $r;    return $r;
559  } # read  } # read
560    
561  sub close { $_[0]->{filehandle}->close }  sub close { $_[0]->{filehandle}->close }
562    
563    package Whatpm::Charset::DecodeHandle::CharString;
564    
565    ## NOTE: Same as Perl's standard |open $handle, '<', \$char_string|,
566    ## but supports |ungetc| and other extensions.
567    
568    sub new ($$) {
569      my $self = bless {pos => 0}, shift;
570      $self->{string} = shift; # must be a scalar ref
571      return $self;
572    } # new
573    
574    sub getc ($) {
575      my $self = shift;
576      if ($self->{pos} < length ${$self->{string}}) {
577        return substr ${$self->{string}}, $self->{pos}++, 1;
578      } else {
579        return undef;
580      }
581    } # getc
582    
583    sub read ($$$$) {
584      #my ($self, $scalar, $length, $offset) = @_;
585      my $self = $_[0];
586      my $length = $_[2] || 0;
587      my $offset = $_[3];
588      ## NOTE: We don't support standard Perl semantics if $offset is
589      ## greater than the length of $scalar.
590      substr ($_[1], $offset) = substr (${$self->{string}}, $self->{pos}, $length);
591      my $count = (length $_[1]) - $offset;
592      $self->{pos} += $count;
593      return $count;
594    } # read
595    
596    sub manakai_read_until ($$$;$) {
597      #my ($self, $scalar, $pattern, $offset) = @_;
598      my $self = $_[0];
599      pos (${$self->{string}}) = $self->{pos};
600      if (${$self->{string}} =~ /\G(?>$_[2])+/) {
601        substr ($_[1], $_[3]) = substr (${$self->{string}}, $-[0], $+[0] - $-[0]);
602        $self->{pos} += $+[0] - $-[0];
603        return $+[0] - $-[0];
604      } else {
605        return 0;
606      }
607    } # manakai_read_until
608    
609    sub ungetc ($$) {
610      my $self = shift;
611      ## Ignore second parameter.
612      $self->{pos}-- if $self->{pos} > 0;
613    } # ungetc
614    
615    sub close ($) { }
616    
617  package Whatpm::Charset::DecodeHandle::Encode;  package Whatpm::Charset::DecodeHandle::Encode;
618    
619    ## NOTE: Provides a Perl |Encode| module wrapper object.
620    
621  sub charset ($) { $_[0]->{charset} }  sub charset ($) { $_[0]->{charset} }
622    
623  sub close ($) { $_[0]->{filehandle}->close }  sub close ($) { $_[0]->{filehandle}->close }
624    
625  sub getc ($) {  sub getc ($) {
626    my $self = $_[0];    my $c = '';
627    return shift @{$self->{character_queue}} if @{$self->{character_queue}};    my $l = $_[0]->read ($c, 1);
628        if ($l) {
629    my $error;      return $c;
630    if ($self->{continue}) {    } else {
631      if ($self->{filehandle}->read ($self->{byte_buffer}, 256,      return undef;
                                    length $self->{byte_buffer})) {  
       #  
     } else {  
       $error = 1;  
     }  
     $self->{continue} = 0;  
   } elsif (512 > length $self->{byte_buffer}) {  
     $self->{filehandle}->read ($self->{byte_buffer}, 256,  
                                length $self->{byte_buffer});  
632    }    }
633    } # getc
634    
635    my $r;  sub read ($$$;$) {
636    unless ($error) {    my $self = $_[0];
637      if (not $self->{bom_checked}) {    #my $scalar = $_[1];
638        if (defined $self->{bom_pattern}) {    my $length = $_[2];
639          if ($self->{byte_buffer} =~ s/^$self->{bom_pattern}//) {    my $offset = $_[3] || 0;
640            $self->{has_bom} = 1;    my $count = 0;
641          }    my $eof;
642        }    ## NOTE: It is incompatible with the standard Perl semantics
643        $self->{bom_checked} = 1;    ## if $offset is greater than the length of $scalar.
644      }  
645      A: {
646      my $string = Encode::decode ($self->{perl_encoding_name},      return $count if $length < 1;
647                                   $self->{byte_buffer},  
648                                   Encode::FB_QUIET ());      if (my $l = (length ${$self->{char_buffer}}) - $self->{char_buffer_pos}) {
649      if (length $string) {        if ($l >= $length) {
650        push @{$self->{character_queue}}, split //, $string;          substr ($_[1], $offset)
651        $r = shift @{$self->{character_queue}};              = substr (${$self->{char_buffer}}, $self->{char_buffer_pos},
652        if (length $self->{byte_buffer}) {                        $length);
653          $self->{continue} = 1;          $count += $length;
654            $self->{char_buffer_pos} += $length;
655            $length = 0;
656            return $count;
657          } else {
658            substr ($_[1], $offset)
659                = substr (${$self->{char_buffer}}, $self->{char_buffer_pos});
660            $count += $l;
661            $length -= $l;
662            ${$self->{char_buffer}} = '';
663            $self->{char_buffer_pos} = 0;
664        }        }
665      } else {        $offset = length $_[1];
666        if (length $self->{byte_buffer}) {      }
667    
668        if ($eof) {
669          return $count;
670        }
671    
672        my $error;
673        if ($self->{continue}) {
674          if ($self->{filehandle}->read ($self->{byte_buffer}, 256,
675                                         length $self->{byte_buffer})) {
676            #
677          } else {
678          $error = 1;          $error = 1;
679          }
680          $self->{continue} = 0;
681        } elsif (512 > length $self->{byte_buffer}) {
682          if ($self->{filehandle}->read ($self->{byte_buffer}, 256,
683                                         length $self->{byte_buffer})) {
684            #
685        } else {        } else {
686          $r = undef;          $eof = 1;
687        }        }
688      }      }
   }  
689    
690    if ($error) {      unless ($error) {
691      $r = substr $self->{byte_buffer}, 0, 1, '';        if (not $self->{bom_checked}) {
692      $self->{onerror}->($self, 'illegal-octets-error', octets => \$r);          if (defined $self->{bom_pattern}) {
693    }            if ($self->{byte_buffer} =~ s/^$self->{bom_pattern}//) {
694                $self->{has_bom} = 1;
695              }
696            }
697            $self->{bom_checked} = 1;
698          }
699    
700    return $r;        my $string = Encode::decode ($self->{perl_encoding_name},
701  } # getc                                     $self->{byte_buffer},
702                                       Encode::FB_QUIET ());
703          if (length $string) {
704            $self->{char_buffer} = \$string;
705            $self->{char_buffer_pos} = 0;
706            if (length $self->{byte_buffer}) {
707              $self->{continue} = 1;
708            }
709          } else {
710            if (length $self->{byte_buffer}) {
711              $error = 1;
712            } else {
713              ## NOTE: No further input.
714              redo A;
715            }
716          }
717        }
718    
719        if ($error) {
720          my $r = substr $self->{byte_buffer}, 0, 1, '';
721          my $fallback;
722          my $etype = 'illegal-octets-error';
723          my %earg;
724          if ($self->{category}
725                  & Message::Charset::Info::CHARSET_CATEGORY_SJIS) {
726            if ($r =~ /^[\x81-\x9F\xE0-\xFC]/) {
727              if ($self->{byte_buffer} =~ s/(.)//s) {
728                $r .= $1;                     # not limited to \x40-\xFC - \x7F
729                $etype = 'unassigned-code-point-error';
730              }
731              ## NOTE: Range [\xF0-\xFC] is unassigned and may be used as a
732              ## single-byte character or as the first-byte of a double-byte
733              ## character, according to JIS X 0208:1997 Appendix 1.  However, the
734              ## current practice is using the range as first-bytes of double-byte
735              ## characters.
736            } elsif ($r =~ /^[\x80\xA0\xFD-\xFF]/) {
737              $etype = 'unassigned-code-point-error';
738            }
739          } elsif ($self->{category}
740                       & Message::Charset::Info::CHARSET_CATEGORY_EUCJP) {
741            if ($r =~ /^[\xA1-\xFE]/) {
742              if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {
743                $r .= $1;
744                $etype = 'unassigned-code-point-error';
745              }
746            } elsif ($r eq "\x8F") {
747              if ($self->{byte_buffer} =~ s/^([\xA1-\xFE][\xA1-\xFE]?)//) {
748                $r .= $1;
749                $etype = 'unassigned-code-point-error' if length $1 == 2;
750              }
751            } elsif ($r eq "\x8E") {
752              if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {
753                $r .= $1;
754                $etype = 'unassigned-code-point-error';
755              }
756            } elsif ($r eq "\xA0" or $r eq "\xFF") {
757              $etype = 'unassigned-code-point-error';
758            }
759          } else {
760            $fallback = $self->{fallback}->{$r};
761            if (defined $fallback) {
762              ## NOTE: This is an HTML5 parse error.
763              $etype = 'fallback-char-error';
764              $earg{char} = \$fallback;
765            } elsif (exists $self->{fallback}->{$r}) {
766              ## NOTE: This is an HTML5 parse error.  In addition, the octet
767              ## is not assigned with a character.
768              $etype = 'fallback-unassigned-error';
769            }
770          }
771    
772          ## NOTE: Fixup line/column number by counting the number of
773          ## lines/columns in the string that is to be retuend by this
774          ## method call.
775          my $line_diff = 0;
776          my $col_diff = 0;
777          my $set_col;
778          for (my $i = 0; $i < $count; $i++) {
779            my $s = substr $_[1], $i - $count, 1;
780            if ($s eq "\x0D") {
781              $line_diff++;
782              $col_diff = 0;
783              $set_col = 1;
784              $i++ if substr ($_[1], $i - $count + 1, 1) eq "\x0A";
785            } elsif ($s eq "\x0A") {
786              $line_diff++;
787              $col_diff = 0;
788              $set_col = 1;
789            } else {
790              $col_diff++;
791            }
792          }
793          my $i = $self->{char_buffer_pos};
794          if ($count and substr (${$self->{char_buffer}}, -1, 1) eq "\x0D") {
795            if (substr (${$self->{char_buffer}}, $i, 1) eq "\x0A") {
796              $i++;
797            }
798          }
799          my $cb_length = length ${$self->{char_buffer}};
800          for (; $i < $cb_length; $i++) {
801            my $s = substr $_[1], $i, 1;
802            if ($s eq "\x0D") {
803              $line_diff++;
804              $col_diff = 0;
805              $set_col = 1;
806              $i++ if substr ($_[1], $i + 1, 1) eq "\x0A";
807            } elsif ($s eq "\x0A") {
808              $line_diff++;
809              $col_diff = 0;
810              $set_col = 1;
811            } else {
812              $col_diff++;
813            }
814          }
815          $self->{onerror}->($self, $etype, octets => \$r, %earg,
816                             level => $self->{level}->{$self->{error_level}->{$etype}},
817                             line_diff => $line_diff,
818                             ($set_col ? (column => 1) : ()),
819                             column_diff => $col_diff);
820              ## NOTE: Error handler may modify |octets| parameter, which
821              ## would be returned as part of the output.  Note that what
822              ## is returned would affect what |manakai_read_until| returns.
823          ${$self->{char_buffer}} .= defined $fallback ? $fallback : $r;
824        }
825    
826        redo A;
827      } # A
828    } # read
829    
830    sub manakai_read_until ($$$;$) {
831      #my ($self, $scalar, $pattern, $offset) = @_;
832      my $self = $_[0];
833      my $s = '';
834      $self->read ($s, 255);
835      if ($s =~ /^(?>$_[2])+/) {
836        my $rem_length = (length $s) - $+[0];
837        if ($rem_length) {
838          if ($self->{char_buffer_pos} > $rem_length) {
839            $self->{char_buffer_pos} -= $rem_length;
840          } else {
841            substr (${$self->{char_buffer}}, 0, $self->{char_buffer_pos})
842                = substr ($s, $+[0]);
843            $self->{char_buffer_pos} = 0;
844          }
845        }
846        substr ($_[1], $_[3]) = substr ($s, $-[0], $+[0] - $-[0]);
847        return $+[0];
848      } elsif (length $s) {
849        if ($self->{char_buffer_pos} > length $s) {
850          $self->{char_buffer_pos} -= length $s;
851        } else {
852          substr (${$self->{char_buffer}}, 0, $self->{char_buffer_pos}) = $s;
853          $self->{char_buffer_pos} = 0;
854        }
855      }
856      return 0;
857    } # manakai_read_until
858    
859  sub has_bom ($) { $_[0]->{has_bom} }  sub has_bom ($) { $_[0]->{has_bom} }
860    
# Line 635  sub ungetc ($$) { Line 882  sub ungetc ($$) {
882    unshift @{$_[0]->{character_queue}}, chr int ($_[1] or 0);    unshift @{$_[0]->{character_queue}}, chr int ($_[1] or 0);
883  } # ungetc  } # ungetc
884    
 package Whatpm::Charset::DecodeHandle::EUCJP;  
 push our @ISA, 'Whatpm::Charset::DecodeHandle::Encode';  
   
 sub getc ($) {  
   my $self = $_[0];  
   return shift @{$self->{character_queue}} if @{$self->{character_queue}};  
   
   my $error;  
   if ($self->{continue}) {  
     if ($self->{filehandle}->read ($self->{byte_buffer}, 256,  
                                    length $self->{byte_buffer})) {  
       #  
     } else {  
       $error = 1;  
     }  
     $self->{continue} = 0;  
   } elsif (512 > length $self->{byte_buffer}) {  
     $self->{filehandle}->read ($self->{byte_buffer}, 256,  
                                length $self->{byte_buffer});  
   }  
     
   my $r;  
   unless ($error) {  
     my $string = Encode::decode ($self->{perl_encoding_name},  
                                  $self->{byte_buffer},  
                                  Encode::FB_QUIET ());  
     if (length $string) {  
       push @{$self->{character_queue}}, split //, $string;  
       $r = shift @{$self->{character_queue}};  
       if (length $self->{byte_buffer}) {  
         $self->{continue} = 1;  
       }  
     } else {  
       if (length $self->{byte_buffer}) {  
         $error = 1;  
       } else {  
         $r = undef;  
       }  
     }  
   }  
   
   if ($error) {  
     $r = substr $self->{byte_buffer}, 0, 1, '';  
     my $etype = 'illegal-octets-error';  
     if ($r =~ /^[\xA1-\xFE]/) {  
       if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {  
         $r .= $1;  
         $etype = 'unassigned-code-point-error';  
       }  
     } elsif ($r eq "\x8F") {  
       if ($self->{byte_buffer} =~ s/^([\xA1-\xFE][\xA1-\xFE]?)//) {  
         $r .= $1;  
         $etype = 'unassigned-code-point-error' if length $1 == 2;  
       }  
     } elsif ($r eq "\x8E") {  
       if ($self->{byte_buffer} =~ s/^([\xA1-\xFE])//) {  
         $r .= $1;  
         $etype = 'unassigned-code-point-error';  
       }  
     } elsif ($r eq "\xA0" or $r eq "\xFF") {  
       $etype = 'unassigned-code-point-error';  
     }  
     $self->{onerror}->($self, $etype, octets => \$r);  
   }  
     
   return $r;  
 } # getc  
   
885  package Whatpm::Charset::DecodeHandle::ISO2022JP;  package Whatpm::Charset::DecodeHandle::ISO2022JP;
886  push our @ISA, 'Whatpm::Charset::DecodeHandle::Encode';  push our @ISA, 'Whatpm::Charset::DecodeHandle::Encode';
887    
# Line 758  sub getc ($) { Line 937  sub getc ($) {
937            } else {            } else {
938              $r = undef;              $r = undef;
939              $self->{onerror}->($self, 'invalid-state-error',              $self->{onerror}->($self, 'invalid-state-error',
940                                 state => $self->{state});                                 state => $self->{state},
941                                   level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
942            }            }
943          }          }
944        } elsif ($self->{state} eq 'state_2442') { # 1983        } elsif ($self->{state} eq 'state_2442') { # 1983
# Line 774  sub getc ($) { Line 954  sub getc ($) {
954            } else {            } else {
955              $r = undef;              $r = undef;
956              $self->{onerror}->($self, 'invalid-state-error',              $self->{onerror}->($self, 'invalid-state-error',
957                                 state => $self->{state});                                 state => $self->{state},
958                                   level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
959            }            }
960          }          }
961        } elsif ($self->{state} eq 'state_2440') { # 1978        } elsif ($self->{state} eq 'state_2440') { # 1978
# Line 790  sub getc ($) { Line 971  sub getc ($) {
971            } else {            } else {
972              $r = undef;              $r = undef;
973              $self->{onerror}->($self, 'invalid-state-error',              $self->{onerror}->($self, 'invalid-state-error',
974                                 state => $self->{state});                                 state => $self->{state},
975                                   level => $self->{level}->{$self->{error_level}->{'invalid-state-error'}});
976            }            }
977          }          }
978        } else {        } else {
# Line 812  sub getc ($) { Line 994  sub getc ($) {
994          $r .= "(H";          $r .= "(H";
995          $self->{state} = 'state_284A';          $self->{state} = 'state_284A';
996        }        }
997        $self->{onerror}->($self, $etype, octets => \$r);        $self->{onerror}->($self, $etype, octets => \$r,
998                             level => $self->{level}->{$self->{error_level}->{$etype}});
999      }      }
1000    } # A    } # A
1001        
1002    return $r;    return $r;
1003  } # getc  } # getc
1004    
1005  package Whatpm::Charset::DecodeHandle::ShiftJIS;  ## TODO: This is not good for performance.  Should be replaced
1006  push our @ISA, 'Whatpm::Charset::DecodeHandle::Encode';  ## by read-centric implementation.
1007    sub read ($$$;$) {
1008  sub getc ($) {    #my ($self, $scalar, $length, $offset) = @_;
1009    my $self = $_[0];    my $length = $_[2];
1010    return shift @{$self->{character_queue}} if @{$self->{character_queue}};    my $r = '';
1011      while ($length > 0) {
1012    my $error;      my $c = $_[0]->getc;
1013    if ($self->{continue}) {      last unless defined $c;
1014      if ($self->{filehandle}->read ($self->{byte_buffer}, 256,      $r .= $c;
1015                                     length $self->{byte_buffer})) {      $length--;
       #  
     } else {  
       $error = 1;  
     }  
     $self->{continue} = 0;  
   } elsif (512 > length $self->{byte_buffer}) {  
     $self->{filehandle}->read ($self->{byte_buffer}, 256,  
                                length $self->{byte_buffer});  
1016    }    }
1017      substr ($_[1], $_[3]) = $r;
1018          ## NOTE: This would do different thing from what Perl's |read| do
1019          ## if $offset points beyond the end of the $scalar.
1020      return length $r;
1021    } # read
1022    
1023    my $r;  sub manakai_read_until ($$$;$) {
1024    unless ($error) {    #my ($self, $scalar, $pattern, $offset) = @_;
1025      my $string = Encode::decode ($self->{perl_encoding_name},    my $self = $_[0];
1026                                   $self->{byte_buffer},    my $c = $self->getc;
1027                                   Encode::FB_QUIET ());    if ($c =~ /^$_[2]/) {
1028      if (length $string) {      substr ($_[1], $_[3]) = $c;
1029        push @{$self->{character_queue}}, split //, $string;      return 1;
1030        $r = shift @{$self->{character_queue}};    } elsif (defined $c) {
1031        if (length $self->{byte_buffer}) {      $self->ungetc (ord $c);
1032          $self->{continue} = 1;      return 0;
1033        }    } else {
1034      } else {      return 0;
       if (length $self->{byte_buffer}) {  
         $error = 1;  
       } else {  
         $r = undef;  
       }  
     }  
   }  
     
   if ($error) {  
     $r = substr $self->{byte_buffer}, 0, 1, '';  
     my $etype = 'illegal-octets-error';  
     if ($r =~ /^[\x81-\x9F\xE0-\xFC]/) {  
       if ($self->{byte_buffer} =~ s/(.)//s) {  
         $r .= $1;                     # not limited to \x40-\xFC - \x7F  
         $etype = 'unassigned-code-point-error';  
       }  
       ## NOTE: Range [\xF0-\xFC] is unassigned and may be used as a single-byte  
       ## character or as the first-byte of a double-byte character according  
       ## to JIS X 0208:1997 Appendix 1.  However, the current practice is  
       ## use the range as the first-byte of double-byte characters.  
     } elsif ($r =~ /^[\x80\xA0\xFD-\xFF]/) {  
       $etype = 'unassigned-code-point-error';  
     }  
     $self->{onerror}->($self, $etype, octets => \$r);  
1035    }    }
1036    } # manakai_read_until
   return $r;  
 } # getc  
1037    
1038  $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us-ascii'} =  $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us-ascii'} =
1039  $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us'} =  $Whatpm::Charset::CharsetDef->{'urn:x-suika-fam-cx:charset:us'} =
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.16
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24