Как я могу проанализировать вывод команды runmqsc, используя Perl?

Question

Я пытаюсь разработать регулярное выражение Perl для анализа вывода команды из утилиты IBM runmqsc.

Каждая интересующая строка содержит одну или несколько пар атрибут / значение в формате: «ATTRIBUTE (VALUE)». Значение атрибута может быть пустым или содержать саму скобку. Как правило, в данной строке появляется максимум две пары атрибут / значение, поэтому регулярное выражение записывается в соответствии с этим предположением.

Пример ввода в 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( )   

У меня есть следующий код Perl для захвата каждой пары атрибут / значение.

Код 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";  
  }  
} 

Вот вывод, когда вышеуказанный код применяется к вводу образца:

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: )   

Это прекрасно работает, за исключением последней строки в выводе выше. Я действительно изо всех сил пытаюсь выяснить, как чтобы изменить вышеприведенное выражение $ resplit, чтобы захватить последний случай.

Может кто-нибудь предложить какие-либо идеи / предложения о том, как сделать эту работу или другой подход?

Answer 1

Модуль Text :: Balanced предназначен для решения подобных проблем. Этот подход будет обрабатывать любое количество столбцов.

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( )

Answer 2

Я хотел попробовать использовать Regexp::Grammars.

Итак, вот оно:

#! /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

Answer 3

while ( <IN2> ) {
    while ( /([A-Z]+)\s*(\((?:[^()]*+|(?2))*\))/g ) {
        print "$1$2\n";
    }
}

Это работает для вложенных паренов, например.

CONNAME(NODE(1414, SOME(1416) ) )           ATTR (00-41-56)

Часть (? 2) является рекурсивной, * + означает «не возвращаться» - работает только в Perl 5.10 или более поздней версии; Я получил это от http://faq.perl.org/perlfaq6.html#Can_I_use_Perl_regul

Answer 4

#!/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( )