regex - 解析 StarTeam 命令行客户端输出

Question

我正在尝试编写一个 Perl 脚本来解析 stcmd.exe(StarTeam 命令行客户端)hist 命令的输出。我正在获取 View 中每个文件的历史记录，输出如下所示:

Folder: The View Name  (working dir: C:\Projects\dir)History for: main.hDescription: Some filesLocked by:Status: Current----------------------------Revision: 1 View: The View Name Branch Revision: 1.0Author: John Smith Date: 3/22/08 11:16:16 AM CSTMain header=============================================================================History for: main.cDescription: Some filesLocked by:Status: Current----------------------------Revision: 2 View: The View Name Branch Revision: 1.1Author: Jane Doe Date: 3/22/08 1:55:55 PM CSTMade an update.----------------------------Revision: 1 View: The View Name Branch Revision: 1.0Author: John Smith Date: 3/22/08 11:16:16 AM CSTInitial revision=============================================================================

Note that the revision summary can contain newlines and can be blank (in which case there's no line for it at all).

I want to get the filename and, for each revision, the author name (first and last), date, and change summary. I'd like to place this information in a data structure where I can sort revisions by date and combine revisions if the date, author, and summary match up. (I think I can figure this part out if someone can help me with the parsing.) I'm not great with regular expressions or Perl, but here's what I'm trying to work with right now:

# $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

关键是一次解析一个 block 并一次匹配所有相关的东西。参见 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' => ''          }        ];