我无法让解析器正确返回我想要的结果。现在我刚开始解析一个基本的字符串,但我最终想要获得完整的 ACL。我借用了一些我在网上找到的为 Cisco ASA 执行此操作的代码,但他的场景与我的略有不同,所以我无法使用该代码。
最终我希望能够匹配一些字符串,如下所示:
permit ip any 1.2.0.0 0.0.255.255
permit ip host 1.2.3.4 1.2.3.4 0.0.0.31
deny ip 138.145.211.0 0.0.0.255 any log-input
etc...
这是代码:
解析器.pm
package AccessList::Parser;
use 5.008008;
use strict;
use warnings;
use Carp;
use Parse::RecDescent;
our $VERSION = '0.05';
sub new {
my ($class) = @_;
my $self = { PARSER => undef, };
bless $self, $class;
$self->_init();
return $self;
}
sub _init {
my ($self) = @_;
$self->{PARSER} = Parse::RecDescent->new( $self->_grammar() );
}
sub parse {
my ( $self, $string ) = @_;
defined ($string) or confess "blank line received";
my $tree = $self->{PARSER}->acl_action($string);
defined($tree) or confess "unrecognized line\n";
return $tree;
}
sub _grammar {
my ($self) = @_;
my $grammar = q{
<autotree>
acl_action : "permit" | "deny"
acl_protocol :
PROTOCOL EOL
| <error>
PROTOCOL :
/\d+/ | "ah" | "eigrp" | "esp" | "gre" | "icmp" | "icmp6" | "igmp"
| "igrp" | "ip" | "ipinip" | "ipsec" | "nos" | "ospf" | "pcp"
| "pim" | "pptp" | "snp" | "tcp" | "udp"
EOL :
/$/
};
return $grammar;
}
1;
我的测试:parse.t
use strict;
use warnings;
use Scalar::Util 'blessed';
use Test::More tests => 2;
use AccessList::Parser;
my $parser = AccessList::Parser->new();
ok( defined($parser), "constructor" );
my $string;
my $tree;
my $actual;
my $expected;
#
# Access list 1
#
$string = q{permit ip};
$tree = $parser->parse($string);
$actual = visit($tree);
$expected = {
'acl_action' => 'permit',
'acl_protocol' => 'ip',
};
is_deeply($actual, $expected, "whatever");
#
# Finished tests
#
sub visit {
my ($node) = @_;
my $Rule_To_Key_Map = {
"acl_action" => 1,
"acl_protocol" => 1
};
my $parent_key;
my $result;
# set s of explored vertices
my %seen;
#stack is all neighbors of s
my @stack;
push @stack, [ $node, $parent_key ];
my $key;
while (@stack) {
my $rec = pop @stack;
$node = $rec->[0];
$parent_key = $rec->[1]; #undef for root
next if ( $seen{$node}++ );
my $rule_id = ref($node);
if ( exists( $Rule_To_Key_Map->{$rule_id} ) ) {
$parent_key = $rule_id;
}
foreach my $key ( keys %$node ) {
next if ( $key eq "EOL" );
my $next = $node->{$key};
if ( blessed($next) ) {
if ( exists( $next->{__VALUE__} ) ) {
#print ref($node), " ", ref($next), " ", $next->{__VALUE__},"\n";
my $rule = ref($node);
my $token = $next->{__VALUE__};
$result->{$parent_key} = $token;
#print $rule, " ", $result->{$rule}, "\n";
}
push @stack, [ $next, $parent_key ];
#push @stack, $next;
}
}
}
return $result;
}