# -*- perl -*-
#
# $Id: KeyVal.pm,v 1.3 1998/03/22 01:31:49 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/KeyVal.pm,v $
# $Author: ejb $
#

require 5.001;
use strict;

package KeyVal;
my $package = "KeyVal";

my $whoami = $main::progname;

# Field names
my $f_filename = "filename";
my $f_valid_keys = "valid_keys";
my $f_values = "values";
my $f_defaults = "defaults";

# Static Variables

# Routines

sub new
{
    my $class = shift;
    my $rep = +{$package => {} };

    die "$whoami: " .'new(filename, \@keys[, \%defaults])'. "\n" if (@_ < 2);

    $rep->{$package}{$f_filename} = shift;
    $rep->{$package}{$f_valid_keys} = shift;
    $rep->{$package}{$f_defaults} = ((@_) ? shift : {});
    $rep->{$package}{$f_values} = &parse_keyval($rep);

    bless $rep, $class;
}

sub parse_keyval
{
    my $rep = shift;
    my ($filename) = $rep->{$package}{$f_filename};
    my (%values) = ();
    my (%valid) = ();
    my ($error) = 0;
    my (@valid_keys) = @{$rep->{$package}{$f_valid_keys}};
    my (%defaults) = %{$rep->{$package}{$f_defaults}};

    local(*FILE);
    open(FILE, "<$filename") ||
	die "$whoami: can't read file $filename: $!\n";

    my $i;
    foreach $i (@valid_keys)
    {
	$valid{$i} = 1;
    }

    while (<FILE>)
    {
	chop;			# Kill newline
	s/#.*//;		# Eliminate comments
	s/^\s+//;		# Eliminate leading blanks
	s/\s+$//;		# Eliminate trailing blanks
	next if $_ eq "";	# skip blank lines
	
	# Separate line into part before and after colon
	# Fail if line doesn't contain colon
	m/^\s*([^:\s]*)\s*:\s*(.*?)\s*$/ or
	    die "$whoami: invalid line \"$_\" in $filename line ${.}.\n";
	
	my ($key, $val) = ($1, $2);

	exists $valid{$key} or
	    die "$whoami: unrecognized key $key while parsing $filename\n";
	
	$values{$key} = $val;
    }

    close(FILE);

    my $k;
    foreach $k (@valid_keys)
    {
	if (! exists $values{$k})
	{
	    if (exists $defaults{$k})
	    {
		$values{$k} = $defaults{$k};
	    }
	    else
	    {
		$error = 1;
		warn "$package: no value for key $k\n";
	    }
	}
    }

    die "$whoami: can't initialize key/value pairs\n" if $error;

    \%values;
}

sub vals
{
    my $rep = shift;
    $rep->{$package}{$f_values};
}

sub get_val
{
    my $rep = shift;
    my $key = shift;
    my $vals = $rep->vals;
    if (! exists($vals->{$key}))
    {
	die "$package: invalid key $key\n";
    }
    $vals->{$key};
}

sub set_val
{
    my $rep = shift;
    my ($key, $val) = @_;
    my $vals = $rep->vals;
    if (! exists($vals->{$key}))
    {
	die "$package: invalid key $key\n";
    }
    $vals->{$key} = $val;
}

sub test
{
    my ($testfile) = "/tmp/a.$$";
    open(TEST, ">$testfile") || die "$whoami: can't open $testfile: $!\n";
    print TEST "one: 1\n";
    print TEST "two: 2\n";
    print TEST "three: 3\n";
    print TEST "# five: 3\n";
    print TEST "\n";
    print TEST "four: 4\n";
    close(TEST);

    my $a = new KeyVal($testfile, ["one", "two", "three", "four", "five"],
		       {"one" => 10, "five" => 50});
    my (%values) = %{$a->vals()};
    for (keys %values)
    {
	print "$_: $values{$_}\n";
    }

    print "\n";
    # Extra space after $ to work around problem in perl mode.
    $ {$a->vals()}{"one"} = 2;
    $a->set_val("three", 12);
    print "Expect 4:\n";
    print $a->get_val('four'), "\n";

    %values = %{$a->vals()};
    for (keys %values)
    {
	print "$_: $values{$_}\n";
    }

    unlink $testfile;
    print "Expect abnormal termination\n";
    $a->get_val('six');
}

1;