How can I extract blocks from this configuration file using Perl? - regex

Question

I am trying to search through a Load Balancer config and extract some data. The configuration file looks like this
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
}
I am trying to assign each pool config to it's own array, so I can loop through the array to find specific IP addresses and pool names. I tried the following regex, but its not working.
my #POOLDATA = <FILE>;
close FILE;
foreach (#POOLDATA) {
if (/^pool\s\{\s/ .. /^\}\s/) {
push (#POOLCONFIG, "$_");
}
}
Does anyone have a suggestion on how to separate each pool config into its own array? (or a better suggestion) Thank you in advance for your help

Answer 1

#!/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
}
Output:
$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:
Of course, you can check for a member element, and fill in a default one if it isn't found. In fact, with the basic structure in place, you should have been able to do that yourself.
One way to do it is to check for the end of a pool record:
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) ];
}
}
}

Answer 2

As Sinan Unur recommended, you can store a reference to a hash in your array. That way, each element of your array is a hash.
By the way, Sinan's data structure is a bit more complex: You have an array of pools. Each pool is a hash with a key that's the value of the name of the pool element, and a reference to an array. This way, each element in the pool could have multiple values (like your IP addresses do).
My only comment is that I might use a hash for storing the pools, and key it by IP address. That is, assuming that an IP address is unique to a particular pool. That way, you can easily pull up a pool by the IP address without having to search. I would also keep a parallel structure by pool name for the same reason. (And, since each pool is a reference, storing the pool by both IP address and name wouldn't take up that much extra memory. And, updating one would update the other automatically).
If you're not familiar with Perl references, or how to create an array or hashes, or a hash of arrays, you can take a look at the following Perl tutorials:
perlretut - Mark's very short tutorial about references
perldsc - Perl Data Structures Cookbook
Once you get the hang of using multilayered Perl structures, you can quickly learn how to use object oriented design in your Perl scripts, and make maintaining these structures very easy to do.

Answer 3

Just another way to look at it. This one handles the multiple member fields, specially.
use strict;
use warnings;
use Data::Dumper;
use English qw<$RS>;
use List::MoreUtils qw<natatime>;
use Params::Util qw<_ARRAY _CODE>;
# Here, we rig the record separator to break on \n}\n
local $RS = "\n}\n";
# Here, we standardize a behavior with hash duplicate keys
my $TURN_DUPS_INTO_ARRAYS = sub {
my ( $hr, $k, $ov, $nv ) = #_;
if ( _ARRAY( $ov )) {
push #{ $ov }, $nv;
}
else {
$h->{ $k } = [ $ov, $nv ];
}
};
# Here is a generic hashing routine
# Most of the work is figuring out how the user wants to store values
# and deal with duplicates
sub hash {
my ( $code, $param_name, $store_op, $on_duplicate );
while ( my ( $peek ) = #_ ) {
if ( $code = _CODE( $peek )) {
last unless $param_name;
if ( $param_name eq 'on_dup' ) {
$on_duplicate = shift;
}
elsif ( $param_name eq 'store' ) {
$store_op = shift;
}
else {
last;
}
undef $code;
}
else {
my #c = $peek =~ /^-?(on_dup|store$)/;
last unless $param_name = $c[0];
shift;
}
}
$store_op ||= sub { $_[0]->{ $_[1] } = $_[3]; };
$on_duplicate ||= $code || $store_op;
my %h;
while ( #_ ) {
my $k = shift;
next unless defined( my $v = shift );
(( exists $h{ $k } and $on_duplicate ) ? $on_duplicate
: $store_op
)->( \%h, $k, $h{ $k }, $v )
;
}
return wantarray ? %h : \%h;
}
my %pools;
# So the loop is rather small
while ( <DATA> ) {
# remove pool { ... } brackets
s/\A\s*pool\s+\{\s*\n//smx;
s/\n\s*\}\n*//smx;
my $h
= hash( -on_duplicate => $TURN_DUPS_INTO_ARRAYS
, map { s/"$//; s/\s+$//; $_ }
map { split /\s+"|\s{2,}/msx, $_, 2 }
split /\n/m
);
$pools{ $h->{name} } = $h;
}
print Dumper( \%pools );
### %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
}
Just a note about the hash function, I had noticed a high number of posts recently about hashes that handle duplicates. This is a general solution.