Convert UTF-8 byte stream to Unicode

问题:

How can I easily create a mapping from a UTF-8 bytestream to a Unicode codepoint array? To clarify, if for example I have the byte sequence:

c3 a5 76 aa e2 82 ac

The mapping should produce two arrays of the same length; one with UTF-8 byte sequences, and the other with the corresponding Unicode codepoint. Then, the arrays could be printed side-by-side like:

UTF8                UNICODE             
----------------------------------------
C3 A5               000000E5            
76                  00000076            
AA                  0000FFFD            
E2 82 AC            000020AC            

回答1:

A solution that works with streams:

use READ_SIZE => 64*1024;

my $buf = '';
while (1) {
   my $rv = sysread($fh, $buf, READ_SIZE, length($buf));
   die("Read error: $!\n") if !defined($rv);
   last if !$rv;

   while (length($buf)) {
      if ($buf =~ s/
         ^
         ( [\x00-\x7F]
         | [\xC2-\xDF] [\x80-\xBF]
         | \xE0        [\xA0-\xBF] [\x80-\xBF]
         | [\xE1-\xEF] [\x80-\xBF] [\x80-\xBF]
         | \xF0        [\x90-\xBF] [\x80-\xBF] [\x80-\xBF]
         | [\xF1-\xF7] [\x80-\xBF] [\x80-\xBF] [\x80-\xBF]
         )
      //x) {
         # Something valid
         my $utf8 = $1;
         utf8::decode( my $ucp = $utf8 );
         handle($utf8, $ucp);
      }

      elsif ($buf =~ s/
         ^
         (?: [\xC2-\xDF]
         |   \xE0            [\xA0-\xBF]?
         |   [\xE1-\xEF]     [\x80-\xBF]?
         |   \xF0        (?: [\x90-\xBF] [\x80-\xBF]? )?
         |   [\xF1-\xF7] (?: [\x80-\xBF] [\x80-\xBF]? )?
         )
         \z
      //x) {
         # Something possibly valid
         last;
      }

      else {
         # Something invalid
         handle(substr($buf, 0, 1, ''), "\x{FFFD}");
      }
}

while (length($buf)) {
   handle(substr($buf, 0, 1, ''), "\x{FFFD}");
}

The above only returns U+FFFD for what Encode::decode('UTF-8', $bytes) considered ill-formed. In other words, it only returns U+FFFD when it encounters on of the following:

• An unexpected continuation byte.
• A start byte not followed by enough continuation bytes.
• The first byte of an "overlong" encoding.

Post-decoding checks are still needed to return U+FFFD for what Encode::decode('UTF-8', $bytes) considers otherwise illegal.

回答2:

Encode has an API for incremental decoding but it's undocumented, Your mileage may vary! It's used by subclasses of Encode::Encoding and PerlIO::encoding. As with any undocumented API it's a subject to change at any time. There has been an effort to document the API.

#!/usr/bin/perl
use strict;
use warnings;

use Encode qw[STOP_AT_PARTIAL];

my $encoding = Encode::find_encoding('UTF-8');

my @octets = map { pack 'C', hex } qw<C3 A5 76 AA E2 82 AC F0 9F 90 A2>;
my $buffer = '';
while (@octets) {
    my $octets = $buffer . shift @octets;

    printf "--> processing: <%s>\n", 
      join ' ', map { sprintf '%.2X', ord } split //, $octets;

    my $string = $encoding->decode($octets, STOP_AT_PARTIAL);

    $buffer = $octets;

    if (length $buffer) {
        printf "buffered code units: <%s>\n", 
          join ' ', map { sprintf '%.2X', ord } split //, $buffer;
    }

    if (length $string) {
        printf "received code points: <%s>\n",
          join ' ', map { sprintf 'U+%.4X', ord } split //, $string;
    }
}

Output:

--> processing: <C3>
buffered code units: <C3>
--> processing: <C3 A5>
received code points: <U+00E5>
--> processing: <76>
received code points: <U+0076>
--> processing: <AA>
received code points: <U+FFFD>
--> processing: <E2>
buffered code units: <E2>
--> processing: <E2 82>
buffered code units: <E2 82>
--> processing: <E2 82 AC>
received code points: <U+20AC>
--> processing: <F0>
buffered code units: <F0>
--> processing: <F0 9F>
buffered code units: <F0 9F>
--> processing: <F0 9F 90>
buffered code units: <F0 9F 90>
--> processing: <F0 9F 90 A2>
received code points: <U+1F422>

回答3:

Here is a way to do it (the script takes the byte sequence as the first command line argument):

use feature qw(say);
use strict;
use warnings;

use Encode;

my @hex = split " ", shift;
my $bytes = join '', map { chr hex } @hex;
my @abytes;
my @achr;
while (1) {
    my $str = decode( 'UTF-8', $bytes, Encode::FB_QUIET );
    if ( length $str > 0 ) {
        for my $char ( split //, $str ) {
            my $bytes = encode( "UTF-8", $char, Encode::FB_CROAK | Encode::LEAVE_SRC);
            push @abytes, $bytes;
            push @achr, $char;
        }
    }
    last if length $bytes == 0;
    push @abytes, substr $bytes, 0, 1;
    push @achr, chr 0xfffd;
    $bytes = substr $bytes, 1;
}

my $fmt = '%-20s%-20s';
say sprintf $fmt, qw(UTF8 UNICODE);
say "-" x 40;
for my $char ( @achr ) {
    my $bytes = shift @abytes;
    my $str1 = join ' ', map { sprintf '%X', ord $_} split //, $bytes;
    my $str2 = sprintf '%08X', ord $char;
    say sprintf $fmt, $str1, $str2;
}