如何检测和报告使用Perl进行交换不合法的Unicode代码点?

时间:2013-07-04 21:12:10

标签: perl unicode character-encoding

我正在使用Perl处理Unicode的UTF-8字符编码方案中的数十万个纯文本文件。这些纯文本文档是法律发现过程中的计算机证据。我没有替换它们或忽略它们的奢侈。

我的问题是其中一些文件被垃圾污染:编码损坏的文本,无效的二进制数据等。我需要能够检测并准确报告这些假定的纯文本文档的错误Unicode术语。换句话说,我必须确定是否存在特定类别的无效Unicode代码点:Unicode非字符,代理项和非Unicode字符。仅仅解决它们是不够的,我知道该怎么做。

使用Perl 5.14,如何检测和报告不适合交换的Unicode代码点?我大多只是在寻找如何开始的提示。

1 个答案:

答案 0 :(得分:2)

首先,找到编码错误,然后找到不需要的代码点。

后者很简单,因为有Unicode属性可以识别它们。 (见下文)

要准确报告错误,您可能需要编写自己的解码器来查找UTF-8错误。

sub bytes_to_hex { join ' ', map { sprintf '%02X', $_ } unpack 'C*', $_[0] }

my @errors;
my @warns;
my $output = '';
for ($input) {
   while (!/\G \z /xgc) {
      my $pos = pos;

      if (/\G (
         (?: [\x00-\x7F]
         |   [\xC0-\xDF][\x80-\xBF]
         |   [\xE0-\xEF][\x80-\xBF]{2}
         |   [\xF0-\xF7][\x80-\xBF]{3}
         |   [\xF8-\xFB][\x80-\xBF]{4}
         |   [\xFC-\xFD][\x80-\xBF]{5}
         )
      ) /xgc) {
         my $bytes = $1;
         my @bytes = unpack 'C*', $bytes;
         my $hex_bytes = bytes_to_hex($bytes);

         if ($bytes =~ /^
            (?: [\xC0-\xC1]
            |   \xE0[\x80-\x9F]
            |   \xF0[\x80-\x8F]
            |   \xF8[\x80-\x87]
            |   \xFC[\x80-\x83]
            )
         /x) {
            push @warns, "Overlong encoding $hex_bytes at pos $pos";
         }

         if ($bytes =~ /^[\xF8-\xFD]/) {
            push @warns, "Defunct 5 or 6 byte sequence $hex_bytes at pos $pos";
         }

         my $code_point_ord = @bytes == 1
            ? $bytes[0]
            : $bytes[0] & ( 0x7F >> @bytes );
         $code_point_ord = ( $code_point_ord << 6 ) | ( $_ & 0x3F )
            for @bytes[ 1..$#bytes ];
         my $code_point_hex = sprintf('U+%05X', $code_point_ord);
         my $code_point = chr($code_point_ord);

         if ($code_point_ord >= 0x110000) {
            push @errors, "Non-Unicode $code_point_hex at pos $pos";
         } else {
            push @warns, "Surrogate $code_point_hex at pos $pos"
               if $code_point =~ /\p{Cs}/;
            push @warns, "Private use $code_point_hex at pos $pos"
               if $code_point =~ /\p{Co}/;
            push @warns, "Unassigned $code_point_hex at pos $pos"
               if $code_point =~ /\p{Cn}/;

            $output .= $code_point;
         }
      }

      elsif (/\G (
         (?: [\xC0-\xDF]
         |   [\xE0-\xEF][\x80-\xBF]{0,1}
         |   [\xF0-\xF7][\x80-\xBF]{0,2}
         |   [\xF8-\xFB][\x80-\xBF]{0,3}
         |   [\xFC-\xFD][\x80-\xBF]{0,4}
         )
      ) /xgc) {
         my $bytes = $1;
         my $hex_bytes = bytes_to_hex($bytes);
         push @errors, "Incomplete sequence $hex_bytes at pos $pos";
      }

      elsif (/\G ( [\x80-\xBF] ) /xgc) {
         my $byte = $1;
         my $hex_byte = bytes_to_hex($byte);
         push @errors, "Unexpected continuation byte $hex_byte at pos $pos";
      }

      elsif (/\G ( [\xFE-\xFF] ) /xgc) {
         my $byte = $1;
         my $hex_byte = bytes_to_hex($byte);
         push @errors, "Invalid byte $hex_byte at pos $pos";
      }
      else {
         die "Bug";
      }
   }
}