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

2023年3月29日 236次阅读

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

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

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

最佳答案 首先,找到编码错误,然后找到不需要的代码点.

后者很容易,因为有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";
      }
   }
}
点赞