Writing a good parser for an INI file

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 

BackloadReader.pm

backloader.ini

[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;

BackloadReader.pm

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>