텍스트 처리 - 파일에서 여러 패턴을 순차적으로 가져오는 방법

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인쇄하기 전에 정리할 필요가 없습니다( 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 "이름"을 가진 요소)은 요소가 레코드에 나타나는 위치에 관계없이 발생합니다. 이전 버전만 병합되었습니다.가까운필드/하위 필드가 동일한 경우.

이러한 변경 사항이 귀하가 원하는 것인지 확실하지 않습니다.

추신: 아직 설치하지 않은 경우 perl이 코드는 매우 쉽게 awk.

Answer