Commits

Palmer, 2E0EOL committed ad1fc79

Code Latest released tag exported from svn @ r66 (version 1.1.0).

Comments (0)

Files changed (8)

+dl-libconfreader-perl (1.1.0) stable; urgency=low
+
+  * Initial release.
+
+ -- David Palmer <palmer@overchat.org>  Fri, 03 Dec 2010 22:44:49 +0000
+Source: dl-libconfreader-perl
+Section: utils
+Priority: extra
+Maintainer: David Palmer <palmer@overchat.org>
+Build-Depends: debhelper (>= 7), perl
+Standards-Version: 3.7.3
+Homepage: http://www.daybologic.co.uk/
+Vcs-Browser: http://svn.daybologic.co.uk/trac/dlconfreader/
+
+Package: dl-libconfreader-perl
+Architecture: all
+Depends: ${shlibs:Depends}, ${misc:Depends}, ${perl:Depends}, perl, liberror-perl
+Description: Code for quickly reading configuration files from Perl scripts
+ Due to a wide range of fairly broken modules on CPAN which don't keep options
+ within their sections, Palmer wrote this handle little package for easily
+ reading configuration in a few number of lines.
+opt/daybo/lib
+#!/usr/bin/make -f
+# -*- makefile -*-
+# Sample debian/rules that uses debhelper.
+# This file was originally written by Joey Hess and Craig Small.
+# As a special exception, when this file is copied by dh-make into a
+# dh-make output file, you may use that output file without restriction.
+# This special exception was added by Craig Small in version 0.37 of dh-make.
+
+# Uncomment this to turn on verbose mode.
+export DH_VERBOSE=1
+
+PKG_NAME=dl-libconfreader-perl
+
+configure: configure-stamp
+configure-stamp:
+	dh_testdir
+	# Add here commands to configure the package.
+
+	touch configure-stamp
+
+
+build: build-stamp
+
+build-stamp: configure-stamp  
+	dh_testdir
+
+	# Add here commands to compile the package.
+	#$(MAKE)
+	mkdir obj/
+	pod2man src/DlConfReader.pm | gzip -c > obj/DlConfReader.3pm.gz
+
+	touch $@
+
+clean: 
+	dh_testdir
+	dh_testroot
+	rm -f build-stamp configure-stamp
+
+	# Add here commands to clean up after the build process.
+	#$(MAKE) clean
+
+	dh_clean 
+
+install: build
+	dh_testdir
+	dh_testroot
+	dh_clean -k 
+	dh_installdirs
+
+	install -m 755 -d $(CURDIR)/debian/$(PKG_NAME)/opt/daybo/lib
+	install -m 755 -d $(CURDIR)/debian/$(PKG_NAME)/usr/share/man/man3
+	install -m 755 src/DlConfReader.pm $(CURDIR)/debian/$(PKG_NAME)/opt/daybo/lib/DlConfReader.pm
+	install -m 644 obj/DlConfReader.3pm.gz $(CURDIR)/debian/$(PKG_NAME)/usr/share/man/man3/DlConfReader.3pm.gz
+
+# Build architecture-independent files here.
+binary-indep: build install
+# We have nothing to do by default.
+
+# Build architecture-dependent files here.
+binary-arch: build install
+	dh_testdir
+	dh_testroot
+#	dh_installchangelogs 
+#	dh_installdocs
+#	dh_installexamples
+	dh_install
+#	dh_installmenu
+#	dh_installdebconf	
+#	dh_installlogrotate
+#	dh_installemacsen
+#	dh_installpam
+#	dh_installmime
+#	dh_python
+#	dh_installinit
+#	dh_installcron
+#	dh_installinfo
+	dh_installman
+#	dh_link
+#	dh_strip
+	dh_compress
+	dh_fixperms
+	dh_perl
+#	dh_makeshlibs
+	dh_installdeb
+	dh_shlibdeps
+	dh_gencontrol
+	dh_md5sums
+	dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure

src/DlConfReader.pm

+#!/usr/bin/perl -w
+
+=item DlConfReader
+
+The DlConfReader provided by the dl-libconfreader-perl package is a package which provides a simple
+way to read configuration files in a .ini [section] key=value format.
+Anything outside of a section will be read into an undefined sectopnm, which allows reading other
+forms of configuration file too.  This was written due to the lack of consistency on CPAN for similar
+packages.  We rely on liberror-perl for exceptions, although this has now been deprecated.
+
+=cut
+
+use Error qw(:try);
+
+package DlConfReader;
+use Data::Dumper;
+use constant DEFAULT_SECTION => ('DEFAULT');
+#----------------------------------------------------------------------------
+=item new
+
+Create a new DlConfReader object.
+
+Parameters:
+FileName
+  The path, either fully qualified, or relative to the configuration file you
+  wish to read.  This is optional, you may also use the SetFn method.
+  The config file will be read immediately if passed here.  This could result
+  in an exception being raised.
+
+Returns:
+  Blessed object for handling configuration files of the type DlConfReader
+
+=cut
+#----------------------------------------------------------------------------
+sub new
+{
+  my %deepHash = ( );
+  my $proto = $_[0];
+  my $class = ref($proto) || $proto;
+  my $self = {
+    _fn => undef,
+    _deep_hash => \%deepHash
+  };
+
+  my $Fn = $_[1];
+  bless($self, $class);
+
+  if ( $self && $Fn ) {
+    $self = undef unless ( $self->SetFn($Fn) );
+    $self->Reload() if ( $self );
+  }
+  return $self;
+}
+#----------------------------------------------------------------------------
+=item DESTROY
+
+This function is used to destroy the object, releasing all memory used
+by keys in memory.  The object cannot be re-used after it is destroyed.
+
+Parameters:
+None
+
+Returns:
+  None
+
+=cut
+#----------------------------------------------------------------------------
+sub DESTROY
+{
+  my $self = $_[0];
+  $self->{_fn} = undef;
+  if ( defined($self->{_deep_hash}) ) {
+    foreach my $k ( keys(%{ $self->{_deep_hash} }) ) {
+      delete($self->{_deep_hash}->{$k});
+    }
+    $self->{_deep_hash} = undef;
+  }
+  return;
+}
+#----------------------------------------------------------------------------
+=item GetSections
+
+Parameters:
+SectionsPtr
+  Pass a reference to an array which will hold the names of the sections within
+  the configuration file.  If not specified, the result value will still be
+  valid.
+
+Returns:
+  The number of section names loaded into SectionsPtr will be returned.  Zero
+  if there are no sections.  The undefined section (the default) will not be
+  counted as a section in its own right, and will not be included.
+
+=cut
+#----------------------------------------------------------------------------
+sub GetSections
+{
+  my ( $self, $SectionsPtr ) = @_;
+  my $count = 0;
+
+  @$SectionsPtr = ( ) if ( $SectionsPtr );
+  foreach my $s ( keys(%{ $self->{_deep_hash} }) ) {
+    next if ( $s eq DEFAULT_SECTION() );
+    push @$SectionsPtr, $s if ( $SectionsPtr );
+    $count++;
+  }
+  return $count;
+}
+#----------------------------------------------------------------------------
+=item GetKeys
+
+Return the names of all keys within a particular section of the configuration
+file.
+
+Parameters:
+Section:
+  The section name, or undef for those keys not within a section.
+
+KeysPtr:
+  A reference to an array which will accept the names of the keys for the
+  desired section.  The reference is optional.  Any existing data in the
+  array will be lost, if passed.
+
+Returns:
+  The number of keys in the section which have been returned via KeysPtr,
+  if not KeysPtr is passed, the number of items which are in the section and
+  would have been returned is returned.
+
+=cut
+#----------------------------------------------------------------------------
+sub GetKeys
+{
+  my ( $self, $Section, $KeysPtr ) = @_;
+  my $count = 0;
+  my $s = $Section;
+
+  @$KeysPtr = ( ) if ( $KeysPtr );
+  $s = $Section;
+  $self->_DeprecatedSection() if ( defined($s) && $s eq DEFAULT_SECTION() );
+  $s = DEFAULT_SECTION() unless ( defined($s) );
+  foreach my $k ( keys(%{ $self->{_deep_hash}->{$s} }) ) {
+    push @$KeysPtr, $k if ( $KeysPtr );
+    $count++;
+  }
+  return $count;
+}
+#----------------------------------------------------------------------------
+=item GetDatum
+
+Return a specific value within the configuration file, given a section and
+a key.  Whitespace will be trimmed from the left and right of the returned
+value.  If the value does not exist, or you are not within the correct
+section, undef is returned.
+
+Parameters:
+Section:
+  The section which is expected to contain the desired key, must be specified,
+  undef should be used if the key is not within a section.
+
+KeyName:
+  The name of the key. must be specified.
+
+Returns:
+  The value within the key, after whitespace trimming, or undef.
+
+=cut
+#----------------------------------------------------------------------------
+sub GetDatum
+{
+  my ( $self, $Section, $KeyName ) = @_;
+  my $ret = undef;
+  my $s = $Section;
+
+  $self->_DeprecatedSection() if ( defined($s) && $s eq DEFAULT_SECTION() );
+  $s = DEFAULT_SECTION() unless ( defined($s) );
+  if ( exists($self->{_deep_hash}->{$s}) ) {
+    if ( exists($self->{_deep_hash}->{$s}->{$KeyName}) ) {
+      $ret = $self->{_deep_hash}->{$s}->{$KeyName};
+    }
+  }
+  return $ret;
+}
+#----------------------------------------------------------------------------
+=item SetFn
+
+Set the path to the configuration file in prepation for the next reload
+operation.
+
+Parameters:
+FilePath:
+  The full or relative path to the configuration file.  May be undef if
+  the filename is to be cleared.
+
+Returns:
+  1 if the FilePath is stored and set correctly,
+  0 if the FilePath is cleared, or illegal.
+
+=cut
+#----------------------------------------------------------------------------
+sub SetFn
+{
+  my $self = $_[0];
+  $self->{_fn} = $_[1] if ( $_[1] );
+  $self->{_fn} = undef unless ( length($self->{_fn}) );
+  return 1 if ( defined($self->{_fn}) );
+  return 0;
+}
+#----------------------------------------------------------------------------
+=item Reload
+
+Loads configuration from the currently set filepath into the object,
+in addition to any configuration already within the object.  The filename
+must be set prior to calling Reload(), or an exception shall be raised.
+
+Multiple calls to the function will override existing values, and, if the
+filename has been changed, will merge configurations together in memory,
+sharing any common sections if section names collide.
+
+An exception is raised if the file cannot be opened.
+
+Parameters:
+None
+
+Returns:
+  None defined, the return value is reversed for future use.
+
+=cut
+#----------------------------------------------------------------------------
+sub Reload
+{
+  my $ret = 0;
+  my $self = $_[0];
+  my $section = DEFAULT_SECTION();
+  $self->SelfCheck();
+
+  if ( open(CONFFILE, ('< ' . $self->{_fn})) ) {
+    while ( my $l = <CONFFILE> ) {
+      chomp $l;
+      next unless ( length($l) );
+      $l = $self->StripComment($l);
+      next unless ( length($l) );
+      if ( $l =~ m/^\[(.*)\]$/ ) {
+        $section = $1;
+      } else {
+        my ( $k, $v ) = ( '', '' );
+        unless ( exists($self->{_deep_hash}->{$section}) ) {
+          my %newSection = ( );
+          $self->{_deep_hash}->{$section} = \%newSection;
+        }
+        if ( $self->_GetData($l, \$k, \$v) ) {
+          $self->{_deep_hash}->{$section}->{$k} = $v;
+        }
+      }
+    }
+    #print Dumper $self->{_deep_hash};
+    close(CONFFILE);
+  } else {
+    throw Error::Simple(sprintf("Cannot open %s - %s\n", $self->{_fn}, $!));
+  }
+  return $ret;
+}
+#----------------------------------------------------------------------------
+sub _GetData
+{
+  my $count = 0;
+  my ( $self, $Line, $KeyPtr, $ValuePtr ) = @_;
+  ( $$KeyPtr, $$ValuePtr ) = split('=', $Line);
+  return undef unless ( defined($$KeyPtr) && defined($$ValuePtr) );
+
+  my @Data = ( $KeyPtr, $ValuePtr );
+  foreach my $d ( @Data ) {
+    $$d =~ s/^\s+//;
+    $$d =~ s/\s+$//;
+    $count++ if ( length($$d) );
+  }
+  return 1 if ( $count );
+  return 0;
+}
+#----------------------------------------------------------------------------
+sub _DeprecatedSection
+{
+  warn(sprintf("[%s] is deprecated\n", DEFAULT_SECTION()));
+  return;
+}
+#----------------------------------------------------------------------------
+=item SelfCheck
+
+This function raises an exception if the object is not in a state
+suitable to load a configuration file.  It is a pre-launch check which
+is usually used internally.
+
+Parameters:
+None
+
+Returns:
+  None
+
+=cut
+#----------------------------------------------------------------------------
+sub SelfCheck
+{
+  my $self = $_[0];
+  unless ( defined($self->{_fn}) && defined($self->{_fn}) ) {
+    throw Error::Simple("Filename not set in DlConfReader");
+  }
+}
+#----------------------------------------------------------------------------
+=item StripComment
+
+This function will strip remarks from lines of text.  Only one line can
+be passed as a time, the function shall return the same string it is
+passed, devoid of anything after and including one of several special
+characters, understood to denote the start of a comment, including ';'
+and '#'.  If these characters occur within a quotation, ' or ", they will be
+ignored.
+
+Parameters:
+Line:
+  A string from a text file, must not be undef
+
+Returns:
+  Line, stripped.  The return value is a duplicate of the string,
+  the original is not overwritten.
+
+=cut
+#----------------------------------------------------------------------------
+sub StripComment
+{
+  my ( $self, $Line ) = @_;
+  my @remarks = ( '#', ';' );
+  my @sl = split(//, $Line);
+  my $q = undef;
+  my $c = length($Line);
+
+  foreach my $r ( @remarks ) {
+    my $i = index($Line, $r);
+    next if ( $i == -1 );
+    $Line = substr($Line, 0, $i);
+    return $Line;
+  }
+
+  #for ( my $i = 0; $i < $c; $i++ ) {
+  #  if ( $q ) { # Within a quote?
+  #    if ( $q eq $sl[$i] ) { # Quote end matched
+  #      $q = undef; # No longer in quote mode.
+  #      next;
+  #    }
+  #  } else { # Not within a quote
+  #    if ( $sl[$i] eq '\'' || $sl[$i] eq '"' ) {
+  #      $q = $sl[$i]; # Turn on quote mode
+  #      next;
+  #    }
+  #    foreach my $r ( @remarks ) {
+  #      if ( $sl[$i] eq $r ) {
+  #        $Line = substr($Line, 0, $i);
+  #        last;
+  #      }
+  #    }
+  #  }
+  #}
+  return $Line;
+}
+#----------------------------------------------------------------------------
+1;
+;
+; This .ini file is a test configuration to ensure that
+; the Perl conf-reader can make some sense of it!
+;
+
+user=overlord
+uid=1101
+gid=1100
+
+[bio]
+age=28
+dob = 1982-11-20
+tagline=Against the new world order
+
+[user1]
+name= David Palmer
+age=28
+
+[user2]
+#name='Michael Jackson ; Assassinated' ; Comment part of name
+name=Michael Jackson
+age=50
+
+[user3]
+name=Tony Blair ; War criminal
+age=65
+
+[user4]
+name =Saddam Hussain
+age=60
+
+[user5]
+name=Carly Ford # NCP
+age=26
+
+;[user6]
+;name=Henry
+;age=15
+#!/usr/bin/perl -w
+#
+# This is a testbed for the DlConfReader component
+#
+#----------------------------------------------------------------------------
+use strict;
+use Data::Dumper;
+use lib '.';
+use DlConfReader;
+
+use constant EXIT_FAILURE => (1);
+use constant EXIT_SUCCESS => (0);
+use constant INI_FILE => ('./test.ini');
+use constant USER => ('overlord');
+#----------------------------------------------------------------------------
+my $Reader = undef;
+#----------------------------------------------------------------------------
+sub Main();
+sub CheckUsers();
+sub CheckUser();
+sub DobReader();
+sub GetSections();
+sub GetKeysDefault();
+sub GetKeysSection();
+sub _GetKeys($$);
+sub Check($$$$);
+#----------------------------------------------------------------------------
+sub Main()
+{
+  my ( $total, $count, $countSuccess ) = ( 0, 0, 0 );
+  my %checks = (
+    'CheckUsers' => \&CheckUsers,
+    'Checkuser' => \&CheckUser,
+    'DobReader' => \&DobReader,
+    'GetSections' => \&GetSections,
+    'GetKeysDefault' => \&GetKeysDefault,
+    'GetKeysSection' => \&GetKeysSection
+  );
+
+  $Reader = DlConfReader->new(INI_FILE());
+  $total = scalar(keys(%checks));
+  foreach my $c ( sort(keys(%checks)) ) {
+    $countSuccess += Check($c, $checks{$c}, ++$count, $total);
+  }
+
+  if ( $countSuccess ) {
+    printf("\n%u of %u checks succeeded.\n", $countSuccess, $total);
+  } else {
+    print("All checks failed.\n");
+  }
+  return EXIT_SUCCESS() if ( $countSuccess == $total );
+  return EXIT_FAILURE();
+}
+#----------------------------------------------------------------------------
+sub CheckUsers()
+{
+  my $c = 0;
+  my $ok = 0;
+  my @sections = ( );
+
+  # The ages as we expect them within the test file
+  my %uAges = (
+    1 => 28,
+    2 => 50,
+    3 => 65,
+    4 => 60,
+    5 => 26
+  );
+
+  # The names as they should be read from the test file
+  my %uNames = (
+    1 => 'David Palmer',
+    #2 => 'Michael Jackson ; Assassinated',
+    2 => 'Michael Jackson',
+    3 => 'Tony Blair',
+    4 => 'Saddam Hussain',
+    5 => 'Carly Ford'
+  );
+
+  # A count of checks against each item, each section should score 2,
+  # so if you see 0 or 1 here, something has gone wrong and the whole
+  # test should bail with an appropriate error.
+  my %uCheckCount = ( );
+
+  # Initialise %uCheckCount
+  foreach my $k ( keys(%uAges) ) {
+    $uCheckCount{$k} = 0;
+  }
+
+  if ( ($c = $Reader->GetSections(\@sections)) ) { # Read all section names
+    if ( scalar(@sections) == $c ) { # Check the return value is consistent
+      foreach my $thisSection ( @sections ) { # All section names
+        my ( $userN, $userName, $userAge );
+        next unless ( $thisSection =~ m/^user(\d)$/ ); # Skip non-user sections
+        $userN = $1; # Take the user number from the section name
+        $userName = $Reader->GetDatum($thisSection, 'name');
+        $userAge = $Reader->GetDatum($thisSection, 'age');
+
+        if ( defined($userName) ) {
+          if ( defined($uNames{$userN}) ) {
+            $uCheckCount{$userN}++ if ( $userName eq $uNames{$userN} );
+          } else {
+            warn(sprintf('Superfluous user %d detected', $userN));
+          }
+        }
+        if ( defined($userAge) ) {
+          if ( defined($uAges{$userN}) ) {
+            $uCheckCount{$userN}++ if ( $userAge eq $uAges{$userN} );
+          }
+        }
+      }
+    } else{
+      printf(
+        STDERR "GetSections() inconsistency, %d elements, returned %d\n",
+        scalar(@sections), $c
+      );
+      return $ok; # Fail.
+    }
+  } else {
+    print(STDERR "No sections in test file!\n");
+    return $ok; # Fail
+  }
+
+  # Check the counts
+  $ok = 1; # Bug, if you have sections but not userN sections, this will be set 1 anyway (FIXME)
+  foreach my $k ( keys(%uCheckCount) ) {
+    unless ( $uCheckCount{$k} == 2 ) {
+      $ok = 0;
+      printf(STDERR "%s is bad\n", $k);
+    }
+  }
+  return $ok;
+}
+#----------------------------------------------------------------------------
+sub CheckUser()
+{
+  my $ok = 0;
+  my $user = $Reader->GetDatum(undef, 'user');
+  $ok = 1 if ( defined($user) && $user eq USER() );
+
+  printf(
+    STDERR "Expected user %s, got %s\n",
+    USER(),
+    ( defined($user) ) ? ( $user ) : ( '(undef)' )
+  ) unless ( $ok );
+  return $ok
+}
+#----------------------------------------------------------------------------
+sub DobReader()
+{
+  my $ok = 0;
+
+  my $d = $Reader->GetDatum('bio', 'dob');
+  if ( defined($d) ) {
+    $ok = 1 if ( $d eq '1982-11-20' );
+  }
+  return $ok;
+}
+#----------------------------------------------------------------------------
+sub GetSections()
+{
+  my $ok = 0;
+  my $c;
+  my @realSections = ( );
+  my @expectSections = ( 'bio' );
+  foreach my $d ( 1 .. 5 ) {
+    push(@expectSections, ('user' . $d));
+  }
+
+  # Tests prepared, now call the reader
+  $c = $Reader->GetSections(\@realSections);
+  if ( $c == scalar(@expectSections) ) {
+    my $found = 0;
+    for ( my $i = 0; $i < scalar(@expectSections); $i++ ) {
+      $found = 0;
+      for ( my $j = 0; $j < scalar(@realSections); $j++ ) {
+        if ( $expectSections[$i] eq $realSections[$j] ) {
+          $found++;
+          last;
+        }
+      }
+      last unless ( $found );
+    }
+    $ok = 1 if ( $found );
+  } else {
+    printf(
+      STDERR "Expected %d sections, but GetSections() returned %d\n",
+      scalar(@expectSections), $c
+    );
+  }
+
+  print STDERR Dumper \@realSections unless ( $ok );
+  return $ok;
+}
+#----------------------------------------------------------------------------
+sub GetKeysDefault()
+{
+  my @expectKeys = ( 'user', 'uid', 'gid' );
+  return _GetKeys(undef, \@expectKeys);
+}
+#----------------------------------------------------------------------------
+sub GetKeysSection()
+{
+  my @expectKeys = ( 'age', 'dob', 'tagline' );
+  return _GetKeys('bio', \@expectKeys);
+}
+#----------------------------------------------------------------------------
+sub _GetKeys($$)
+{
+  my ( $Section, $ExpectedKeys ) = @_;
+  my $ok = 0;
+  my $c;
+  my @realKeys = ( );
+
+  $c = $Reader->GetKeys($Section, \@realKeys);
+  if ( $c == scalar(@$ExpectedKeys) ) {
+    my $found = 0;
+    for ( my $i = 0; $i < scalar(@$ExpectedKeys); $i++ ) {
+      $found = 0;
+      for ( my $j = 0; $j < scalar(@realKeys); $j++ ) {
+        if ( $ExpectedKeys->[$i] eq $realKeys[$j] ) {
+          $found++;
+          last;
+        }
+      }
+      last unless ( $found );
+    }
+    $ok = 1 if ( $found );
+  } else {
+    printf(
+      STDERR "Expected %d keys in %s, but GetKeys() returned %d\n",
+      scalar(@$ExpectedKeys),
+      ( $Section ) ? ( 'section '. $Section ) : ( 'default section' ),
+      $c
+    );
+  }
+
+  print STDERR Dumper \@realKeys unless ( $ok );
+  return $ok;
+}
+#----------------------------------------------------------------------------
+sub Check($$$$)
+{
+  my $r;
+  my ( $ProcName, $Proc, $ProcN, $ProcTotal ) = ( @_ );
+  $r = $Proc->();
+  printf("[%u/%u] %s(): ", $ProcN, $ProcTotal, $ProcName);
+  printf("%s\n", ($r) ? ('OK') : ('FAILED'));
+  return $r;
+}
+#----------------------------------------------------------------------------
+exit Main();
+#----------------------------------------------------------------------------