处理具有多种固定格式的文件的策略答案

【问题标题】：Strategies to handle a file with multiple fixed formats处理具有多种固定格式的文件的策略
【发布时间】：2012-05-12 04:48:59
【问题描述】：

这个问题不是 Perl 特有的，（尽管unpack 函数很可能会出现在我的实现中）。

我必须处理存在多种格式的文件，以便将数据分层分解为有意义的部分。我想做的就是将文件数据解析成合适的数据结构。

这是一个例子（RHS 的评论）：

                                       # | Format | Level | Comment
                                       # +--------+-------+---------
**DEVICE 109523.69142                  #        1       1   file-specific
  .981    561A                         #        2       1
10/MAY/2010    24.15.30,13.45.03       #        3       2   group of records
05:03:01   AB23X  15.67   101325.72    #        4       3   part of single record
*           14  31.30474 13        0   #        5       3   part of single record
05:03:15   CR22X  16.72   101325.42    #        4       3   new record
*           14  29.16264 11        0   #        5       3
06:23:51   AW41X  15.67    101323.9    #        4       3
*           14  31.26493219        0   #        5       3
11/MAY/2010    24.07.13,13.44.63       #        3       2   group of new records
15:57:14   AB23X  15.67   101327.23    #        4       3   part of single record
*           14  31.30474 13        0   #        5       3   part of single record
15:59:59   CR22X  16.72   101331.88    #        4       3   new record
*           14  29.16264 11        0   #        5

我现在的逻辑很脆弱：

例如，我知道 Format 2 总是在 Format 1 之后，而且它们只跨越 2 行。
我还知道格式 4 和 5 总是成对出现，因为它们对应于单个记录。记录的数量可能是可变的
我正在使用正则表达式来推断每一行的格式。但是，这是有风险的，并且在未来（当有人决定更改输出格式时）不会带来灵活性。

这里最大的问题是我可以采用哪些策略来确定哪条线路需要使用哪种格式。我很想知道其他人是否遇到过类似的情况，以及他们为解决这个问题做了什么。

【问题讨论】：

标签： perl

【解决方案1】：

为了回答你的问题，我找到了一个有趣的解决方案，其中包含一个简洁的主循环：

while (<>) {
  given($_) {
    when (@{[ map $pattern{$_}, @expect]}) {}
    default {
      die "$0: line $.: expected " . join("|" => @expect) . "; got\n$_";
    }
  }
}

正如您将在下面看到的，%pattern 是不同格式的命名模式的哈希，given/when 针对Regex 对象数组执行短路搜索以找到第一个匹配项。

由此，您可以推断@expect 是我们希望在当前行中找到的格式名称列表。

有一段时间，我被多种可能的预期格式以及如何知道刚刚匹配的格式所困扰，但后来我想起了正则表达式中的(?{ code })：

这个零宽度断言评估任何嵌入的 Perl 代码。它总是成功，并且它的代码没有被插值。

这允许类似穷人的 yacc 语法。例如要匹配和处理格式1的模式是

fmt1 => qr/^ \*\* DEVICE \s+ (\S+) \s*$
             (?{ $device->{attr1} = $1;
                 @expect = qw< fmt2 >;
               })
          /x,

处理您问题的输入后，$device 包含

{
  'attr1' => '109523.69142',
  'attr2' => '.981',
  'attr3' => '561A',
  'groups' => [
    {
      'date' => '10/MAY/2010',
      'nnn' => [ '24.15.30', '13.45.03' ],
      'records' => [
        [ '05:03:01', 'AB23X', '15.67', '101325.72', '14', '31.30474',  '13', '0' ],
        [ '05:03:15', 'CR22X', '16.72', '101325.42', '14', '29.16264',  '11', '0' ],
        [ '06:23:51', 'AW41X', '15.67', '101323.9',  '14', '31.264932', '19', '0' ],
      ],
    },
    {
      'date' => '11/MAY/2010',
      'nnn' => [ '24.07.13', '13.44.63' ],
      'records' => [
        [ '15:57:14', 'AB23X', '15.67', '101327.23', '14', '31.30474', '13', '0' ],
        [ '15:59:59', 'CR22X', '16.72', '101331.88', '14', '29.16264', '11', '0' ],
      ],
    }
  ],
}

我对这个结果很满意，但出于某种原因，我想到了拉里在 perlstyle 中的建议：

仅仅因为您可以以特定方式做某事并不意味着您应该这样做。

为了完整起见，下面是一个演示结果的工作程序。

#! /usr/bin/perl

use warnings;
use strict;
use feature ':5.10';
use re 'eval';

*ARGV = *DATA;

my $device;
my $record;
my @expect = qw/ fmt1 /;
my %pattern;
%pattern = (
  fmt1 => qr/^ \*\* DEVICE \s+ (\S+) \s*$
               (?{ $device->{attr1} = $1;
                   @expect = qw< fmt2 >;
                 })
            /x,

  fmt2 => qr/^ \s* (\S+) \s+ (\S+) \s*$
               (?{ @{$device}{qw< attr2 attr3 >} = ($1,$2);
                   @expect = qw< fmt3 >;
                 })
            /x,

  # e.g., 10/MAY/2010    24.15.30,13.45.03
  fmt3 => qr/^ (\d\d\/[A-Z]{3}\/\d{4}) \s+ (\S+) \s*$
               (?{ my($date,$nnns) = ($1,$2);
                   push @{ $device->{groups} } =>
                     { nnn  => [ split m|,| => $nnns ],
                       date => $date };
                   @expect = qw< fmt4 >;
                 })
            /x,

  # e.g., 05:03:01   AB23X  15.67   101325.72
  fmt4 => qr/^ (\d\d:\d\d:\d\d) \s+
               (\S+) \s+ (\S+) \s+ (\S+)
               \s*$
               (?{ push @{ $device->{groups}[-1]{records} } =>
                        [ $1, $2, $3, $4 ];
                   @expect = qw< fmt4 fmt5 >;
                 })
            /x,

  # e.g., *           14  31.30474 13        0
  fmt5 => qr/^\* \s+ (\d+) \s+
              # tricky: possibly no whitespace after 9-char float
              ((?=\d{1,7}\.\d+)[\d.]{1,9}) \s*
              (\d+) \s+ (\d+)
              \s*$
              (?{ push @{ $device->{groups}[-1]{records}[-1] } =>
                        $1, $2, $3, $4;
                  @expect = qw< fmt4 fmt3 fmt2 >;
                })
            /x,
);

while (<>) {
  given($_) {
    when (@{[ map $pattern{$_}, @expect]}) {}
    default {
      die "$0: line $.: expected " . join("|" => @expect) . "; got\n$_";
    }
  }
}

use Data::Dumper;
$Data::Dumper::Terse = $Data::Dumper::Indent = 1;
print Dumper $device;

__DATA__
**DEVICE 109523.69142
  .981    561A
10/MAY/2010    24.15.30,13.45.03
05:03:01   AB23X  15.67   101325.72
*           14  31.30474 13        0
05:03:15   CR22X  16.72   101325.42
*           14  29.16264 11        0
06:23:51   AW41X  15.67    101323.9
*           14  31.26493219        0
11/MAY/2010    24.07.13,13.44.63
15:57:14   AB23X  15.67   101327.23
*           14  31.30474 13        0
15:59:59   CR22X  16.72   101331.88
*           14  29.16264 11        0

【讨论】：

+1 以获得完整的示例。是否有必要对取消引用的映射转换 (@{[ map $pattern{$_}, @expect]}) 进行数组引用？ map { $pattern{$_} } @expect 本身还不够吗？
@Zaid 使用朴素的map 会导致程序死掉，抱怨Argument "**DEVICE 109523.69142\n" isn't numeric in smart match …

【解决方案2】：

这是个好问题。我想到了两个建议。

(1) 首先是简单地重申idea from cjm：一个基于对象的状态机。这是一种执行复杂解析的灵活方式。我已经使用了好几次，并且在大多数情况下都对结果感到满意。

(2) 第二个想法属于分而治之的 Unix 管道来预处理数据。

首先对您的数据进行观察：如果一组格式总是成对出现，则它有效地表示一种数据格式，并且可以组合在一起而不会丢失任何信息。这意味着您只有 3 种格式：1+2、3 和 4+5。

这种想法导致了策略。编写一个或两个非常简单的脚本来预处理您的数据——有效地，在真正的解析工作开始之前重新格式化数据以使数据成形。在这里，我将脚本显示为单独的工具。它们可以结合使用，但一般哲学可能表明它们仍然是不同的、狭义的工具。

在 unbreak_records.pl.中

省略 she-bang 并使用严格/警告。

while (<>){
    chomp;
    print /^\*?\s/ ? ' ' : "\n", $_;
}
print "\n";

在 add_record_types.pl 中

while (<>){
    next unless /\S/;
    my $rt = /^\*/ ?   1 :
             /^..\// ? 2 : 3;
    print $rt, ' ', $_;
}

在命令行。

./unbreak_records.pl orig.dat | ./add_record_types.pl > reformatted.dat

输出：

1 **DEVICE 109523.69142   .981    561A
2 10/MAY/2010    24.15.30,13.45.03
3 05:03:01   AB23X  15.67   101325.72 *           14  31.30474 13        0
3 05:03:15   CR22X  16.72   101325.42 *           14  29.16264 11        0
3 06:23:51   AW41X  15.67    101323.9 *           14  31.26493219        0
2 11/MAY/2010    24.07.13,13.44.63
3 15:57:14   AB23X  15.67   101327.23 *           14  31.30474 13        0
3 15:59:59   CR22X  16.72   101331.88 *           14  29.16264 11        0

解析的其余部分很简单。如果您的数据提供者稍微修改格式，您只需要编写一些不同的重新格式化脚本。

【讨论】：

【解决方案3】：

根据你想用它做什么，它可能是一个真正编写正式语法的好地方，例如使用Parse::RecDescent。这将允许您将整个文件提供给解析器，并从中获取数据结构。

【讨论】：

+1 ：这真的很有趣！非常值得研究。如果您可以发布一个示例，我会很高兴（不一定是问题中的示例）。
@Zaid：Parse::RecDescent 的行分隔语法并不是最容易编写的东西。我不得不深入研究代码以获得一些 (s) 和 (s?) 类型规则，甚至接近于为我正在编写的 COBOL 扫描器工作。
如果您需要 Perl 5.10，您还应该查看 Regexp::Grammars，它是 Parse::RecDescent 的继承者。

【解决方案4】：

这听起来像是状态机擅长的事情。在 Perl 中创建状态机的一种方法是作为对象，其中每个状态都是一个方法。该对象为您提供了一个地方来存储您正在构建的结构以及您需要的任何中间状态（例如您正在读取的文件句柄）。

my $state = 'expect_fmt1';
while (defined $state) {
  $state = $object->$state();
}
...
sub expect_fmt1 {
  my $self = shift;
  # read format 1, parse it, store it in object
  return 'expect_fmt2';
}

关于处理在决定如何处理之前必须查看线路的情况的一些想法：

如果文件足够小，您可以将其放入对象中的数组引用中。这使得一个州可以很容易地检查一行而不删除它。

如果文件太大而无法轻松读取，您可以使用一种方法读取下一行以及对象中的缓存，以便您将其放回：

my get_line {
  my $self = shift;
  my $cache = $self->{line_cache};
  return shift @$cache if @$cache;
  return $self->{filehandle}->getline;
}
my unget_line { my $self = shift; unshift @{ $self->{line_cache} }, @_ }

或者，您可以将涉及此决定的状态分成两个状态。第一个状态读取该行，将其存储在$self->{current_line} 中，决定它是什么格式，并返回解析和存储该格式的状态（从$self->{current_line} 获取要解析的行）。

【讨论】：

【解决方案5】：

我会在一个或多个变量中保留一个附加状态，并按行更新。然后你e。 G。知道最后一行是 1 级，还是最后一行是格式 4（您可以期待格式 5），从而为您的处理提供更多安全性。

【讨论】：

我现在正在这样做。我更感兴趣的是替代方法。

【解决方案6】：

在这种情况下，我过去常常做的——如果可能的话——为每一行设置一个唯一的正则表达式。如果格式#2 遵循格式#1 的1 行，那么您可以在1 之后立即应用正则表达式#2。但是对于第一个#2 之后的行，您想尝试#2 或#3。

你也可以有一个组合#2和#3的交替：

my ( $cap2_1, $cap2_2, $cap3_1, $cap3_2 ) = $line =~ /$regex2|regex3/;

如果 #4 紧跟在 3 之后，您需要在 #3 之后应用 regex #4，然后在 regex #5 之后应用。之后，因为它可以是#3 或#4，您可能想要重复多重匹配或与#3/#4 的交替。

while ( <> ) {
    given ( $state ) { 
         when ( 1 ) { my ( $device_num )  = m/$regex1/; $state++; }
         when ( 2 ) { my ( $cap1, $cap2 ) = m/$regex2/; $state++; }
         when ( 3 ) { 
             my ( $cap1, $cap2, $date, $nums ) = m/$regex2|$regex3/;
             $state += $cap1 ? 1 : 2;
         }
    }
}

这种方式为您提供了您可能想做的事情的要点。或者查看FSA::Rules 了解状态管理模块。

【讨论】：