Simple Config reader in Perl

Recently I had to develop some config file reading utillity, and here are efects.

Config file definition

# this is comment
! this also is comment
; and this

param : argh
param2=argh2
param3     := arghs

    ; ! # erm?
# erm
param4 = "test in quotes"

# this is invalid
param invalid = invalid
invalid-2=in-valid

param_ok : ok
param_test = #this is not comment

Perl code (one liner) formating this config file

perl -ne 'm/^([^\$\!;#][A-Z0-9_]+)\s*[=:]+\s*(.*|)/i && printf("%-35s%s\n", $1, $2)'

Perl code for reading this file

#!/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

Summary

I hope that code is readable for everybody and will help to deal with some simple config files.

Comments

  1. If you're interested in more complex config parser f.eg dhcpd file or css you should look at Config::Scoped module - http://search.cpan.org/~gaissmai/Config-Scoped-0.12/lib/Config/Scoped.pm

    ReplyDelete

Post a Comment

Popular posts from this blog

How to generate user documentation from Perl script?

35 Google open-source projects that you probably don't know