Perl находит правильные пары линий между различными случаями

Question

У меня есть запрос HTTP-заголовка и данные ответа в форме с разделителями табуляции с каждым GET/POST и ответом в разных строках. Эти данные таковы, что существует несколько GET, POST и REPLY для одного потока TCP. Из этих случаев мне нужно выбрать только первую действительную пару GET-REPLY. Пример (упрощенный) является:

ID  Source Dest Bytes Type Content-Length host    lines.... 
1   A   B  10  GET  NA   yahoo.com   2 
1   A   B  10  REPLY  10   NA     2 
2   C   D  40  GET  NA   google.com   4 
2   C   D  40  REPLY  20   NA     4 
2   C   D  40  GET  NA   google.com   4 
2   C   D  40  REPLY  30   NA     4 
3   A   B  250 POST  NA   mail.yahoo.com  5 
3   A   B  250 REPLY  NA   NA     5 
3   A   B  250 REPLY  15   NA     5 
3   A   B  250 GET  NA   yimg.com    5 
3   A   B  250 REPLY  35   NA     5 
4   G   H  415 REPLY  10   NA     6 
4   G   H  415 POST  NA   facebook.com   6 
4   G   H  415 REPLY  NA   NA     6 
4   G   H  415 REPLY  NA   NA     6 
4   G   H  415 GET  NA   photos.facebook.com 6 
4   G   H  415 REPLY  50   NA     6 

.... 

Таким образом, в основном мне нужно, чтобы получить один запрос-ответ пару для каждого ID и записать их в новый файл.

Для «1» это всего лишь одна пара, так что это легко. Но есть также ложные случаи, когда обе строки являются GET, POST или REPLY. Итак, такие случаи игнорируются.

Для «2» я выбрал бы первую пару GET-REPLY.

Для «3» я выбрал бы первый GET, а второй REPLY, поскольку Content-Length отсутствует в первом (что делает более подходящим кандидатом).

Для «4» я выбрал бы первый POST (или GET), поскольку первый заголовок не может ОТКАЗАТЬСЯ. Я бы не выбрал REPLY после второго GET, даже если длина содержимого отсутствует в сообщениях после POST., После чего появляется REPLY. Поэтому я бы выбрал первый ОТВЕТ.

Итак, выбирая лучшую пару запроса и ответа, мне нужно соединить их в одну строку. Для примера, на выходе будет:

ID  Source Dest Bytes Type Content-Length host   .... 
    1   A   B  10  GET  10   yahoo.com 
    2   C   D  40  GET  20   google.com 
    3   A   B  250 POST  15   mail.yahoo.com 
    4   G   H  415 POST  NA   facebook.com 

Есть много других заголовков в фактических данных, но этот пример довольно много показывает, что мне нужно. Как это сделать в Perl? Я в значительной степени застрял в начале, поэтому мне удалось прочитать файл по одной строке за раз.

open F, "<", "file.txt" || die "Cannot open $f: $!"; 

    while (<F>) { 
    chomp; 
    my @line = split /\t/; 


     # get the valid pairs for cases with multiple request - replies 


     # get the paired up data together 

    } 
    close (F); 

* Edit: я добавил дополнительный столбец дает количество HTTP заголовков для каждого идентификатора. Это может помочь узнать, сколько последующих строк необходимо проверить. Кроме того, я изменил ID '4', так что первая строка заголовка - REPLY. *

Answer 1

Программа ниже делает то, что, по вашему мнению, вам нужно.

Прокомментировано, и я думаю, что это довольно разборчиво. Пожалуйста, спросите, что-то неясно.

use strict; 
use warnings; 

use List::Util 'max'; 

my $file = $ARGV[0] // 'file.txt'; 
open my $fh, '<', $file or die qq(Unable to open "$file" for reading: $!); 

# Read the field names from the first line to index the hashes 
# Remember where the data in the file starts so we can get back here 
# 
my @fields = split ' ', <$fh>; 
my $start = tell $fh; 

# Build a format to print the accumulated data 
# Create a hash that relates column headers to their widths 
# 
my @headers = qw/ ID Source Dest Bytes Type Content-Length host /; 
my %len = map { $_ => length } @headers; 

# Read through the file to find the maximum data width for each column 
# 
while (<$fh>) { 
    my %data; 
    @data{@fields} = split; 
    next unless $data{ID} =~ /^\d/; 
    $len{$_} = max($len{$_}, length $data{$_}) for @headers; 
} 

# Build a format string using the values calculated 
# 
my $format = join ' ', map sprintf('%%%ds', $_), @len{@headers}; 
$format .= "\n"; 

# Go back to the start of the data 
# Print the column headers 
# 
seek $fh, $start, 0; 
printf $format, @headers; 

# Build transaction data hashes into $record and print them 
# Ignore any events before the first request 
# Ignore the second request and anything after it 
# Update the stored Content-Length field if a value other than NA appears 
# 
my $record; 
my $nreq = 0; 

while (<$fh>) { 

    my %data; 
    @data{@fields} = split; 
    my ($id, $type) = @data{ qw/ ID Type/}; 
    next unless $id =~ /^\d/; 

    if ($record and $id ne $record->{ID}) { 
    printf $format, @{$record}{@headers}; 
    undef $record; 
    $nreq = 0; 
    } 

    if ($type eq 'GET' or $type eq 'POST') { 
    $record = \%data if $nreq == 0; 
    $nreq++; 
    } 
    elsif ($nreq == 1) { 
    if ($record->{'Content-Length'} eq 'NA' and $data{'Content-Length'} ne 'NA') { 
     $record->{'Content-Length'} = $data{'Content-Length'}; 
    } 
    } 
} 

printf $format, @{$record}{@headers} if $record; 

выход

с данными, приведенными в этом вопросе, эта программа производит

ID Source Dest Bytes Type Content-Length     host 
1  A  B  10  GET    10    yahoo.com 
2  C  D  40  GET    20   google.com 
3  A  B  250 POST    15  mail.yahoo.com 
4  G  H  415 POST    NA   facebook.com 

Answer 2

Это похоже на работу по данному данных:

#!/usr/bin/env perl 
use strict; 
use warnings; 

# Shape of input records 
use constant ID  => 0; 
use constant Source => 1; 
use constant Dest  => 2; 
use constant Bytes => 3; 
use constant Type  => 4; 
use constant Length => 5; 
use constant Host  => 6; 

use constant fmt_head => "%-6s %-6s %-6s %-6s %-6s %-6s %s\n"; 
use constant fmt_data => "%-6d %-6s %-6s % 6d %-6s % 6s %s\n"; 

printf fmt_head, "ID", "Source", "Dest", "Bytes", "Type", "Length", "Host"; 

my @post_get; 
my @reply; 
my $lastid = -1; 
my $pg_count = 0; 

sub print_data 
{ 
    # Final validity checking 
    if ($lastid != -1) 
    { 
     printf fmt_data, $post_get[ID], $post_get[Source], 
       $post_get[Dest], $post_get[Bytes], $post_get[Type], $reply[Length], $post_get[Host]; 
     # Reset arrays; 
     @post_get =(); 
     @reply =(); 
     $pg_count = 0; 
    } 
} 

while (<>) 
{ 
    chomp; 
    my @record = split; 
    # Validate record here (number of fields, etc) 
    # Detect change in ID 
    print_data if ($record[ID] != $lastid); 
    $lastid = $record[ID]; 

    if ($record[Type] eq "REPLY") 
    { 
     # Discard REPLY if there wasn't already a POST/GET 
     next unless defined $post_get[ID]; 
     # Discard REPLY if there was a second POST/GET 
     next if $pg_count > 1; 
     @reply = @record if !defined $reply[ID]; 
     $reply[Length] = $record[Length] 
         if $reply[Length] eq "NA" && $record[Length] ne "NA"; 
    } 
    else 
    { 
     $pg_count++; 
     @post_get = @record if !defined $post_get[ID]; 
     $post_get[Length] = $record[Length] 
          if $post_get[Length] eq "NA" && $record[Length] ne "NA"; 
    } 
} 
print_data; 

Это производит:

ID Source Dest Bytes Type Content-Length    host 
1  A  B  10 GET    10  yahoo.com 
2  C  D  40 GET    20  google.com 
3  A  B  250 POST    15 mail.yahoo.com 
4  G  H  415 POST    NA  facebook.com 

Основное отклонение от вопроса о замене 'Длина' для «Content-Length «; исправление легко, если достаточно, если необходимо, — изменить 6-ю длину в fmt_data и fmt_head на длину 14, и сменить "Length" на "Content-Length".