テキスト処理 - ファイルから複数のパターンを順次インポートする方法

Question

次の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、印刷する前にクリーンアップする必要はありません（join()単にコンマと新しい値を追加する代わりにPerlの機能を使用するだけです）。文字列）。しかし、私はこのスクリプトが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 1