文本处理 - 如何从文件中按顺序获取多个模式

Question 1

以下 perl 脚本在给定示例输入时准确地生成示例输出。

它可能无法完全按照您想要的实际数据文件工作，但它并没有作为完整的工作解决方案呈现。它被作为开始工作的基础 - 玩弄脚本、弄乱它、破坏它、修复它、更改它以执行您想要的操作。

毫无疑问，它远非最佳，但如果没有对输入数据和所需输出更详细的了解/更好的解释，就很难对其进行很大的改进。

它处理每个输入行（也称为“记录”，或使用术语“段”）并构建一个字符串，以便在处理记录后打印出来。每条输出线都是根据您的规格构建的所需数据你问题的部分。

#!/usr/bin/perl

use strict;

while(<>) {
  next unless /AK3/;  # skip lines that don't contain AK3

  # process each "segment" aka "record".
  my @fields = split /~/;

  # get segment "header" and 2nd sub-field of that header.
  my @segment = split(/\*/,$fields[0]);
  my $segment_header = $segment[2];
  shift @fields;

  my $output = "GS: $segment_header -";

  my $groupoutput = ''; # output for a given AK3 "group"
  my $last_go = ''; # used to avoid duplicates like "REF02 REF02 REF02"

  foreach my $f (@fields) {
    my @subfields = split /\*/,$f;

    if ($f =~ m/^AK3/) {

        if (($groupoutput) && ($groupoutput ne $last_go)) {
          $output .= " $groupoutput";
          $last_go = $groupoutput;  # remember the most recent $groupoutput
        };

        $groupoutput = $subfields[1];

    } elsif ($f =~ m/^AK4/) {
        my $ak401 = $subfields[1];
        $groupoutput .= sprintf("%02i,",$ak401) if ($ak401 > 0);
    } elsif ($f =~ m/^AK5/) {
        my $ak502 = $subfields[2];
        $groupoutput .= sprintf("%02i",$ak502) if ($ak502 > 0);
    };
  };

  # append the group output generated since the last seen AK3 (if any)
  # i.e. don't forget to print the final group on the line.
  $output .= " $groupoutput" if (($groupoutput) && ($groupoutput ne $last_go));

  # clean up output string before printing.
  $output =~ s/, / /g;
  $output =~ s/\s*$|,$//;

  print $output, "\n";
}

我将此脚本保存为mysteryprocess.pl因为我想不出更合适的名称。然后我用您的示例数据运行它（在名为的文件中input）：

示例输出：

$ ./mysteryprocess.pl input 
GS: 1036 - TD102,07 TD503 REF02 DTM02,02 CTT
GS: 1037 - HL03

“REF02 REF03 REF02”的事情让我很困扰，所以这里是另一个版本。这个使用一个数组和一个散列（@groups和%groups）来构建输出行，另一个散列（%gseen）通过记住我们已经看到并包含在输出中的值来防止记录中的重复。

组数据存储在中%groups，但散列在中是无序的perl，因此该@groups数组用于记住我们第一次看到特定组的顺序。

顺便说一句，%groups可能应该是一个数组散列，又名 HoA（即每个元素都包含一个数组的散列），这将避免$output在打印之前需要进行清理（通过使用 perl 的join()函数而不是简单地附加逗号和字符串的新值）。但我认为这个脚本对于 perl 新手来说已经足够复杂了。

#!/usr/bin/perl

use strict;

while(<>) {
  next unless /AK3/;  # skip lines that don't contain AK3

  # process each "segment" aka "record".
  my @fields = split /~/;

  # get segment "header" from 1st field,  and then 2nd sub-field of that header.
  # NOTE: "shift" returns the first field of an array AND removes it from
  # the array.
  my @segment = split(/\*/, shift @fields);
  my $segment_header = $segment[2];

  my $output = "GS: $segment_header -";

  my @groups=(); # array to hold each group name (ak301) in the order that
                 # we see them
  my %groups=(); # hash to hold the ak401/ak502 values for each group
  my %gseen =(); # used to avoid dupes by holding specific values of ak301+ak401
                 # and ak301+ak502 that we've seen before.

  my $ak301='';

  foreach my $f (@fields) {
    my @subfields = split /\*/, $f;

    if ($f =~ m/^AK3/) {

        $ak301 = $subfields[1];
        if (!defined($groups{$ak301})) {
          push @groups, $ak301;
        };

    } elsif ($f =~ m/^AK4/) {

        my $ak401 = sprintf("%02i",$subfields[1]);
        $ak401 = '' if ($ak401 == 0);
        next if ($gseen{$ak301.'ak4'.$ak401});

        if (!defined($groups{$ak301})) {
          $groups{$ak301} = $ak401;
        } else {
          $groups{$ak301} .= ',' . $ak401;
        };
        $gseen{$ak301.'ak4'.$ak401}++;

    } elsif ($f =~ m/^AK5/) {

        my $ak502 = sprintf("%02i",$subfields[1]);
        $ak502 = '' if ($ak502 == 0);
        next if ($gseen{$ak301.'ak5'.$ak502});

        if (!defined($groups{$ak301})) {
          $groups{$ak301} = $ak502;
        } else {
          $groups{$ak301} .= ',' . $ak502;
        };
        $gseen{$ak301.'ak5'.$ak502}++;

    };
  };

  # construct the output string in the order we first saw each group
  foreach my $group (@groups) {
    $output .= " $group" . $groups{$group};
  };

  # clean up output string before printing.
  $output =~ s/, |  +/ /g;
  $output =~ s/\s*$|,$//;

  print $output, "\n";
}

通过以下输入

AK2*856*1036~AK3*TD1*4**~AK4*2**1*~AK4*7**1*~AK3*TD5*5**~AK4*3**6*2~AK3*REF*6**~AK4*2**1*~AK3*REF*7**~AK4*2**1*~AK3*REF*8**~AK4*2**1*~AK3*DTM*9**~AK4*2**4*20~AK4*2**4*20~AK3*CTT*12**7~AK5*R
AK2*856*1037~AK3*HL*92**~AK4*3**7*O~AK5*R~AK9*R*2*2*0~SE*25*0001~GE*1*211582~IEA*1*000211582
AK2*856*1099~AK3*TD1*4**~AK4*2**1*~AK4*7**1*~AK3*TD5*5**~AK4*3**6*2~AK3*REF*6**~AK4*2**1*~AK3*REF*7**~AK4*2**1*~AK3*REF*8**~AK4*3**1*~AK3*REF*8**~AK4*2**1*~AK3*DTM*9**~AK4*2**4*20~AK4*2**4*20~AK3*CTT*12**7~AK5*R

现在的输出是：

$ ./mysteryprocess.pl input 
GS: 1036 - TD102,07 TD503 REF02 DTM02 CTT
GS: 1037 - HL03
GS: 1099 - TD102,07 TD503 REF02,03 DTM02 CTT

笔记：

DTM02,02也被塌陷成刚刚DTM02。现在所有的事情都会被消除。
无论元素出现在记录中的哪个位置，也会发生组（即具有相同 AK301“名称”的元素）的合并。之前的版本只合并了邻近的字段/子字段（如果它们相同）。

我不确定这些更改是否是您想要的。

ps：如果您尚未perl安装，此代码将相当容易地转换为awk.这是一个非常简单（甚至简单化）、直接的算法。

Answer