X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=lib%2FOnis%2FConfig.pm;fp=lib%2FOnis%2FConfig.pm;h=e03d2a39a3eb299b760bf2db0c4e1c3d9cc21509;hb=d9d95d5f171d96c658e7a83406297d7aef07fcc1;hp=0000000000000000000000000000000000000000;hpb=942b56647efea6b2c0a7f1da4772ceca3ac5ef83;p=onis.git

diff --git a/lib/Onis/Config.pm b/lib/Onis/Config.pm
new file mode 100644
index 0000000..e03d2a3
--- /dev/null
+++ b/lib/Onis/Config.pm
@@ -0,0 +1,267 @@
+package Onis::Config;
+
+use strict;
+use warnings;
+use Exporter;
+
+@Onis::Config::EXPORT_OK = qw/get_config parse_argv read_config get_checksum/;
+
+@Onis::Config::ISA = ('Exporter');
+
+=head1 NAME
+
+Onis::Config - Parsing of configuration files and query method.
+
+=head1 USAGE
+
+  use Config qw#get_config read_config#;
+
+  read_config ("filename");
+  read_config ($filehandle);
+
+  get_config ("key");
+
+  get_checksum ();
+
+=head1 SYNTAX
+
+Here are the syntax rules:
+
+=over 4
+
+=item *
+
+An option 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
+
+=cut
+
+our $config = {};
+
+my $VERSION = '$Id: Config.pm,v 1.10 2004/09/16 10:30:00 octo Exp $';
+print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
+
+return (1);
+
+=head1 EXPORTED FUNCTIONS
+
+=over 4
+
+=item B<get_config> (I<$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]);
+	}
+}
+
+=item B<parse_argv> (I<@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);
+}
+
+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);
+}
+
+=item B<read_config> (I<$file>)
+
+Reads the configuration file. $file must either be a filename, a reference to
+one or a reference to a filehandle. Complains, is file does not exist.
+
+=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);
+}
+
+=back
+
+=head1 AUTHOR
+
+Florian octo Forster E<lt>octo at verplant.orgE<gt>