Разбор симфонического чата с помощью Perl

Question

Мы перешли с MindAlign на Symphony Chat на работе. Symphony кажется чем-то вроде чат-программы ZenDesk. Мы используем симфонический чат, чтобы распределять билеты людям.

Когда я вырезал и вставил из терминала Symphony, это выглядело так (в нем нет новой строки - это всего лишь одна большая непрерывная строка текста):

16th Jun 2020 7:57:18 am Tom Lewin: WJ: RE: BART failed STP - JIMBCI - INC101981467816th Jun 2020 8:20:38 am Nathan Winslow: II : RE: Loans are experiencing issues sending RUNZ - INC101981521816th Jun 2020 8:57:58 am Nathan Winslow: NW : RE: FW: Missing pool factor PnL [Restricted - Internal] - INC101981603016th Jun 2020 9:13:49 am Nathan Winslow: JK : RE: missing sales credits - INC101981633816th Jun 2020 9:24:26 am Nathan Winslow: KB : RE: Bookbuilder not responding - INC1019816567

Итак, я написал это сценарий, чтобы сформировать его лучше - работает нормально.

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

my $filename = shift @ARGV ;
open(my $fh, '<', $filename) or die "Could not open file 
$filename $!";
while (my $line = <$fh>) {

chomp $line ;
my @words = split /(\d{2}(?:st|nd|rd|th) \w{3} \d{4})/a, $line;

foreach my $word(@words) {
        if($word =~ /\d{2}(?:st|nd|rd|th) \w{3} \d{4}/a) {
        chomp $word ;
        print $word ;
        }
        else {  print "$word\n"; }
    }
}

Это результат. Это нормально, но я трачу слишком много времени на очистку данных.

16th Jun 2020 7:57:18 am Tom Lewin: WJ: RE: BART failed STP - JIMBCI - INC1019814678
16th Jun 2020 8:20:38 am Nathan Winslow: II : RE: Loans are experiencing issues sending RUNZ - INC1019815218
16th Jun 2020 8:57:58 am Nathan Winslow: NW : RE: FW: Missing pool factor PnL [Restricted - Internal] - INC1019816030
16th Jun 2020 9:13:49 am Nathan Winslow: JK : RE: missing sales credits - INC1019816338   
16th Jun 2020 9:24:26 am Nathan Winslow: KB : RE: Bookbuilder not responding - INC1019816567

Это проблема - это результат, который мне нужен:

06/16/2020 WJ: RE: BART failed STP - JIMBCI - INC1019814678
06/16/2020 II : RE: Loans are experiencing issues sending RUNZ - INC1019815218 
06/16/2020 NW : RE: FW: Missing pool factor PnL - INC1019816030
06/16/2020 JK : RE: missing sales credits - INC1019816338
06/16/2020 KB : RE: Bookbuilder not responding - INC1019816567

Я пробовал регулярные выражения и разбиение строк, но это просто большой беспорядок. WJ NW JK KB II это инициалы - они постоянны. Иногда у них есть пробел после двоеточия (:), иногда нет. Однако все, что мне нужно, это Дата и Данные, начиная с Начального и заканчивая последним di git номера билета INC00000000.

Answer 1

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

my @parts = $string =~ /
    ([0-9]+)             # numbers for day
    (?:[^0-9]+)?\s+      # for st|nd|rd|th (optional!), space. not captured
    (\w+)\s+             # month
    ([0-9]+)\s+          # year
    .+?                  # the rest, but only up to the initials 
    ( (?:WJ|NW|JK|KB|II): .+? INC[0-9]+ )
/x; 

Некоторые шаблоны здесь могут быть усилены или ослаблены (например, вместо чередования ожидаемых инициалов мы могли бы иметь [A-Z]+:, с учетом других и большего количества букв).

Затем преобразуйте время в желаемую метку времени. Хороший инструмент для этого - Time :: Piece . Всего

use warnings;
use strict;
use feature 'say';

use Time::Piece;

my $string = q(16th Jun 2020 7:57:18 am Tom Lewin: WJ: RE: BART failed STP - JIMBCI - INC101981467816th Jun 2020 8:20:38 am Nathan Winslow: II : RE: Loans are experiencing issues sending RUNZ - INC101981521816th Jun 2020 8:57:58 am Nathan Winslow: NW : RE: FW: Missing pool factor PnL [Restricted - Internal] - INC101981603016th Jun 2020 9:13:49 am Nathan Winslow: JK : RE: missing sales credits - INC101981633816th Jun 2020 9:24:26 am Nathan Winslow: KB : RE: Bookbuilder not responding - INC1019816567);

my @parts = $string =~ /
    ([0-9]+) (?:[^0-9]+)?\s+ (\w+)\s+ (\w+)\s+ .+? 
    ( (?:WJ|NW|JK|KB|II): .+? INC[0-9]+ )
/x;
#say for @parts;  say '---';

my $dt = Time::Piece->strptime("@parts[0..2]", "%d %b %Y");

say $dt->mdy('/'), ' ', $parts[3];

Последний бит, возможно, лучше сделать как

my $date = Time::Piece
    -> strptime( join(' ', splice @parts, 0, 3), "%d %b %Y")
    -> mdy('/');

say "$date @parts";

, где теперь нам не нужно считать точное количество элементов для печати. ​​

В этом случае @parts в итоге содержит только один элемент, но изменения требований все же происходят. Кроме того, если некоторые элементы на самом деле необходимы как отдельные для других целей (добавьте наборы захватывающих скобок), тогда @parts будет иметь больше элементов.

Они печатают то, что необходимо.

Answer 2

Самый простой способ - "исправить" строку перед ее печатью.

Так что добавьте

use Date::Parse;
sub fix_line {
  my $output = shift;
  if ($output =~ s/^(.*? (am|pm)).*?\s([A-Z]{2} ?:)/$3/) {
     my @date = localtime(str2time($1));
     $output = sprintf("%02d/%02d/%02d %s", @date[4]+1,@date[3],@date[5]-100,$output) ;
  }
  return $output."\n";
}

внизу нашей строки и измените свой внутренний fer-l oop на:

my $nl = '';
foreach my $word(@words) {
   if($word =~ /\d{2}(?:st|nd|rd|th) \w{3} \d{4}/a) {
        chomp $word ;
        $nl.= $word ;
    }
    else {  
         print fix_line("$nl$word");
         $nl=''
    }
}