Parsing Результат командной строки командной строки StarTeam

Question

Я пытаюсь написать скрипт Perl, который будет анализировать вывод команды stcmd.exe (клиента командной строки StarTeam). Я получаю историю для каждого файла в представлении и вывод выглядит примерно так:

Folder: The View Name (working dir: C:\Projects\dir) 
History for: main.h 
Description: Some files 
Locked by: 
Status: Current 
---------------------------- 
Revision: 1 View: The View Name Branch Revision: 1.0 
Author: John Smith Date: 3/22/08 11:16:16 AM CST 
Main header 
============================================================================= 

History for: main.c 
Description: Some files 
Locked by: 
Status: Current 
---------------------------- 
Revision: 2 View: The View Name Branch Revision: 1.1 
Author: Jane Doe Date: 3/22/08 1:55:55 PM CST 
Made an update. 

---------------------------- 
Revision: 1 View: The View Name Branch Revision: 1.0 
Author: John Smith Date: 3/22/08 11:16:16 AM CST 
Initial revision 
=============================================================================

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

Я хочу получить имя файла и для каждой ревизии имя автора (первая и последняя), дата и сводка изменений. Я хотел бы разместить эту информацию в структуре данных, где я могу сортировать изменения по дате и комбинировать изменения, если совпадают дата, автор и резюме. (Я думаю, что я могу понять эту часть, если кто-то может помочь мне с разбором.) Я не большим с регулярными выражениями или Perl, но вот что я пытаюсь работать с прямо сейчас:

# $hist contains the stcmd output in the format above 
while($hist =~ /History for: (?<filename>.)/s) 
{ 
    # Record filename somewhere with $+{filename} 

    while($hist =~ /^Revision: (?<file_rev>\S+) View: (?<view_name>.+) Branch Revision: (?<branch_rev>\S+).\nAuthor: (?<author>.*) Date: (?<date>.*) \w+\r\n(?<summary>.*)/) 
    { 
     # Extract things with $+{author}, $+{date}, $+{summary} 
    } 
} 

Однако это не работает. Насколько я знаю, я могу приблизиться к этому совершенно неправильно. Может ли кто-нибудь указать мне в правильном направлении?

Answer 1

Ключ для разбора один кусок за один раз и соответствовать все необходимые вещи сразу. См. qr in perldoc perlop и $/ in perldoc perlvar.

Принимая во внимание тот факт, что вы также хотели разместить информацию в структуре данных, которая позволит вам запрашивать и обрабатывать информацию, вот окончательная редакция. В приведенном ниже коде используется способность SQLite создавать базы данных в памяти. Возможно, вы захотите разделить функциональность на два сценария: один для разбора и хранения данных, а другой - для любых необходимых манипуляций. Фактически, в SQL можно было бы сделать все необходимые манипуляции.

#!/usr/bin/perl 
use v5.010; 
use strict; use warnings; 
use DBI; 

my $dbh = get_dbh(); 

my $header_pattern = qr{ 
    History[ ]for:  [ ](?<filename>[^\n]+)   \n 
    Description:  [ ](?<description>[^\n]+)  \n 
    Locked[ ]by:  [ ]?(?<lockedby>[^\n]*)  \n 
    Status:   [ ](?<status>.[^\n]+)   \n 
}x; 

my $revision_pattern = qr{-+\n 
    Revision:   [ ](?<revision>\d+)   [ ] 
    View:    [ ](?<view>.+)    [ ] 
    Branch[ ]Revision: [ ](?<branch_revision>[^\n]+) \n 
    Author:   [ ](?<author>.+)    [ ] 
    Date:    [ ](?<revdate>[^\n]+)   \n 
    (?<summary>.*)         \n 
}x; 

local $/ = '=' x 77 . "\n"; 

while (my $entry = <>) { 
    if ($entry =~ $header_pattern) { 
     my %file = %+; 
     $dbh->do(sprintf(
       q{INSERT INTO files (%s) VALUES (%s)}, 
       join(',', keys %file), 
       join(',', ('?') x keys %file), 
      ), {}, values %file); 

     while ($entry =~ /$revision_pattern/g) { 
      my %rev = %+; 
      $dbh->do(sprintf(
        q{INSERT INTO revisions (%s) VALUES (%s)}, 
        join(',', filename => keys %rev), 
        join(',', ('?') x (1 + keys %rev)), 
       ), {}, $file{filename}, values %rev); 
     } 
    } 
} 

my $revs = $dbh->selectall_arrayref(
    q{SELECT * FROM revisions JOIN files 
    ON files.filename = revisions.filename}, 
    { Slice => {} } 
); 

use Data::Dumper; 
print Dumper $revs; 

sub get_dbh { 
    my $dbh = DBI->connect(
     'dbi:SQLite:dbname=:memory:', undef, undef, 
     { RaiseError => 1, AutoCommit => 1 } 
    ); 

    $dbh->do(q{PRAGMA foreign_keys = ON}); 
    $dbh->do(q{CREATE TABLE files (
      filename VARCHAR PRIMARY KEY, 
      description VARCHAR, 
      lockedby VARCHAR, 
      status  VARCHAR 
    )}); 
    $dbh->do(q{CREATE TABLE revisions (
      filename  VARCHAR, 
      revision  VARCHAR, 
      view   VARCHAR, 
      branch_revision VARCHAR, 
      author   VARCHAR, 
      revdate   VARCHAR, 
      summary   VARCHAR, 
      CONSTRAINT pk_revisions PRIMARY KEY (filename, revision), 
      CONSTRAINT fk_revisions_files FOREIGN KEY (filename) 
      REFERENCES files(filename) 
    )}); 

    return $dbh; 
} 

Выход:

C:\Temp> y.pl test.txt 
$VAR1 = [ 
      { 
      'status' => 'Current', 
      'revdate' => '3/22/08 11:16:16 AM CST', 
      'author' => 'John Smith', 
      'description' => 'Some files', 
      'revision' => '1', 
      'filename' => 'main.h', 
      'summary' => 'Main header', 
      'view' => 'The View Name', 
      'branch_revision' => '1.0', 
      'lockedby' => '' 
      }, 
      { 
      'status' => 'Current', 
      'revdate' => '3/22/08 1:55:55 PM CST', 
      'author' => 'Jane Doe', 
      'description' => 'Some files', 
      'revision' => '2', 
      'filename' => 'main.c', 
      'summary' => 'Made an update.', 
      'view' => 'The View Name', 
      'branch_revision' => '1.1', 
      'lockedby' => '' 
      }, 
      { 
      'status' => 'Current', 
      'revdate' => '3/22/08 11:16:16 AM CST', 
      'author' => 'John Smith', 
      'description' => 'Some files', 
      'revision' => '1', 
      'filename' => 'main.c', 
      'summary' => 'Initial revision', 
      'view' => 'The View Name', 
      'branch_revision' => '1.0', 
      'lockedby' => '' 
      } 
     ];

Answer 2

Вот один из способов начать работу. Я предпочитаю, чтобы разделить вашу строку на строки (\n) и цикл через те:

use strict; 
use warnings; 

my $hist = <<'EOF'; 
Folder: The View Name (working dir: C:\Projects\dir) 
History for: main.h 
Description: Some files 
Locked by: 
Status: Current 
---------------------------- 
Revision: 1 View: The View Name Branch Revision: 1.0 
Author: John Smith Date: 3/22/08 11:16:16 AM CST 
Main header 
============================================================================= 

History for: main.c 
Description: Some files 
Locked by: 
Status: Current 
---------------------------- 
Revision: 2 View: The View Name Branch Revision: 1.1 
Author: Jane Doe Date: 3/22/08 1:55:55 PM CST 
Made an update. 

---------------------------- 
Revision: 1 View: The View Name Branch Revision: 1.0 
Author: John Smith Date: 3/22/08 11:16:16 AM CST 
Initial revision 
============================================================================= 
EOF 

my %data; 
my $filename; 
for (split /\n/, $hist) { 
    if (/History for: (.*)/) { 
     $filename = $1; 
    } 
    if (/^Revision: (.+?) View: (.+?) Branch Revision: (.*)/) { 
     $data{$filename}{rev} = $1; 
     $data{$filename}{view} = $2; 
     $data{$filename}{branch} = $3; 
    } 
} 

use Data::Dumper; print Dumper(\%data); 

__END__ 

$VAR1 = { 
      'main.h' => { 
         'view' => 'The View Name', 
         'rev' => '1', 
         'branch' => '1.0' 
         }, 
      'main.c' => { 
         'view' => 'The View Name', 
         'rev' => '1', 
         'branch' => '1.0' 
         } 
     }; 

Answer 3

Вам нужен основе состояния синтаксического анализа. С раздела __DATA__, как и раньше:

use v5.010; 
use constant 
    { READING_FOR_FILENAME => 0 
    , READING_FOR_AUTHOR => 1 
    , READING_FOR_DIVIDER => 2 
    }; 

use strict; 
use warnings; 
use English qw<%LAST_PAREN_MATCH>; 
use Data::Dumper; 

my $state = READING_FOR_FILENAME; 
my %history_for; 
my $file_name; 
while (<DATA>) { 
    my $line = $_; 
    given ($state) { 
     when (READING_FOR_FILENAME) { 
      if ($line =~ m/^History for: (?<file_name>\S+)/) { 
       $file_name = $LAST_PAREN_MATCH{file_name}; 
       $state  = READING_FOR_DIVIDER; 
      } 
     } 
     when (READING_FOR_DIVIDER) { 
      if ($line =~ m/^-+\s*$/) { 
       $state = READING_FOR_AUTHOR; 
      } 
      elsif ($line =~ m/^=+\s*$/) { 
       $state = READING_FOR_FILENAME; 
      } 
     } 
     when (READING_FOR_AUTHOR) { 
      if ($line =~ m/^Author: (?<author>[^:]+?) Date: (?<time>.*)/) { 
       push @{ $history_for{$file_name} } 
        , { name => $LAST_PAREN_MATCH{author} 
        , time => $LAST_PAREN_MATCH{time} 
        }; 
       $state = READING_FOR_DIVIDER; 
      } 
     } 
    } 
} 
print Dumper(\%history_for); 

Answer 4

У вас есть какие-то хорошие ответы уже. Вот другой способ разделить работу:

use strict; 
use warnings; 
use Data::Dumper qw(Dumper); 

# Read file a section at a time. 
$/ = '=' x 77 . "\n"; 

my @data; 
while (my $section = <>){ 
    # Split each section into sub-sections, the 
    # first containing the file info and the rest 
    # containing info about each revision. 
    my @revs = split /-{20,}\n/, $section; 

    # Do whatever you want with @file_info and, below, @ref_info. 
    # The example here splits them apart into lines. 
    # Alternatively, you could run the sub-sections through 
    # regex parsing, as in Sinan's answer. 
    my @file_info = parse_lines(shift @revs); 
    push @data, { file_info => \@file_info }; 

    for my $r (@revs){ 
     my @rev_info = parse_lines($r); 
     push @{$data[-1]{revs}}, \@rev_info; 
    } 
} 

sub parse_lines { 
    # Parse each sub-section into lines. 
    my @lines = split /\n/, shift; 
    # Optionally, filtering out unwanted material. 
    @lines = grep { /\S/ and $_ !~ /={70,}/ } @lines; 
    # And perhaps splitting lines into their key-value components. 
    @lines = map { [split /:\s*/, $_, 2] } @lines; 
    return @lines; 
} 

print Dumper(\@data);