#!/usr/bin/env perl
use warnings; use strict;
my @pools;
my $keys = join('|', sort
'name',
'ttl',
'monitor all',
'preferred',
'partition',
'member'
);
my $pat = qr/^($keys)\s+([^\n]+)\n\z/;
while ( my $line = <DATA> ) {
if ($line =~ /^pool\s+{/ ) {
push @pools, {},
}
elsif (my ($key, $value) = ($line =~ $pat)) {
$value =~ s/^"([^"]+)"\z/$1/;
push @{ $pools[-1]->{$key} }, $value;
}
}
use Data::Dumper;
print Dumper \@pools;
__DATA__
pool {
name "POOL_name1"
ttl 30
monitor all "tcp"
preferred rr
partition "Common"
member 12.24.5.100:80
}
pool {
name "Pool-name2"
ttl 30
monitor all "https_ignore_dwn"
preferred rr
fallback rr
partition "Common"
member 69.241.25.121:8443
member 69.241.25.122:8443
}
Выход:
$VAR1 = [
{
'monitor all' => [
'tcp'
],
'member' => [
'12.24.5.100:80'
],
'ttl' => [
'30'
],
'name' => [
'POOL_name1'
],
'preferred' => [
'rr'
],
'partition' => [
'Common'
]
},
{
'monitor all' => [
'https_ignore_dwn'
],
'member' => [
'69.241.25.121:8443',
'69.241.25.122:8443'
],
'ttl' => [
'30'
],
'name' => [
'Pool-name2'
],
'preferred' => [
'rr'
],
'partition' => [
'Common'
]
}
];
Edit:
Конечно, вы можете проверить элемент-элемент и заполнить элемент по умолчанию, если он не найден. Фактически, имея базовую структуру, вы могли бы сделать это самостоятельно.
Один из способов сделать это - проверить конец записи пула:
while ( my $line = <DATA> ) {
if ($line =~ /^pool\s+{/ ) {
push @pools, {},
}
elsif (my ($key, $value) = ($line =~ $pat)) {
$value =~ s/^"([^"]+)"\z/$1/;
push @{ $pools[-1]->{$key} }, $value;
}
elsif ($line =~ /^\s*}/) {
my $last = $pools[-1];
if ($last and not $last->{member}) {
$last->{member} = [ qw(0.0.0.0) ];
}
}
}