#!/usr/bin/perl

package INF;

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

use Carp qw(carp);

require Exporter;

$VERSION = "0.01";
@ISA = qw(Exporter);
@EXPORT_OK = qw(read_inf inf_has_key inf_get_key inf_get_keys);

# Return true if the hash has the named key.
sub inf_has_key
{
    croak("inf_has_key(HASH_REF, KEY)") if @_ != 2;
    my($hash_ref, $the_key) = @_;

    $the_key =~ tr/a-z/A-Z/;

    foreach my $key (keys %{$hash_ref}) {
	my $key1 = $key;
	$key1 =~ tr/a-z/A-Z/;

	return 1 if $key1 eq $the_key;
    }

    return 0;
}

# Return the value associated with the named key.
sub inf_get_key
{
    croak("inf_get_key(HASH_REF, KEY)") if @_ != 2;
    my($hash_ref, $the_key) = @_;

    $the_key =~ tr/a-z/A-Z/;

    foreach my $key (keys %{$hash_ref}) {
	my $key1 = $key;
	$key1 =~ tr/a-z/A-Z/;

	return $hash_ref->{$key} if $key1 eq $the_key;
    }

    return undef;
}

# Apply inf_get_key multiple times.
sub inf_get_keys
{
    croak("inf_get_keys(HASH_REF, KEY1, [KEY2], ...)") if @_ < 2;
    my($hash_ref, $first_key, @keys) = @_;
    my $result = inf_get_key($hash_ref, $first_key);

    foreach my $key (@keys) {
	$result = inf_get_key($result, $key);
    }

    return $result;
}

sub store_pair
{
    my($hash, $section, $key, $value) = @_;

    # Strip leading whitespace from key and value.
    $key =~ s/^\s+//;
    $value =~ s/^\s+//;

    # Handle quotes in the key.
    if (substr($key, 0, 1) eq '"') {
	$key =~ s/^"(.*?)"\s*$/$1/;
    } else {
	$key =~ s/\s+$//;
    }

    # Handle quotes in the value.
    if (substr($value, 0, 1) eq '"') {
	$value =~ s/^"(.*?)"\s*$/$1/;
    } else {
	$value =~ s/\s+$//;
    }

    # Store the key,value pair.
    $hash->{$section}{$key} = $value;
}

sub subst_string
{
    my($strings, $str) = @_;

    my $pos = 0;
    while ($pos < length($str)) {
	# Find the next location of a % character.
	my $percent_pos_1 = index($str, '%', $pos);

	if ($percent_pos_1 != -1) {
	    my $percent_pos_2 = index($str, '%', $percent_pos_1 + 1);
	    if ($percent_pos_2 != -1) {
		my $replacement;

		# Determine what replacement to use.
		if ($percent_pos_2 - $percent_pos_1 > 0) {
		    my $key = substr($str, $percent_pos_1 + 1,
				     $percent_pos_2 - ($percent_pos_1 + 1));
		    $replacement = $strings->{$key};
		} else {
		    $replacement = "%";
		}

		# Replace the %...% markers with the replacement.
		substr($str, $percent_pos_1,
		       $percent_pos_2 - $percent_pos_1 + 1) = $replacement;
		$pos += length($replacement);
	    } else {
		$pos = length($str);
	    }
	} else {
	    $pos = length($str);
	}
    }

    return $str;
}

sub subst_inf
{
    my($inf) = @_;

    # Retrieve the [Strings] section if it exists.
    return if not inf_has_key($inf, "Strings");
    my $strings = inf_get_key($inf, "Strings");

    foreach my $section (keys %{$inf}) {
	next if $section =~ /^Strings$/i;
	foreach my $key (keys %{$inf->{$section}}) {
	    my $value = subst_string($strings, $inf->{$section}{$key});
	    if ($value ne $inf->{$section}{$key}) {
		$inf->{$section}{$key} = $value;
	    }
	    $value = subst_string($strings, $key);
	    if ($value ne $key) {
		my $tmp = $inf->{$section}{$key};
		delete $inf->{$section}{$key};
		$inf->{$section}{$value} = $tmp;
	    }
	}
    }
}

sub read_inf
{
    my($fname) = @_;
    local(*INF);
    my $hash = {};
    my($line, $linenum, $section);

    if (! open(INF, "<$fname")) {
	carp "open: $!\n";
	return undef;
    }

    $linenum = 0;
    while (defined($line = <INF>)) {
	# Advance the line number.
	$linenum++;

	# Remove trailing newline and leading whitespace.
	chomp $line;
	$line =~ s/^\s+//;

	# Skip over blank lines and comments.
	next if $line eq '';
	next if substr($line, 0, 1) eq ';';

	if ($line =~ /^\[(.*)\]\s*$/) {
	    # Handle section markers. Just update the "current" section.
	    $section = $1;
	    $hash->{$section} = {} if not exists $hash->{$section};
	} elsif ($line =~ /^(.*?)=(.*)$/) {
	    store_pair($hash, $section, $1, $2);
	} elsif ($line =~ /^(.+)$/) {
	    store_pair($hash, $section, $1, "");
	} else {
	    carp("parse error at $fname:$linenum\n");
	    return undef;
	}
    }

    close(INF);

    # Replace any %...% strings in the parsed file.
    subst_inf($hash);

    return $hash;
}

1;