sub doConf
{
        my ($conf, %directives) = @_;
        
        while (($directive, $variable) = each(%directives))
        {
        if ($directive eq "Servers") {
              %$variable = $conf->get($directive);
        } else {
                  $$variable = $conf->get($directive);
            }
        }

}


#
# string abbreviate (string thestring[, int maxlength)
#
# Returns thestring abbreviated to maxlength-3 characters plus "...", unless
# thestring is shorter than maxlength.
#

sub abbreviate
{
        my ($thestring, $maxlength) = @_;
        
        $maxlength = 12  unless ($maxlength);
        
        if (length($thestring) > $maxlength)
        {
                $thestring = substr($thestring, 0, $maxlength - 3);
                return "$thestring...";
        }
        else
        {
                return $thestring;
        }
}


1;

package ConfigReaderSimple;
#
# Simple interface to a configuration file
#

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();

$VERSION = "1.0";

my $DEBUG = 0;

=head1 NAME

ConfigReader::Simple - Simple configuration file parser

=head1 SYNOPSIS

   use ConfigReader::Simple;

   $config = ConfigReader::Simple->new("configrc", [qw(Foo Bar Baz Quux)]);

   $config->parse();
   
   $config->get("Foo");
   

=head1 DESCRIPTION

   C<ConfigReader::Simple> reads and parses simple configuration files. It's
   designed to be smaller and simpler than the C<ConfigReader> module
   and is more suited to simple configuration files.

=cut

###################################################################
# Functions under here are member functions                       #
###################################################################

=head1 CONSTRUCTOR

=item new ( FILENAME, DIRECTIVES )

This is the constructor for a new ConfigReader::Simple object.

C<FILENAME> tells the instance where to look for the configuration
file.

C<DIRECTIVES> is an optional argument and is a reference to an array.  
Each member of the array should contain one valid directive. A directive
is the name of a key that must occur in the configuration file. If it
is not found, the module will die. The directive list may contain all
the keys in the configuration file, a sub set of keys or no keys at all.

=cut

sub new {
   my $prototype = shift;
   my $filename = shift;
   my $keyref = shift;

   my $class = ref($prototype) || $prototype;
   my $self  = {};

   $self->{"filename"} = $filename;
   $self->{"validkeys"} = $keyref;

   bless($self, $class);
   return $self;
}


#
# destructor
#
sub DESTROY {
   my $self = shift;

   return 1;
}

=pod
=item parse ()

This does the actual work.  No parameters needed.

=cut

sub parse {
   my $self = shift;

   open(CONFIG, $self->{"filename"}) || 
      die "Config: Can't open config file " . $self->{"filename"} . ": $!";

   my @array_buffer;
   my $ext_option = 0;
   my $parsed_line = 0;
 
   while (<CONFIG>) {
      chomp;
      next if /^\s*$/;  # blank
      next if /^\s*#/;  # comment

      $parsed_line   = 0;
      my $input_text = $_;
      
      if (/^\s*.*\[[0-9]+\]\s*=\s*\(/)  {
        $ext_option++;
      } elsif (/^.*\)/)  {
        push (@array_buffer, $_);
        my ($key, %values) = &parse_array(@array_buffer);
        warn "Key:  '$key'   Value:  '%values'\n" if $DEBUG;
        my $address = $values{"AddressPort"};
        if ($address eq "") {
          die ("No Address for server found!");
        }  
        %{$self->{"config_data"}{$key}{"$address"}} = %values;
        $ext_option = 0;
        $parsed_line++;
        @array_buffer = ();
      }
      
      if (($ext_option == 0) && ($parsed_line == 0)) {
        my ($key, $value) = &parse_line($input_text);
        warn "Key:  '$key'   Value:  '$value'\n" if $DEBUG;
        $self->{"config_data"}{$key} = $value;
      } elsif ($ext_option > 0) {
        push (@array_buffer, $_);
      }
   }
   close(CONFIG);
   #$self->_validate_keys;

   return 1;

}

=pod
=item get ( DIRECTIVE )

Returns the parsed value for that directive.

=cut

sub get {
   my $self = shift;
   my $key = shift;

   unless (ref $self->{"config_data"}{$key}) {
     return $self->{"config_data"}{$key};
   } else {
     return %{$self->{"config_data"}{$key}};
   }  
}

# Internal methods

sub parse_line {
   my $text = shift;

   my ($key, $value);
   
   if ($text =~ /^\s*(\w+)\s+(['"]?)(.*?)\2\s*$/) {
      $key   = $1;
      $value = $3;
   } else {
      die "Config: Can't parse line: $text\n";
   }

   return ($key, $value);
}

sub parse_array {
   my @array_buffer = @_;
   
   my ($key, %values);

   foreach my $entry (@array_buffer) 
   {
     if ($entry =~ /^\s*(.*)\[[0-9]+\]\s*=\s*\(\s*("(.+)"\s*=\>\s*"(.+)")?/ ) {
       $key = $1;
       $values{$3} = $4;
       
     } elsif ($entry =~ /^\s*"(.+)"\s*=\>\s*"(.+)"([,)]?)?/ ) {
       $values{$1} = $2;
     }
   }
   return ($key, %values);
}


=pod

=item _validate_keys ( )

If any keys were declared when the object was constructed,
check that those keys actually occur in the configuration file.

=cut


sub _validate_keys {
        
   my $self = shift;
   
        if ( $self->{"validkeys"} )
        {
          my ($declared_key);
          my $declared_keys_ref = $self->{"validkeys"};
      foreach $declared_key ( @$declared_keys_ref )
      {
        unless ( $self->{"config_data"}{$declared_key} )
        {
                die "Config: key '$declared_key' does not occur in file $self->{filename}\n";
        }
         warn "Key: $declared_key found.\n" if $DEBUG;
      }
        }

   return 1;
}

=pod

=head1 LIMITATIONS/BUGS

Directives are case-sensitive.

If a directive is repeated, the first instance will silently be
ignored.

Always die()s on errors instead of reporting them.

C<get()> doesn't warn if used before C<parse()>.

C<get()> doesn't warn if you try to acces the value of an
unknown directive not know (ie: one that wasn't passed via C<new()>).

All these will be addressed in future releases.

=head1 CREDITS

Kim Ryan <kimaryan@ozemail.com.au> adapted the module to make declaring
keys optional.  Thanks Kim.

=head1 AUTHORS

Bek Oberin <gossamer@tertius.net.au>

=head1 COPYRIGHT

Copyright (c) 2000 Bek Oberin.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

#
# End code.
#
1;