checking the string against all values of multidimension hashmap in perl - perl

Question

I have the below requirements
Read the sample data file /tmp/user_defined_connection.ini
MANAGEMENT=IDL||CIDL
NORTH=IDL,NORTHERN||VIDL,NORTH||IDL,NORTH
SOUTH=IDL,SOUTHERN||CIDL,SOUTH||IDL,SOUTH
Each Key here can have the multiple such values ',' signifies an AND operations and '||' is an OR operation
I need to check this against another string $instance and for each value , so I take the first key MANAGEMENT and get its values and check against isntance ....
$instance contains IDL or CIDL
In next iteration same instance will be checked against the second key which is NORTH and if true the function should return NORTH so basically I need to check the instance against each value one by one and then return the key which i find the last... below is the code written till now
#!/sbin/perl -w
use strict;
use Data::Dumper;
my #providerCloudSequence;
my %idlcodes;
open(my $iniFH, '<', '/tmp/user_defined_connection.ini')
or die "Unable to open file:$!\n";
while(<$iniFH>) {
chomp;
my #providerCloudClass = split('=',$_);
push #providerCloudSequence, $providerCloudClass[0];
if ($#) {
print "Script Failed to get the Sequence....Exiting the Script\n";
exit 1;
}
#my %idlcodes = map { split /=|\s+/; } <$iniFH>;
my ($k, #r) = split /=|\Q||/;
$idlcodes{$k} = [ map [ split /,/ ], #r ];
}
if($#){
print "Script Failed to create the hash....Exiting the Script\n";
exit 1;
}
close $iniFH;
print Dumper \%idlcodes;
my #interfaceSampleAliases = { "AFGHD_NORTH",
"NORTHERN_IIDID_IPV123",
"IDL_SOUTH",
"IDL_SOUTH_IUID",
"SOUTHERN_IND_IPV" };
foreach (#interfaceSampleAliases){
my $correctKey = getCorrectKey($_, %idlcodes, #providerCloudSequence)
print $correctKey;
}
}
# Providercloudsequence helps to maintain the precedence of the input file
# idlcodes is the hasp map where key is the key from file and value is an arracy of arrays ...see below the output of same
sub getCorrectKey($$$){
my $interfaceAlias = $_[0];
foreach ($_[2]) {
# This is where I need the help , I want to get the value from
# hash %idlcodes using the key from #providerCloudSequence
# The value of %idlcodes is kind of multiple Arrays where I want to
# grep $interfaceAlias against each with a AND in between elements
# and OR in between arrays , if true this is match
}
}
##Data Dumper Output : Hash looks like
'NORTH_IPV' => [
[
'IDL',
'NORTHERN'
],
[
'VIDL',
'NORTH'
],
[
'IDL',
'NORTH'
]
],
'MANAGEMENT' => [
[
'IDL'
],
[
'CIDL'
]
],
'SOUTH_IPV' => [
[
'IDL',
'SOUTHERN'
],
[
'CIDL',
'SOUTH'
],
[
'IDL',
'SOUTH'
]
]
Expected output
InterfaceAlias correctKey
"AFGHD_NORTH" Doesnt Match anything so return NULL
"NORTHERN_IIDID_IPV123" Doesnt Match anything so return NULL
"IDL_SOUTH", SOUTH_IPV
"IDL_SOUTH_IUID", SOUTH_IPV
"SOUTHERN_IND_IPV" Doesnt Match anything so return NULL
"IDL_NORTH_IPV" NORTH_IPV
"IDL_ABDGJF" MANAGEMENT
How the check should work in this example
checks if InterfaceAlias contains (IDL OR CIDL) , then checks if same interfaceAlias contains [(IDL AND NORTH) OR (VIDL AND NORTH) OR (IDL AND NORTHERN) , then checks if same interfaceAlias contains [(IDL AND SOUTH) OR (CIDL AND SOUTH) OR (IDL AND SOUTHERN)]
So we have to check against all values in hash %idlcodes and return the last key with which match was TRUE
The sequence is managed by the array #providerCloudSequence
Adjacency of words is not important For example SOUTH_XXX_CIDL or even "SOUTH IDL IPV WITH SPACES" should match SOUTH_IPV....These are just examples it is basically a contains match....though the structure of file is fixed...(the data may vary)

Answer 1

I think I would build a table of regular expressions from the ini file and then simply compare the strings one by one.
My suggested code is below. The get_correct_key now converts all underscores to hyphens and trips out all the junk so, for example, SOUTH-GWS-F-IDL100555236-Primary-1Gb is converted to SOUTH-GWS-F-IDL-Primary-Gb. That has allowed me to simplify the regex substantially too.
Some notes on your code
It is superior to use warnings instead of adding -w to the shebang line
Capital letters in identifiers are generally reserved for globals like packages, and anyone familiar with Perl would thank you to stick to lower case and underscores for simple variables and subroutines
$# is only set when a piece of Perl code fails to compile or calls die. It is only caught by eval, and if you aren't using that then your tests on $# will always fail
You should never use prototypes on a Perl subroutine definition. They are different from prototypes in other languages and don't do what you think
I hope this helps
use strict;
use warnings;
open my $ini, '<', 'user_defined_connection.ini' or die $!;
my #provider_patterns;
while (<$ini>) {
next unless /\S/;
chomp;
my ($key, $data) = split /=/, $_, 2;
my $regex = join " |\n", map {
join ' ', map { "(?=.* \\b $_ \\b )" } split /,/;
} split /\|\|/, $data;
push #provider_patterns, [ qr/$regex/xi, $key ];
}
my #aliases = (
'AFGHD_NORTH',
'NORTHERN_IIDID_IPV123',
'IDL_SOUTH',
'IDL_SOUTH_IUID',
'SOUTHERN_IND_IPV',
'IDL_NORTH_IPV',
'IDL_ABDGJF',
'IDL SOUTH',
'MANAGEMENT_IPV_IDL100595208',
'SOUTH-GWS-F-IDL100555236-Primary-1Gb',
);
for my $alias (#aliases) {
my $found = get_correct_key($alias, \#provider_patterns);
printf qq{ %-38s %-s\n}, qq{"$alias"}, defined $found ? $found : "Doesn't match anything so return undef";
}
sub get_correct_key {
my ($alias, $patterns) = #_;
$alias =~ tr/_/-/;
$alias = join '-', $alias =~ /[a-z]+/gi;
my $found;
for my $pair (#$patterns) {
my ($re, $key) = #$pair;
$found = $key if $alias =~ $re;
}
$found;
}
output
"AFGHD_NORTH" Doesn't match anything so return undef
"NORTHERN_IIDID_IPV123" Doesn't match anything so return undef
"IDL_SOUTH" SOUTH_IPV
"IDL_SOUTH_IUID" SOUTH_IPV
"SOUTHERN_IND_IPV" Doesn't match anything so return undef
"IDL_NORTH_IPV" NORTH_IPV
"IDL_ABDGJF" MANAGEMENT
"IDL SOUTH" SOUTH_IPV
"MANAGEMENT_IPV_IDL100595208" MANAGEMENT
"SOUTH-GWS-F-IDL100555236-Primary-1Gb" SOUTH_IPV