package Yaala::Config;

use strict;
use warnings;
use Exporter;

@Yaala::Config::EXPORT_OK = qw/get_config parse_argv read_config get_checksum/;

@Yaala::Config::ISA = ('Exporter');

=head1 Config.pm

Parsing of configuration files and query method.

=head1 Usage

use Yaala::Config qw#get_config read_config#;

read_config ("filename");
read_config ($filehandle);

get_config ("key");

get_checksum ();

=head1 Config Syntax

Here are the syntax rules:

=over 4

=item *

An options starts with a keyword, followed by a colon, then the value for
that key and is ended with a semi-colon. Example:

keyword: value;

=item *

Text in single- or souble quotes is taken literaly. Quotes can not be
escaped. However, singlequotes enclosed in double quotes (and vice versa)
are perfectly ok. Examples:

teststring: "Yay, it's a string!";

html: '<span style="color: #fe0000;">';

=item *

Hashes are start comments and are ignored to the end of the line. Hashes
enclosed in quotes are B<not> interpreted as comments.. See html-example
above..

=item *

Linebreaks and spaces (unless when in quotes..) are ignored. Strings may
not span multiple lines. Use something along this lines instead:

multiplelineoption: "This is a very very long"
	"string that continues in the next line";

=item *

Any key may occur more than once. You can separate two or more values with
commas:

key: value1, value2, "This, is ONE value..";

key: value4;

=back

=head1 Interna

=head2 Structure of $config

C<$config-E<gt>{'key'} = ['val0', 'val1', ...];>

=cut

our $config = {};

my $VERSION = '$Id: Config.pm,v 1.4 2003/12/07 14:52:02 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

return (1);

=head2 get_config ($key)

Queries the config structure for the given key and returns the value(s). 
In list context all values are returned, in scalar context only the most
recent one.

=cut

sub get_config
{
	my $key = shift;
	my $val;

	if (!defined ($config->{$key}))
	{
		return (wantarray () ? () : '');
	}

	$val = $config->{$key};

	if (wantarray ())
	{
		return (@$val);
	}
	else
	{
		return ($val->[0]);
	}
}

=head2 parse_argv (@argv)

Parses ARGV and adds command-line options to the internal config
structure.

=cut

sub parse_argv
{
	my @argv = @_;

	while (@argv)
	{
		my $item = shift (@argv);

		if ($item =~ m/^--?(\S+)/)
		{
			my $key = lc ($1);

			if (!@argv)
			{
				print STDERR $/, __FILE__, ": No value for key '$key'",
					'present.';
				next;
			}

			my $val = shift (@argv);

			push (@{$config->{$key}}, $val);
		}
		elsif ($item)
		{
			push (@{$config->{'input'}}, $item);
		}
		else
		{
			print STDERR $/, __FILE__, ': Ignoring empty argument.';
		}
	}

	return (1);
}

=head2 parse_config ($string)

Parses $string and adds the extracted configuration options to the
internal structure.

=cut

sub parse_config
{
	my $text = shift;
	my $tmp = '';
	my @rep;
	my $rep = 0;

	local ($/) = "\n";
	
	$text =~ s/\r//sg;

	for (split (m/\n+/s, $text))
	{
		my $line = $_;
		chomp ($line);

		# escape quoted text
		while ($line =~ m/^[^#]*(['"]).*?\1/)
		{
			$line =~ s/(['"])(.*?)\1/<:$rep:>/;
			push (@rep, $2);
			$rep++;
		}

		$line =~ s/#.*$//;
		$line =~ s/\s*//g;
		
		$tmp .= $line;
	}

	$text = lc ($tmp);

	while ($text =~ m/(\w+):([^;]+);/g)
	{
		my $key = $1;
		my @val = split (m/,/, $2);

		s/<:(\d+):>/$rep[$1]/eg for (@val);

		push (@{$config->{$key}}, @val);
	}

	return (1);
}

=head2 read_config ($file)

Reads the configuration file. $file must either be a filename, a reference
to one or a reference to a filehandle.

=cut

sub read_config
{
	my $arg = shift;
	my $fh;
	my $text;
	my $need_close = 0;
	local ($/) = undef; # slurp mode ;)

	if (ref ($arg) eq 'GLOB')
	{
		$fh = $arg->{'IO'};
	}
	elsif (!ref ($arg) || ref ($arg) eq 'SCALAR')
	{
		my $scalar_arg;
		if (ref ($arg)) { $scalar_arg = $$arg; }
		else { $scalar_arg = $arg; }
		
		if (!-e $scalar_arg)
		{
			print STDERR $/, __FILE__, ': Configuration file ',
				"'$scalar_arg' does not exist";
			return (0);
		}

		unless (open ($fh, "< $scalar_arg"))
		{
			print STDERR $/, __FILE__, ': Unable to open ',
				"'$scalar_arg': $!";
			return (0);
		}

		$need_close++;
	}
	else
	{
		my $type = ref ($arg);

		print STDERR $/, __FILE__, ": Reference type $type not ",
			'valid';
		return (0);
	}

	# By now we should have a valid filehandle in $fh

	$text = <$fh>;

	close ($fh) if ($need_close);

	parse_config ($text);

	return (1);
}

sub get_checksum
{
	my $logtype = get_config ('logtype');
	my @selects = get_config ('select');

	my $checksum = lc ($logtype) . '::' . join (':', map { lc ($_) } (sort (@selects)));
	
	return ($checksum);
}

=head1 Author

Florian octo Forster E<lt>octo@verplant.orgE<gt>
