O seguinte script perl produz sua saída de exemplo exatamente quando recebe sua entrada de amostra.
Pode não funcionar exatamente como você deseja em seu arquivo de dados real, mas não está sendo apresentado como uma solução de trabalho completa. Ele é apresentado como uma base para começar a trabalhar - jogue com o script, mexa nele, divida, corrija, mude para fazer o que quiser.
Está, sem dúvida, longe do ideal, mas seria difícil melhorar muito sem um conhecimento muito mais detalhado / melhor explicação de seus dados de entrada e sua saída necessária.
Ele processa cada linha de entrada (também conhecida como "registro" ou "segmento" usando sua terminologia) e cria uma cadeia para ser impressa depois que o registro é processado. Cada linha de saída é criada de acordo com suas especificações na seção Dados necessários de sua pergunta.
#!/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";
}
Salvei este script como mysteryprocess.pl porque não consegui pensar em um nome mais apropriado. Então eu corri com seus dados de amostra (em um arquivo chamado input ):
:
$ ./mysteryprocess.pl input
GS: 1036 - TD102,07 TD503 REF02 DTM02,02 CTT
GS: 1037 - HL03
Essa coisa "REF02 REF03 REF02" me incomodou, então aqui está outra versão. Este usa uma matriz e um hash ( @groups e %groups ) para construir a linha de saída e outro hash ( %gseen ) para evitar erros dentro de um registro, lembrando valores que já vimos e incluímos em a saída.
Os dados dos grupos são armazenados em %groups , mas os hashes são desordenados em perl , então o array @groups é usado para lembrar a ordem em que vimos um grupo em particular pela primeira vez.
BTW, %groups provavelmente deve ser um hash-de-arrays, conhecido como HoA (ou seja, um hash que contém um array em cada elemento), evitando a necessidade de limpar $output antes de imprimi-lo (usando A função join() do perl, em vez de simplesmente anexar uma vírgula e o novo valor às cadeias de caracteres). Mas eu acho que esse script já é complicado o bastante para um novato entender.
#!/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";
}
Com a seguinte entrada
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
A saída é agora:
$ ./mysteryprocess.pl input
GS: 1036 - TD102,07 TD503 REF02 DTM02 CTT
GS: 1037 - HL03
GS: 1099 - TD102,07 TD503 REF02,03 DTM02 CTT
Notas:
-
DTM02,02também foi recolhido em apenasDTM02. A eliminação do dupe acontece para tudo agora. - A mesclagem de grupos (ou seja, elementos com o mesmo nome "AK301") também ocorre, não importa em que lugar do registro um elemento apareça. A versão anterior só mesclava campos / subcampos adjacentes se fossem os mesmos.
Não tenho certeza se uma dessas alterações é o que você deseja.
ps: se você não tiver perl instalado, esse código será traduzido com bastante facilidade para awk . É um algoritmo simples (simplista, simples) e direto.