[英]How can I parse runmqsc command output using Perl?
I am trying devise Perl regex to parse command output from IBM's runmqsc utility. 我正在尝试设计Perl regex来解析来自IBM的runmqsc实用程序的命令输出。
Each line of output of interest contains one or more attribute/value pairs with format: "ATTRIBUTE(VALUE)". 感兴趣的每行输出包含一个或多个属性/值对,格式为:“ATTRIBUTE(VALUE)”。 The value for an attribute can be empty, or can contain parenthesis itself.
属性的值可以为空,也可以包含括号本身。 Typically, a maximum of two attribute/value pairs appear on a given line, so the regex is written under this assumption.
通常,给定行上最多出现两个属性/值对,因此正则表达式是在此假设下编写的。
Example input to Perl RE: Perl RE的示例输入:
CHANNEL(TO.IPTWX01) CHLTYPE(CLUSRCVR)
DISCINT(6000) SHORTRTY(10)
TRPTYPE(TCP) DESCR( )
LONGTMR(1200) SCYEXIT( )
CONNAME(NODE(1414)) MREXIT( )
MREXIT( ) CONNAME2(SOME(1416))
TPNAME( ) BATCHSZ(50)
MCANAME( ) MODENAME( )
ALTTIME(00.41.56) SSLPEER()
CONTRIVED() ATTR (00-41-56)
CONTRIVED() DOCTORED()
MSGEXIT( )
I have the following Perl code to capture each attribute/value pair. 我有以下Perl代码来捕获每个属性/值对。
my $resplit = qr/\s+([^\s]+(?:\([^)]*\))?)\s?/;
while ( <IN2> )
{ s/[\s\r\n]+$//;
if ( m/^\s(?:$resplit)(?:$resplit)?$/ )
{ my ($one,$two) = ($1,$2);
print "one: $one, two: $two\n";
}
}
Here's the output when the above code is applied to sample input: 以上代码应用于示例输入时的输出:
one: CHANNEL(TO.IPTWX01), two: CHLTYPE(CLUSRCVR) one: DISCINT(6000), two: SHORTRTY(10) one: TRPTYPE(TCP), two: DESCR( ) one: LONGTMR(1200), two: SCYEXIT( ) one: CONNAME(NODE(1414)), two: MREXIT( ) one: MREXIT( ), two: CONNAME2(SOME(1416)) one: TPNAME( ), two: BATCHSZ(50) one: MCANAME( ), two: MODENAME( ) one: ALTTIME(00.41.56), two: SSLPEER() one: CONTRIVED(), two: ATTR(00-41-56) one: CONTRIVED(), two: DOCTORED() one: MSGEXIT(, two: )
This works great with the exception of the last line in the output above. 除了上面输出中的最后一行之外,这种方法很有用。 I'm really struggling to figure out how to modify the above expression $resplit to capture the last case.
我真的很难弄清楚如何修改上面的表达式$ resplit来捕获最后一种情况。
Can anyone offer any ideas/suggestions on how to make this work or another approach? 任何人都可以提供有关如何使这项工作或其他方法的任何想法/建议?
The Text::Balanced module is designed to handle this sort of problem. Text :: Balanced模块旨在处理此类问题。 This approach will handle any number of columns as well.
这种方法也可以处理任意数量的列。
use strict;
use warnings;
use Text::Balanced qw(extract_bracketed);
my ($extracted, $remainder, $prefix);
while ( defined($remainder = <DATA>) ){
while ( Get_paren_text() ){
$prefix =~ s/ //g;
print $prefix, $extracted, "\n";
}
}
sub Get_paren_text {
($extracted, $remainder, $prefix)
= extract_bracketed($remainder, '()', '[\w ]+');
return defined $extracted;
}
__DATA__
CHANNEL(TO.IPTWX01) CHLTYPE(CLUSRCVR) FOO( ( BAR) )
DISCINT(6000) SHORTRTY(10) BIZZ((((BUZZ) ) ) ) )
TRPTYPE(TCP) DESCR( )
LONGTMR(1200) SCYEXIT( )
CONNAME(NODE(1414)) MREXIT( )
MREXIT( ) CONNAME2(SOME(1416))
TPNAME( ) BATCHSZ(50)
MCANAME( ) MODENAME( )
ALTTIME(00.41.56) SSLPEER()
CONTRIVED() ATTR (00-41-56)
CONTRIVED() DOCTORED()
MSGEXIT( )
I wanted to try to use Regexp::Grammars
. 我想尝试使用
Regexp::Grammars
。
So here it is: 所以这里是:
#! /opt/perl/bin/perl
use strict;
#use warnings;
use 5.10.1;
use Regexp::Grammars;
my $grammar = qr{
<line>
<token: line>
(?: <[pair]> \s* )+
(?{
my $arr = $MATCH{pair};
local $MATCH = {};
for my $pair( @$arr ){
my($key) = keys %$pair;
my($value) = values %$pair;
$MATCH->{$key} = $value;
}
})
<token: pair>
<attrib> \s* \( \s* <value> \s* \)
(?{
$MATCH = {
$MATCH{attrib} => $MATCH{value}
};
})
<token: attrib>
[^()]*?
<token: value>
(?:
<MATCH=pair> |
[^()]*?
)
}x;
use warnings;
my %attr;
while( my $line = <> ){
$line =~ /$grammar/;
for my $key ( keys %{ $/{line} } ){
$attr{$key} = $/{line}{$key};
}
}
use YAML;
say Dump \%attr;
--- ALTTIME: 00.41.56 ATTR: 00-41-56 BATCHSZ: 50 CHANNEL: TO.IPTWX01 CHLTYPE: CLUSRCVR CONNAME: NODE: 1414 CONNAME2: SOME: 1416 CONTRIVED: '' DESCR: '' DISCINT: 6000 DOCTORED: '' LONGTMR: 1200 MCANAME: '' MODENAME: '' MREXIT: '' MSGEXIT: '' SCYEXIT: '' SHORTRTY: 10 SSLPEER: '' TPNAME: '' TRPTYPE: TCP
while ( <IN2> ) {
while ( /([A-Z]+)\s*(\((?:[^()]*+|(?2))*\))/g ) {
print "$1$2\n";
}
}
This works for nested parens eg 这适用于嵌套的parens,例如
CONNAME(NODE(1414, SOME(1416) ) ) ATTR (00-41-56)
The (?2) part is recursive, the *+ means "don't backtrack" - only works in Perl 5.10 or later; (?2)部分是递归的,* +表示“不回溯” - 仅适用于Perl 5.10或更高版本; I got this from http://faq.perl.org/perlfaq6.html#Can_I_use_Perl_regul
我从http://faq.perl.org/perlfaq6.html#Can_I_use_Perl_regul得到了这个
#!/usr/bin/perl
use strict;
use warnings;
my @parsed;
while ( my $line = <DATA> ) {
while ( $line =~ / ([A-Z0-9]+) \s* \( (.*?) \) \s /gx ) {
push @parsed, { $1 => $2 }
}
}
use Data::Dumper;
print Dumper \@parsed;
__DATA__
CHANNEL(TO.IPTWX01) CHLTYPE(CLUSRCVR)
DISCINT(6000) SHORTRTY(10)
TRPTYPE(TCP) DESCR( )
LONGTMR(1200) SCYEXIT( )
CONNAME(NODE(1414)) MREXIT( )
MREXIT( ) CONNAME2(SOME(1416))
TPNAME( ) BATCHSZ(50)
MCANAME( ) MODENAME( )
ALTTIME(00.41.56) SSLPEER()
CONTRIVED() ATTR (00-41-56)
CONTRIVED() DOCTORED()
MSGEXIT( )
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.