[interchange-cvs] interchange - heins modified lib/Vend/Config.pm

interchange-core@icdevgroup.org interchange-core@icdevgroup.org
Tue Apr 1 12:38:01 2003


User:      heins
Date:      2003-04-01 17:34:36 GMT
Modified:  lib/Vend Config.pm
Log:
* Add container values for config files.

	<Variable FOOBAR>
		Something in the FOOBAR variable.
	</Variable>

  This is exactly equivalent to:

  	Variable FOOBAR <<EOV
		Something in the FOOBAR variable.
	EOV

   except that the end marker can have leading/trailing whitespace
   and capitalization is not important.

* Allows trigger response to end container; currently only "yesno"
  directives are defined. The "yesno" behavior allows:

  <ParseVariables Yes>
  	Static __CATALOG_STATIC__
  	StaticLogged __LOGGED_STATIC__
  </ParseVariables>

  This will set ParseVariables to Yes

* Directives of the same type cannot be nested (though I might do that
  shortly). Directives of different types can be nested, so you can
  do:

  	<ParseVariables Yes>
		<Route log>
			foo   __BAR__
		</route>
	</Parsevariables>

  (Note that capitalization doesn't matter.)

* You can add triggers for directives by setting the ContainerSpecial
  variable in package Vend::Config. This would allow:

  	 <DirectiveUniverse foo>
	 	Foobar   yes
	 </DirectiveUnivers>

  	 <DirectiveUniverse bar>
	 	Foobar   yes
	 </DirectiveUnivers>

  Perhaps more importantly, it might allow:

  <Catalog found /var/lib/interchange/found /c/found>
  	  Variable  INITTED   This catalog has an initted value already.
  </catalog>

  Note that this is not yet implemented!

Revision  Changes    Path
2.104     +105 -7    interchange/lib/Vend/Config.pm


rev 2.104, prev_rev 2.103
Index: Config.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.103
retrieving revision 2.104
diff -u -r2.103 -r2.104
--- Config.pm	1 Apr 2003 04:12:32 -0000	2.103
+++ Config.pm	1 Apr 2003 17:34:36 -0000	2.104
@@ -1,6 +1,6 @@
 # Vend::Config - Configure Interchange
 #
-# $Id: Config.pm,v 2.103 2003/04/01 04:12:32 mheins Exp $
+# $Id: Config.pm,v 2.104 2003/04/01 17:34:36 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 # Copyright (C) 2003 ICDEVGROUP <interchange@icdevgroup.org>
@@ -37,6 +37,7 @@
 			$VERSION $C
 			@Locale_directives_ary @Locale_directives_scalar
 			@Locale_directives_code
+			%ContainerSave %ContainerTrigger %ContainerSpecial %ContainerType
 			@Locale_directives_currency @Locale_keys_currency
 			$GlobalRead  $SystemCodeDone $SystemGroupsDone $CodeDest
 			);
@@ -47,9 +48,32 @@
 use Vend::File;
 use Vend::Data;
 
-$VERSION = substr(q$Revision: 2.103 $, 10);
+$VERSION = substr(q$Revision: 2.104 $, 10);
 
 my %CDname;
+my %CPname;
+%ContainerType = (
+	yesno => sub {
+		my ($var, $value, $end) = @_;
+		$var = $CDname{lc $var};
+		if($end) {
+			my $val = delete $ContainerSave{$var};
+			no strict 'refs';
+			if($C) {
+				$C->{$var} = $val;
+			}
+			else {
+				${"Global::$var"} = $val;
+				
+			}
+		}
+		else {
+			no strict 'refs';
+			$ContainerSave{$var} = $C ? $C->{$var} : ${"Global::$var"};
+			$ContainerSave{$var} ||= 'No';
+		}
+	},
+);
 
 for( qw(search refresh cancel return secure unsecure submit control checkout) ) {
 	$Global::LegalAction{$_} = 1;
@@ -672,6 +696,7 @@
 			$directive = lc $d->[0];
 			next if $Global::DeleteDirective->{$directive};
 			$CDname{$directive} = $ucdir;
+			$CPname{$directive} = $d->[1];
 			$parse{$directive} = get_parse_routine($d->[1]);
 		}
 	}
@@ -980,6 +1005,47 @@
 	return $C;
 }
 
+sub read_container {
+	my($start, $handle, $marker, $parse, $allcfg) = @_;
+	my $lvar = lc $marker;
+	my $var = $CDname{$lvar};
+
+#::logDebug("Read container start=$start marker=$marker lvar=$lvar var=$var parse=$parse");
+	$parse ||= {};
+#::logDebug("Read container parse value=$CPname{$lvar}");
+	my $sub = $ContainerSpecial{$var}
+			  || $ContainerSpecial{$lvar}
+			  || $ContainerType{$CPname{$lvar}};
+
+	if($sub) {
+#::logDebug("Trigger special container");
+		$start =~ s/\n$//;
+		$sub->($var, $start);
+		$ContainerTrigger{$lvar} ||= $sub;
+		return $start;
+	}
+	
+	my $foundeot = 0;
+	my $startline = $.;
+	my $value = '';
+	if(length $start) {
+		$value .= "$start\n";
+	}
+	while (<$handle>) {
+		print ALLCFG $_ if $allcfg;
+		if ($_ =~ m{^\s*</$marker>\s*$}i) {
+			$foundeot = 1;
+			last;
+		}
+		$value .= $_;
+	}
+	return undef unless $foundeot;
+	#untaint
+	$value =~ /([\000-\377]*)/;
+	$value = $1;
+	return $value;
+}
+
 sub read_here {
 	my($handle, $marker, $allcfg) = @_;
 	my $foundeot = 0;
@@ -1198,10 +1264,22 @@
 
 	local($Vend::config_line);
 	$Vend::config_line = $_;
-	# lines read from the config file become untainted
-	m/^[ \t]*(\w+)\s+(.*)/ or config_error("Syntax error");
-	my $var = $1;
-	my $value = $2;
+	my $container_here;
+	my $container_trigger;
+	my $var;
+	my $value;
+
+	if(s{^[ \t]*<(/?)(\w+)\s*(.*)\s*>\s*$}{$2$3}) {
+		$container_trigger = $1;
+		$var = $container_here = $2;
+		$value = $3;
+	}
+	else {
+		# lines read from the config file become untainted
+		m/^[ \t]*(\w+)\s+(.*)/ or config_error("Syntax error");
+		$var = $1;
+		$value = $2;
+	}
 	($lvar = $var) =~ tr/A-Z/a-z/;
 
 	config_error("Unknown directive '%s'", $lvar), next
@@ -1209,7 +1287,25 @@
 
 	my($codere) = '[-\w_#/.]+';
 
-	if ($value =~ /^(.*)<<(\w+)\s*/) {                  # "here" value
+	if ($container_trigger) {                  # Apache container value
+		if(my $sub = $ContainerTrigger{$lvar}) {
+			$sub->($var, $value, 1);
+			return;
+		}
+	}
+
+	if ($container_here) {                  # Apache container value
+		my $begin  = $value;
+		$begin .= "\n" if length $begin;
+		my $mark = "</$container_here>";
+		my $startline = $.;
+		$value = read_container($begin, $fh, $container_here, \%parse);
+		unless (defined $value) {
+			config_error (sprintf('%d: %s', $startline,
+				qq#no end contaner ("</$container_here>") found#));
+		}
+	}
+	elsif ($value =~ /^(.*)<<(\w+)\s*/) {                  # "here" value
 		my $begin  = $1 || '';
 		$begin .= "\n" if $begin;
 		my $mark = $2;
@@ -1285,6 +1381,7 @@
 	no strict 'refs';
 
 	%CDname = ();
+	%CPname = ();
 
 	my $directives = global_directives();
 
@@ -1296,6 +1393,7 @@
 	foreach my $d (@$directives) {
 		$directive = lc $d->[0];
 		$CDname{$directive} = $d->[0];
+		$CPname{$directive} = $d->[1];
 		$parse = get_parse_routine($d->[1]);
 		$parse{$directive} = $parse;
 		undef $value;