home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / NoUnicodeExt.pm < prev    next >
Encoding:
Perl POD Document  |  2002-02-03  |  3.0 KB  |  100 lines
  1. # $Id: NoUnicodeExt.pm,v 1.2 2002/02/03 12:25:45 matt Exp $
  2.  
  3. package XML::SAX::PurePerl::Reader;
  4. use strict;
  5.  
  6. use XML::SAX::PurePerl::Reader qw(
  7.     CURRENT
  8.     ENCODING
  9. );
  10.  
  11. sub set_raw_stream {
  12.     # no-op
  13. }
  14.  
  15. sub switch_encoding_stream {
  16.     my ($fh, $encoding) = @_;
  17.     throw XML::SAX::Exception::Parse (
  18.         Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
  19.     ) if $encoding !~ /(ASCII|UTF\-?8)/i;
  20. }
  21.  
  22. sub switch_encoding_string {
  23.     my (undef, $encoding) = @_;
  24.     throw XML::SAX::Exception::Parse (
  25.         Message => "Only ASCII encoding allowed without perl 5.7.2 or higher. You tried: $encoding",
  26.     ) if $encoding !~ /(ASCII|UTF\-?8)/i;
  27. }
  28.  
  29. sub nextchar {
  30.     my $self = shift;
  31.     $self->next;
  32.     
  33.     return unless defined $self->[CURRENT];
  34.  
  35.     if ($self->[CURRENT] eq "\x0D") {
  36.         $self->next;
  37.         return unless defined($self->[CURRENT]);
  38.         if ($self->[CURRENT] ne "\x0A") {
  39.             $self->buffer("\x0A");
  40.         }
  41.     }
  42.     
  43.     return unless $self->[ENCODING];
  44.     my $n = ord($self->[CURRENT]);
  45.     # warn(sprintf("ch: 0x%x ($self->[CURRENT])\n", $n));
  46.     if (($] < 5.007002) && ($n > 0x7F)) {
  47.         # utf8 surrogate
  48.         my $current = $self->[CURRENT];
  49.         if    ($n >= 0xFC) {
  50.             # read 5 chars
  51.             $self->next; $current .= $self->[CURRENT];
  52.             $self->next; $current .= $self->[CURRENT];
  53.             $self->next; $current .= $self->[CURRENT];
  54.             $self->next; $current .= $self->[CURRENT];
  55.             $self->next; $current .= $self->[CURRENT];
  56.         }
  57.         elsif ($n >= 0xF8) {
  58.             # read 4 chars
  59.             $self->next; $current .= $self->[CURRENT];
  60.             $self->next; $current .= $self->[CURRENT];
  61.             $self->next; $current .= $self->[CURRENT];
  62.             $self->next; $current .= $self->[CURRENT];
  63.         }
  64.         elsif ($n >= 0xF0) {
  65.             # read 3 chars
  66.             $self->next; $current .= $self->[CURRENT];
  67.             $self->next; $current .= $self->[CURRENT];
  68.             $self->next; $current .= $self->[CURRENT];
  69.         }
  70.         elsif ($n >= 0xE0) {
  71.             # read 2 chars
  72.             $self->next; $current .= $self->[CURRENT];
  73.             $self->next; $current .= $self->[CURRENT];
  74.         }
  75.         elsif ($n >= 0xC0) {
  76.             # read 1 char
  77.             $self->next; $current .= $self->[CURRENT];
  78.         }
  79.         else {
  80.             throw XML::SAX::Exception::Parse(
  81.                 Message => sprintf("Invalid character 0x%x", $n),
  82.                 ColumnNumber => $self->column,
  83.                 LineNumber => $self->line,
  84.                 PublicId => $self->public_id,
  85.                 SystemId => $self->system_id,
  86.             );
  87.         }
  88.         if ($] >= 5.006001) {
  89.             $self->[CURRENT] = pack("U0A*", $current);
  90.         }
  91.         else {
  92.             $self->[CURRENT] = $current;
  93.         }
  94.         # warn("read extra. current now: $current\n");
  95.     }
  96. }
  97.  
  98. 1;
  99.  
  100.