I wrote one of these a couple of years ago but it wasnt quite right. This takes another stab at it.
1. It uses the DFLT section to populate any key that is not already there.
2. All sections and sub section are case insensitive .
3. All keys are case insensitive.
4. Any section that does not have key=value pairs is ignored
5. The sections will only use the first numeric then alpha characters get the client
a. For instance
[144LI0901]
Becomes
[144LI]
6. The DEV and PROD sub sections replace any key in the section.
144LI0901 is a section and the sub section of DEV will replace sets = 1000 with sets = 100
[DFLT]
sets = 1000
[DEV]
archive = //host1/Resource/Archives/Contract_Runs/
sets = 100
[prod]
archive = //host2/Resource/Archives/Contract_Runs/
[144LI0901]
FI = 1061
Instance = SomeBank
Name = Some Bank
Title = SomeBank_Backload
[264FB]
fi = 1111
Instance = somebank
Name = somebankBank
Title = somebankBank_Backload
sets = 10
[dev]
sets = 100
PM code
BackloadReader.pm
package Modules::BackloadReader;
use strict;
use Data::Dumper;
sub new {
my ($pkg, %args)= @_;
my $class = ref($pkg) || $pkg;
my $self = $class->SUPER::new(%args);
return $self;
}
sub getClient {
my $self = shift(@_);
my $file = shift(@_);
my $client = shift(@_);
my $mode = shift(@_);
# uc the clients
#
$client = uc( $client );
# read the ini
#
my $config = readINI ($self,$file);
# check for client
# if we dont have a client die
# we do then its renamed
$client = checkClient($self,$config,$client);
# setup the defaults if they are not already
# in the client section
#
setDFLT($self,$config);
# if we dont have a mode assume dev
#
if ( $mode == 1 ) {
$mode = 'DEV';
}
else {
$mode = 'PROD';
}
# copy mode the the client section
#
setMode($self,$config,$client,$mode);
print Dumper $config->{INI}->{$client};
return $config->{INI}->{$client};
}
sub checkClient {
my $self = shift(@_);
my $config = shift(@_);
my $client = shift(@_);
# replace the full section with the 5 digit
# so 144LI0901 is replaced with 144LI
#
$client =~ s/^(\d+\w+)(.*)$/$1/;
foreach ( keys %{$config->{INI}} ) {
# match on the first 5
#
if ( $_ =~ /^$client/ ) {
# if the rest does not match
#
unless ( $client =~ /^$_$/ ) {
# copy hash
#
$config->{INI}->{$client} = delete $config->{INI}->{$_};
last;
}
}
}
# die if the client is not there
unless ( $config->{INI}->{$client} ) {
print Dumper $config;
die "BackloadReader.pm Could not find client $client ";
}
return $client;
}
sub setMode {
my $self = shift(@_);
my $config = shift(@_);
my $client = shift(@_);
my $mode = shift(@_);
# put the dev or prod details into the variable data
# '144LI0901' => {
# dev
# sets = 10
# sets = 100
# ends up beging
# '144LI0901' => {
# dev
# sets = 10
# sets = 10
return unless ( $config->{INI}->{$client}->{$mode} ) ;
foreach my $key ( keys %{$config->{INI}->{$client}->{$mode}} ) {
$config->{INI}->{$client}->{$key} = $config->{INI}->{$client}->{$mode}->{$key};
}
return;
}
sub setModeImplicit {
my $self = shift(@_);
my $config = shift(@_);
my $client = shift(@_);
my $mode = shift(@_);
# put the dev or prod details into the variable data
# '144LI0901' => {
# dev
# sets = 10
# sets = 100
# ends up beging
# '144LI0901' => {
# dev
# sets = 10
# sets = 10
return unless ( $config->{INI}->{$client}->{$mode} ) ;
foreach my $key ( keys %{$config->{INI}->{$client}->{$mode}} ) {
$config->{INI}->{$client}->{$key} = $config->{INI}->{$client}->{$mode}->{$key};
}
return;
}
sub setDFLT {
my $self = shift(@_);
my $config = shift(@_);
# do every line in dflt
# 'DFLT' => {
# 'SETS' => '1000',
# 'SOMETHING' => '1',
# 'DEV' => {
# 'ARCHIVE' => '//nhost1/Resource/Archives/Contract_Runs/'
# },
# 'PROD' => {
# 'ARCHIVE' => '//howst2/Resource/Archives/Contract_Runs/'
# },
# }
foreach ( %{$config->{INI}->{'DFLT'}} ) {
# '144LI0901' => {
#
foreach my $sec ( keys %{$config->{INI}} ) {
# don't do dflt again
next if ( $sec =~ /DFLT/ );
# move sub groups too
# this is the DFLT group
if ( $_ =~ /^DEV|PROD$/ ) {
foreach my $key ( keys %{$config->{INI}->{'DFLT'}->{$_}} ) {
# if its already there dont do anything
#next unless ( $config->{INI}->{$sec}->{$_} ) ;
unless ( $config->{INI}->{$sec}->{$_}->{$key} ) {
$config->{INI}->{$sec}->{$_}->{$key} = $config->{INI}->{'DFLT'}->{$_}->{$key} ;
}
}
next;
}
# if subkey not set then set to default
#
#
unless ( $config->{INI}->{$sec}->{$_} ) {
# replace with the dflt if the section key is
# not there
#
if ( $config->{INI}->{'DFLT'}->{$_} ) {
# 'DFLT' => {
# 'SETS' => '1000'
# }
$config->{INI}->{$sec}->{$_} = $config->{INI}->{'DFLT'}->{$_};
}
}
}
}
}
sub readINI {
my $self = shift(@_);
my $file = shift(@_);
my $section;
my $mode;
my $config = {};
open FH , "< $file"
or die "Could not open $file : $!";
foreach ( <FH> ) {
# if blank line
#
next if ( $_ =~ /^\s*$/ );
# if comments
#
next if ( $_ =~ /^\s*#/ );
# DFLT is for everything unless set
#
# sections are [144LI]
# sub sections are [dev] or [DEV]
# we will uc all
#
if ( $_ =~ /\[(DFLT)\]/ ) {
$section = $1;
# we have a new section so reset $mode
#
undef $mode;
next;
}
if ( $_ =~ /\[(\S+)\]/ ) {
my $sec = uc( $1 );
if ( $sec =~ /^\d/ ) {
$section = $sec;
# we have a new section so reset $mode
#
undef $mode;
}
else {
# dev prod etc
#
$mode = $sec;
}
next;
}
if ( $_ =~ /^(.+)=(.*)$/ ) {
# values and keys
#
my $key = uc( $1 );
my $val = $2;
$key =~ s/^\s*//;
$val =~ s/^\s*//;
$key =~ s/\s*$//;
$val =~ s/\s*$//;
if ( length $mode ) {
$config->{INI}->{$section}->{$mode}->{$key} = $val;
}
else {
# defualt
$config->{INI}->{$section}->{$key} = $val;
}
next;
}
}
close ( FH ) ;
return $config;
}
1;
__END__
</code>