Simple Config reader in Perl¶

#!/usr/bin/perl

# Author:  Tomasz Gawęda - blog.0x1fff.com
# Date:   2009.07.26
# License:  BSD
# Description: Simple Perl script for parsing config files
#
# Dependicies: Perl
# Tested on: Perl v5.10.0

use strict;
use warnings;

# Return value of key in hash if it exists and
# it is defined else returns user default (if not set 0)
sub getExistsDefine {
 my ( $hash, $key, $default ) = @_;

 $default |= 0;

 return $default if not exists $hash->{$key};
 return $default if not defined $hash->{$key};

 return $hash->{$key};
}

# procedure for reading config file
sub readConfig {
 my ( $cnfLoc, $h_config, $options ) = @_;

 # cnfLoc - location of config file
 # h_config - reference to hash (here keys will be stored)
 # options - list of options - reference to hash - possible vals:
 #   ':replace' => {0,1},
 #   ':verbose' => {0,1},
 #   ':debug' => {0,1},
 #   ':checkParams' => {0,1},
 #   ':acceptedParams' => \%acceptedParams, # ref to hash
 #

 my $replace     = getExistsDefine( $options, ':replace',     0 );
 my $checkParams = getExistsDefine( $options, ':checkParams', 0 );
 my $h_expected = getExistsDefine( $options, ':acceptedParams', {} );
 my $verbose = getExistsDefine( $options, ':verbose', 1 );
 my $debug   = getExistsDefine( $options, ':debug',   1 );

 if ($debug) {
  print "readConfig: Passed options are:\n";
  for my $prop ( keys %{$options} ) {
   print $prop. " => " . $options->{$prop} . "\n";
  }
  print "\n";
 }

 die "Config $cnfLoc is not readable\n" if not -r $cnfLoc;
 open( CONF, '<', $cnfLoc ) or die "Unable to open file $cnfLoc\n";
 print <CONF> if 0;    # this is only to get rid of warning

 while ( my $line = <CONF> ) {

  print "Reading line: " . $line if $debug;

  # do read
  if ( $line =~ m/^\s*([^#\$\!;]\s*[a-z_0-9]*)\s*[=:]+\s*(.*?)\s*$/i ) {
   my $prop = $1;
   my $val  = ( defined $2 ) ? $2 : "";

   print "Found param: " . $prop . " => " . $val if $verbose or $debug;

   # check is param is valid
   if ( $checkParams and not exists $h_expected->{$prop} ) {
    print "\tIgnoring\n" if $verbose or $debug;
    next;
   }

   # if parameter is on list - replace it or not?
   if ( exists( $h_config->{$prop} ) and not $replace ) {
    print "\tReplacing\n" if $verbose or $debug;
    next;
   }

   # save it
   print "\tAccepting (" . $prop . " => " . $val . ")\n"
     if $verbose or $debug;

   $h_config->{$prop} = $val;
  }
 }
 close(CONF) or die "Unable to close file $cnfLoc\n";
}

##
##
## MAIN:
##
##

die "\nusage:\t" . $0 . " config_file_location\n\n" if scalar @ARGV %lt; 1;

print "Reading config file " . $ARGV[0] . "\n";

my %cnf;    # here will read be data stored

# this is list of accepted parameters in config file
my %acceptedParams = ( 'this_params_is_ok', 'this_also_is_ok', 'nunfil', );

# internal options for procedure
my %opts = (
 ':replace'        => 0,
 ':verbose'        => 1,
 ':debug'          => 0,
 ':checkParams'    => 1,
 ':acceptedParams' => \%acceptedParams,
);
readConfig( $ARGV[0], \%cnf, \%opts );

# and inline way to run it
#readConfig($ARGV[0], \%cnf, {":me"=>"a"});

# print values
for my $prop ( keys %cnf ) {
 print $prop. " => " . $cnf{$prop} . "\n";
}

# end