[interchange-cvs] interchange - heins modified 22 files

interchange-core@icdevgroup.org interchange-core@icdevgroup.org
Mon Sep 16 19:07:01 2002


User:      heins
Date:      2002-09-16 23:06:33 GMT
Modified:  .        MANIFEST
Modified:  code/UI_Tag db_hash.coretag dump_session.coretag
Modified:           write_shipping.coretag
Modified:  code/UserTag var.tag
Modified:  lib/Vend Accounting.pm Config.pm Control.pm Data.pm Error.pm
Modified:           Interpolate.pm Order.pm SOAP.pm Search.pm Server.pm
Modified:           Session.pm UserDB.pm Util.pm
Modified:  lib/Vend/Accounting SQL_Ledger.pm
Modified:  lib/Vend/Payment MCVE.pm
Modified:  lib/Vend/Table DBI.pm
Modified:  scripts  interchange.PL
Log:
* Move most all code out of bin/interchange. The only routines
  that remain are:

		dontwarn
		version
		usage
		catch_warnings
		parse_options
		main_loop

   Once the initial startup for Interchange is done, this code
   is completely out of the picture.

* Create new Vend::Dispatch module which contains the bulk of the
  code removed from bin/interchange.

* Move the important update_data() subroutine to Vend::Data.

* Move the session-related routines to Vend::Session.

* Move the order-related routines do_order() and update_quantity()
  to Vend::Order.

* Change many ::uneval() calls to plain uneval() or Vend::Util::uneval().

* Remove various unused tags and routines....

Revision  Changes    Path
2.62      +1 -5      interchange/MANIFEST


rev 2.62, prev_rev 2.61
Index: MANIFEST
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/MANIFEST,v
retrieving revision 2.61
retrieving revision 2.62
diff -u -r2.61 -r2.62
--- MANIFEST	13 Sep 2002 20:46:17 -0000	2.61
+++ MANIFEST	16 Sep 2002 23:06:30 -0000	2.62
@@ -147,16 +147,12 @@
 code/UI_Tag/list_glob.coretag
 code/UI_Tag/list_keys.coretag
 code/UI_Tag/list_pages.coretag
-code/UI_Tag/load_templates.coretag
 code/UI_Tag/meta_record.coretag
 code/UI_Tag/mm_locale.coretag
 code/UI_Tag/mm_value.coretag
 code/UI_Tag/newer.coretag
 code/UI_Tag/quick_table.coretag
-code/UI_Tag/read_page.coretag
 code/UI_Tag/read_shipping.coretag
-code/UI_Tag/read_ui_page.coretag
-code/UI_Tag/read_ui_template.coretag
 code/UI_Tag/reconfig.coretag
 code/UI_Tag/reconfig_time.coretag
 code/UI_Tag/reconfig_wait.coretag
@@ -918,7 +914,6 @@
 dist/lib/UI/pages/admin/bug_report.html
 dist/lib/UI/pages/admin/build_related.html
 dist/lib/UI/pages/admin/button_builder.html
-dist/lib/UI/pages/admin/compedit.html
 dist/lib/UI/pages/admin/content.html
 dist/lib/UI/pages/admin/content_editor.html
 dist/lib/UI/pages/admin/content_preview.html
@@ -1174,6 +1169,7 @@
 lib/Vend/CounterFile.pm
 lib/Vend/Data.pm
 lib/Vend/DbSearch.pm
+lib/Vend/Dispatch.pm
 lib/Vend/Document.pm
 lib/Vend/Error.pm
 lib/Vend/External.pm



1.2       +2 -4      interchange/code/UI_Tag/db_hash.coretag


rev 1.2, prev_rev 1.1
Index: db_hash.coretag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/code/UI_Tag/db_hash.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- db_hash.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ db_hash.coretag	16 Sep 2002 23:06:31 -0000	1.2
@@ -6,10 +6,9 @@
 	my($table, $col, $key, $opt) =3D @_;
 	$col =3D~ s/:+(.*)//s;
 	my $out;
-	#$out .=3D ::uneval(\@_);
 	my $rest =3D $1;
 	my $val =3D ::tag_data($table,$col,$key);
-	#$out .=3D "val=3D$val";
+
 	my $ref;
 	if ($val !~ /\S/) {
 		$ref =3D {};
@@ -28,7 +27,6 @@
 	my $final =3D pop @extra;
 	my $curr =3D $ref;
 	$out .=3D "Original key request: $rest\n";
-	#$out .=3D ::uneval($ref);
 	$out .=3D "\nFinal key: $final\n";
 	for(@extra) {
 		$out .=3D "key --> $_\n";
@@ -47,7 +45,7 @@
 	}
 	else {
 		$curr->{$final} =3D $opt->{value};
-		tag_data($table, $col, $key, { value =3D> ::uneval_it($ref) });
+		tag_data($table, $col, $key, { value =3D> uneval_it($ref) });
 		return $curr->{$final};
 	}
 }



1.2       +1 -1      interchange/code/UI_Tag/dump_session.coretag


rev 1.2, prev_rev 1.1
Index: dump_session.coretag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/code/UI_Tag/dump_session.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- dump_session.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ dump_session.coretag	16 Sep 2002 23:06:31 -0000	1.2
@@ -30,7 +30,7 @@
 	else {
 		my $fn =3D Vend::Util::get_filename($name, 2, 1, $Vend::Cfg->{SessionDat=
abase});
 		return '' unless -f $fn;
-		return ::uneval(Vend::Util::eval_file($fn));
+		return uneval(Vend::Util::eval_file($fn));
 	}
 }
 EOR



1.2       +1 -1      interchange/code/UI_Tag/write_shipping.coretag


rev 1.2, prev_rev 1.1
Index: write_shipping.coretag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/code/UI_Tag/write_shipping.coretag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- write_shipping.coretag	29 Jan 2002 05:52:40 -0000	1.1
+++ write_shipping.coretag	16 Sep 2002 23:06:31 -0000	1.2
@@ -16,7 +16,7 @@
 		my @line =3D @$_;
 		my $opt =3D '';
 		if (ref($line[7]) =3D~ /HASH/) {
-			$line[7] =3D ::uneval_it($line[7]);
+			$line[7] =3D uneval_it($line[7]);
 		}
 		push @outlines, \@line;
 	}



1.2       +7 -3      interchange/code/UserTag/var.tag


rev 1.2, prev_rev 1.1
Index: var.tag
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/code/UserTag/var.tag,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- var.tag	29 Jan 2002 05:52:42 -0000	1.1
+++ var.tag	16 Sep 2002 23:06:31 -0000	1.2
@@ -18,9 +18,13 @@
 	return $Vend::Cfg->{Member}{$key}
 		if	$Vend::Session->{logged_in}
 			&& defined $Vend::Cfg->{Member}{$key};
-	if($global) {
-		return Vend::Interpolate::dynamic_var($key) || $Global::Variable->{$key};
+
+	if($::Pragma->{dynamic_variables}) {
+		return Vend::Interpolate::dynamic_var($key) || $Global::Variable->{$key}
+			if $global;
+		return Vend::Interpolate::dynamic_var($key);
 	}
-	return Vend::Interpolate::dynamic_var($key);
+	return $::Variable->{$key} || $Global::Variable if $global;
+	return $::Variable->{$key};
 }
 EOR



2.2       +5 -5      interchange/lib/Vend/Accounting.pm


rev 2.2, prev_rev 2.1
Index: Accounting.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Accounting.pm,v
retrieving revision 2.1
retrieving revision 2.2
diff -u -r2.1 -r2.2
--- Accounting.pm	11 Jun 2002 20:30:58 -0000	2.1
+++ Accounting.pm	16 Sep 2002 23:06:31 -0000	2.2
@@ -1,6 +1,6 @@
 # Vend::Accounting - Interchange payment processing routines
 #
-# $Id: Accounting.pm,v 2.1 2002/06/11 20:30:58 mheins Exp $
+# $Id: Accounting.pm,v 2.2 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 2002 Mike Heins, <mike@heins.net>
 #
@@ -21,7 +21,7 @@
=20
 package Vend::Accounting;
=20
-$VERSION =3D substr(q$Revision: 2.1 $, 10);
+$VERSION =3D substr(q$Revision: 2.2 $, 10);
=20
 use Vend::Util;
 use LWP::UserAgent;
@@ -224,7 +224,7 @@
 	my %result;
 	if($Have_Net_SSLeay) {
 #::logDebug("placing Net::SSLeay request: host=3D$server, port=3D$port, sc=
ript=3D$script");
-#::logDebug("values: " . ::uneval($query) );
+#::logDebug("values: " . uneval($query) );
 		my ($page, $response, %reply_headers)
                 =3D post_https(
 					   $server, $port, $script,
@@ -247,7 +247,7 @@
 		my @query =3D %{$query};
 		my $ua =3D new LWP::UserAgent;
 		my $req =3D POST($submit_url, \@query, %header);
-#::logDebug("placing LWP request: " . ::uneval_it($req) );
+#::logDebug("placing LWP request: " . uneval_it($req) );
 		my $resp =3D $ua->request($req);
 		$result{status_line} =3D $resp->status_line();
 		$result{status_line} =3D~ /(\d+)/
@@ -257,7 +257,7 @@
 #::logDebug("received LWP header: $header_string");
 		$result{result_page} =3D $resp->content();
 	}
-#::logDebug("returning thing: " . ::uneval_it(\%result) );
+#::logDebug("returning thing: " . uneval_it(\%result) );
 	return \%result;
 }
=20



2.71      +155 -9    interchange/lib/Vend/Config.pm


rev 2.71, prev_rev 2.70
Index: Config.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.70
retrieving revision 2.71
diff -u -r2.70 -r2.71
--- Config.pm	7 Sep 2002 20:05:10 -0000	2.70
+++ Config.pm	16 Sep 2002 23:06:31 -0000	2.71
@@ -1,6 +1,6 @@
 # Vend::Config - Configure Interchange
 #
-# $Id: Config.pm,v 2.70 2002/09/07 20:05:10 mheins Exp $
+# $Id: Config.pm,v 2.71 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -27,7 +27,7 @@
=20
 @ISA =3D qw(Exporter);
=20
-@EXPORT		=3D qw( config global_config );
+@EXPORT		=3D qw( config global_config config_named_catalog );
=20
 @EXPORT_OK	=3D qw( get_catalog_default get_global_default parse_time parse=
_database);
=20
@@ -43,8 +43,9 @@
 use Fcntl;
 use Vend::Parse;
 use Vend::Util;
+use Vend::Data;
=20
-$VERSION =3D substr(q$Revision: 2.70 $, 10);
+$VERSION =3D substr(q$Revision: 2.71 $, 10);
=20
 my %CDname;
=20
@@ -176,7 +177,7 @@
 		warn "$msg\n" unless $Vend::Quiet;
 	}
 	else {
-		::logGlobal({level =3D> 'warn'}, $msg);
+		logGlobal({level =3D> 'warn'}, $msg);
 		die "$msg\n";
 	}
 }
@@ -972,6 +973,146 @@
 	return $value;
 }
=20
+sub config_named_catalog {
+	my ($cat_name, $source, $db_only, $dbconfig) =3D @_;
+	my ($g,$c);
+
+	$g =3D $Global::Catalog{$cat_name};
+	unless (defined $g) {
+		logGlobal( "Can't find catalog '%s'" , $cat_name );
+		return undef;
+	}
+
+	$Vend::Log_suppress =3D 1;
+
+	unless ($db_only or $Vend::Quiet) {
+		logGlobal( "Config '%s' %s%s", $g->{'name'}, $source );
+	}
+	undef $Vend::Log_suppress;
+
+    chdir $g->{'dir'}
+            or die "Couldn't change to $g->{'dir'}: $!\n";
+
+	if($db_only) {
+		logGlobal(
+			"Config table '%s' (file %s) for catalog %s from %s",
+			$db_only,
+			$dbconfig,
+			$g->{'name'},
+			$source,
+			);
+		my $cfg =3D $Global::Selector{$g->{script}}
+			or die errmsg("'%s' not a catalog (%s).", $g->{name}, $g->{script});
+		undef $cfg->{Database}{$db_only};
+		$Vend::Cfg =3D config(
+				$g->{name},
+				$g->{dir},
+				undef,
+				undef,
+				$cfg,
+				$dbconfig,
+				)
+			or die errmsg("error configuring catalog %s table %s: %s",
+							$g->{name},
+							$db_only,
+							$@,
+					);
+		open_database();
+		close_database();
+		return $Vend::Cfg;
+	}
+
+    eval {
+        $c =3D config($g->{'name'},
+					$g->{'dir'},
+					undef,
+					$g->{'base'} || undef,
+# OPTION_EXTENSION
+#					$Vend::CommandLine->{$g->{'name'}} || undef
+# END OPTION_EXTENSION
+					);
+    };
+
+    if($@) {
+		my $msg =3D $@;
+        logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
+     	return undef;
+    }
+
+	if (defined $g->{base}) {
+		open_database(1);
+		dump_structure($c, $g->{name}) if $Global::DumpStructure;
+		return $c;
+	}
+
+	eval {
+		$Vend::Cfg =3D $c;=09
+		$::Variable =3D $Vend::Cfg->{Variable};
+		$::Pragma   =3D $Vend::Cfg->{Pragma};
+		Vend::Data::read_salestax();
+		Vend::Data::read_shipping();
+		open_database(1);
+		my $db;
+
+		LREAD: {
+			last LREAD unless $db =3D $Vend::Cfg->{LocaleDatabase};
+			$db =3D database_exists_ref($db)
+				or last LREAD;
+			$db =3D $db->ref();
+			my ($k, @f);	# key and fields
+			my @l;			# refs to locale repository
+			my @n;			# names of locales
+
+			@n =3D $db->columns();
+			my $extra;
+			for(@n) {
+				$Vend::Cfg->{Locale_repository}{$_} =3D {}
+					unless $Vend::Cfg->{Locale_repository}{$_};
+				push @l, $Vend::Cfg->{Locale_repository}{$_};
+			}
+			my $i;
+			while( ($k , @f ) =3D $db->each_record) {
+				for ($i =3D 0; $i < @f; $i++) {
+					next unless length($f[$i]);
+					$l[$i]->{$k} =3D $f[$i];
+				}
+			}
+			unless ($Vend::Cfg->{Locale}) {
+				for(@n) {
+					next unless $Vend::Cfg->{Locale_repository}{$_}{'default'};
+					$Vend::Cfg->{DefaultLocale} =3D $_;
+					$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$_};
+					last;
+				}
+				unless ($Vend::Cfg->{Locale}) {
+					$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$n[0]};
+					$Vend::Cfg->{DefaultLocale} =3D $n[0];
+				}
+			}
+		}
+
+		close_database();
+	};
+
+	undef $Vend::Cfg;
+    if($@) {
+		my $msg =3D $@;
+		$msg =3D~ s/\s+$//;
+        logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
+     	return undef;
+    }
+
+	dump_structure($c, $g->{name}) if $Global::DumpStructure;
+
+	my $stime =3D scalar localtime();
+	Vend::Util::writefile(">$Global::RunDir/status.$g->{name}", "$stime\n");
+	Vend::Util::writefile(">$c->{ConfDir}/status.$g->{name}", "$stime\n");
+
+	return $c;
+
+}
+
+
 use File::Find;
=20
 my %extmap =3D qw/
@@ -1331,7 +1472,7 @@
 	push @{$C->{Tie_Watch}}, $name;
=20
 	my ($ref, $orig);
-#::logDebug("Contents of $name: " . ::uneval_it($C->{$name}));
+#::logDebug("Contents of $name: " . uneval_it($C->{$name}));
 	if(ref($C->{$name}) =3D~ /ARRAY/) {
 #::logDebug("watch ref=3Darray");
 		$ref =3D $C->{$name};
@@ -1783,7 +1924,7 @@
 		print $msg;
 	}
 	else {
-		::logGlobal({level =3D> 'info', strip =3D> $strip },
+		logGlobal({level =3D> 'info', strip =3D> $strip },
 				errmsg($val,
 						$name,
 						$.,
@@ -2130,6 +2271,11 @@
 					}
 					return 1;
 				},
+		Glimpse =3D> sub {
+					return 1 unless shift;
+					require Vend::Glimpse;
+					return 1;
+				},
 		SOAP_Socket =3D> sub {
 					shift;
 					return 1 if $Have_set_global_defaults;
@@ -2615,7 +2761,7 @@
 		$cat->{$key} =3D $value;
 	}
=20
-#::logDebug ("parsing catalog $name =3D " . ::uneval_it($cat));
+#::logDebug ("parsing catalog $name =3D " . uneval_it($cat));
=20
 	$Global::Catalog{$name} =3D $cat;
=20
@@ -2744,7 +2890,7 @@
 		}
 	}
=20
-#::logDebug("d object: " . ::uneval_it($d));
+#::logDebug("d object: " . uneval_it($d));
 	if($d->{ACTIVE} and ! $d->{OBJECT}) {
 		my $name =3D $d->{'name'};
 		$d->{OBJECT} =3D Vend::Data::import_database($d)
@@ -2940,7 +3086,7 @@
 			config_warn(
 				"Bad $var value '%s': %s\n%s",
 				"Database $table $file $type",
-				::uneval($C->{Database}),
+				uneval($C->{Database}),
 			);
 			return '';
 		}



2.5       +5 -5      interchange/lib/Vend/Control.pm


rev 2.5, prev_rev 2.4
Index: Control.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Control.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- Control.pm	19 Jul 2002 05:13:16 -0000	2.4
+++ Control.pm	16 Sep 2002 23:06:31 -0000	2.5
@@ -1,6 +1,6 @@
 # Vend::Control - Routines that alter the running Interchange daemon
 #=20
-# $Id: Control.pm,v 2.4 2002/07/19 05:13:16 mheins Exp $
+# $Id: Control.pm,v 2.5 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -45,7 +45,7 @@
 	my (@cats) =3D @_;
 	for(@cats) {
 		my $ref =3D $Global::Catalog{$_}
-			or die ::errmsg("Unknown catalog '%s'. Stopping.\n", $_);
+			or die errmsg("Unknown catalog '%s'. Stopping.\n", $_);
 		Vend::Util::writefile("$Global::RunDir/reconfig", "$ref->{script}\n");
 	}
 }
@@ -111,7 +111,7 @@
 	}
 	my $msg;
 	if($mode eq 'cron') {
-		$msg =3D ::errmsg(
+		$msg =3D errmsg(
 					"Dispatching jobs=3D%s for cat %s to Interchange server %s with %s.\n=
",
 					$Vend::CronJob,
 					$Vend::CronCat,
@@ -120,7 +120,7 @@
 				);
 	}
 	else {
-		$msg =3D ::errmsg(
+		$msg =3D errmsg(
 					"Killing Interchange server %s with %s.\n",
 					$pid,
 					$sig,
@@ -140,7 +140,7 @@
 	my @aliases;
=20
 	unless(defined $g) {
-		::logGlobal( {level =3D> 'error'}, "Attempt to remove non-existant catal=
og %s." , $name );
+		logGlobal( {level =3D> 'error'}, "Attempt to remove non-existant catalog=
 %s." , $name );
 		return undef;
 	}
=20



2.16      +568 -22   interchange/lib/Vend/Data.pm


rev 2.16, prev_rev 2.15
Index: Data.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Data.pm,v
retrieving revision 2.15
retrieving revision 2.16
diff -u -r2.15 -r2.16
--- Data.pm	10 Aug 2002 02:30:26 -0000	2.15
+++ Data.pm	16 Sep 2002 23:06:31 -0000	2.16
@@ -1,6 +1,6 @@
 # Vend::Data - Interchange databases
 #
-# $Id: Data.pm,v 2.15 2002/08/10 02:30:26 mheins Exp $
+# $Id: Data.pm,v 2.16 2002/09/16 23:06:31 mheins Exp $
 #=20
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -55,6 +55,7 @@
 product_row
 product_row_hash
 set_field
+update_data
=20
 );
 @EXPORT_OK =3D qw(update_productbase column_index);
@@ -196,7 +197,7 @@
 	undef $Vend::OnlyProducts if scalar @Vend::Productbase > 1;
=20
 	$Products =3D $Vend::Productbase[0];
-#::logError("Productbase: '@Vend::Productbase' --> " . ::uneval(\%Vend::Ba=
sefinder));
+#::logError("Productbase: '@Vend::Productbase' --> " . uneval(\%Vend::Base=
finder));
=20
 }
=20
@@ -230,7 +231,7 @@
=20
 sub database_field {
     my ($db, $key, $field_name, $foreign) =3D @_;
-#::logDebug("database_field: " . ::uneval_it(\@_));
+#::logDebug("database_field: " . uneval_it(\@_));
     $db =3D database_exists_ref($db) or return undef;
     return '' unless defined $db->test_column($field_name);
 	$key =3D $db->foreign($key, $foreign) if $foreign;
@@ -251,7 +252,7 @@
 	$db =3D $db->ref();
     return undef unless $db->test_record($key);
     return undef unless defined $db->test_column($field_name);
-#::logDebug(__PACKAGE__ . "increment_field: " . ::uneval_it(\@_));
+#::logDebug(__PACKAGE__ . "increment_field: " . uneval_it(\@_));
     return $db->inc_field($key, $field_name, $adder);
 }
=20
@@ -742,15 +743,15 @@
 				};
 				if($@) {
 						my $msg =3D "table '%s' failed: %s";
-						$msg =3D ::errmsg($msg, $name, $@);
-						::logError($msg);
+						$msg =3D errmsg($msg, $name, $@);
+						logError($msg);
 				}
 			}
 			else {
 				if($data->{GUESS_NUMERIC}) {
 					my $dir =3D $data->{DIR} || $Vend::Cfg->{ProductDir};
 					my $fn =3D Vend::Util::catfile( $dir, $data->{file} );
-					my @fields =3D grep /\S/, split /\s+/, ::readfile("$fn.numeric");
+					my @fields =3D grep /\S/, split /\s+/, readfile("$fn.numeric");
 					$data->{NUMERIC} =3D {};
 					for(@fields) {
 						$data->{NUMERIC}{$_} =3D 1;
@@ -799,10 +800,10 @@
 #	if($type =3D=3D 9) {
 #my @caller =3D caller();
 #::logDebug ("enter import_database: dummy=3D$dummy");
-#::logDebug("opening table table=3D$database config=3D" . ::uneval($obj) .=
 " caller=3D@caller");
+#::logDebug("opening table table=3D$database config=3D" . uneval($obj) . "=
 caller=3D@caller");
 #
-#::logDebug ("database=3D$database type=3D$type name=3D$name obj=3D" . ::u=
neval($obj));
-#::logDebug ("database=3D$database type=3D$type name=3D$name obj=3D" . ::u=
neval($obj)) if $obj->{HOT};
+#::logDebug ("database=3D$database type=3D$type name=3D$name obj=3D" . une=
val($obj));
+#::logDebug ("database=3D$database type=3D$type name=3D$name obj=3D" . une=
val($obj)) if $obj->{HOT};
 #=09
 #	}
 	return $Vend::Cfg->{SaveDatabase}->{$name}
@@ -1096,7 +1097,7 @@
=20
 #::logDebug(
 #	"dbname=3D$dbname db_fn=3D$db_fn bx_fn=3D$bx_fn ix_fn=3D$ix_fn\n" .
-#	"options: " . Vend::Util::uneval($opt) . "\n"
+#	"options: " . uneval($opt) . "\n"
 #	);
=20
 	if(		! -f $bx_fn
@@ -1126,7 +1127,7 @@
 		my @fields =3D grep $_ ne $key, split /[\0,\s]+/, $opt->{fn};
 		my $sort =3D join ",", @fields;
 		if(! $opt->{fn}) {
-			::logError(errmsg("index attempted on table '%s' with no fields, no sea=
rch spec", $dbname));
+			logError(errmsg("index attempted on table '%s' with no fields, no searc=
h spec", $dbname));
 			return undef;
 		}
 		$opt->{spec} =3D <<EOF;
@@ -1156,7 +1157,7 @@
 		@fn =3D split /\s*[\0,]+\s*/, $c->{mv_return_fields};
 	}
=20
-#::logDebug( "search options: " . Vend::Util::uneval($c) . "\n");
+#::logDebug( "search options: " . uneval($c) . "\n");
=20
 	open(Vend::Data::INDEX, "+<$ix_fn") or
 		open(Vend::Data::INDEX, "+>$ix_fn") or
@@ -1419,7 +1420,7 @@
=20
 	my $db =3D database_exists_ref($table);
 	if(! $db) {
-		::logError('Non-existent price option table %s', $table);
+		logError('Non-existent price option table %s', $table);
 		return;
 	}
 #::logDebug("database $table exists");
@@ -1445,7 +1446,7 @@
 #::logDebug("called option_cost");
 	my $db =3D database_exists_ref($table);
 	if(! $db) {
-		::logError('Non-existent price option table %s', $table);
+		logError('Non-existent price option table %s', $table);
 		return;
 	}
=20
@@ -1493,7 +1494,7 @@
 	my $f;
=20
 	foreach $ref (@$ary) {
-#::logDebug("checking option " . ::uneval_it($ref));
+#::logDebug("checking option " . uneval_it($ref));
 		next unless defined $item->{$ref->[0]};
 		$ref->[1] =3D~ s/^\s+//;
 		$ref->[1] =3D~ s/\s+$//;
@@ -1536,11 +1537,11 @@
 		@p =3D Text::ParseWords::shellwords($raw);
 	}
 	if(scalar @p > ($Vend::Cfg->{Limit}{chained_cost_levels} || 64)) {
-		::logError('Too many chained cost levels for item ' .  uneval($item) );
+		logError('Too many chained cost levels for item ' .  uneval($item) );
 		return undef;
 	}
=20
-#::logDebug("chain_cost item =3D " . uneval ($item) . "\np=3D" . ::uneval(=
\@p) );
+#::logDebug("chain_cost item =3D " . uneval ($item) . "\np=3D" . uneval(\@=
p) );
 	my ($chain, $percent);
 	my $passed_key;
 	my $want_key;
@@ -1548,7 +1549,7 @@
 	foreach $price (@p) {
 		next if ! length($price);
 		if($its++ > ($Vend::Cfg->{Limit}{chained_cost_levels} || 64)) {
-			::logError('Too many chained cost levels for item ' .  uneval($item) );
+			logError('Too many chained cost levels for item ' .  uneval($item) );
 			last CHAIN;
 		}
 		$price =3D~ s/^\s+//;
@@ -1640,6 +1641,30 @@
 #::logDebug("database referenc found table=3D$table field=3D$field key=3D$=
key|$item->{$key}|$item->{code} price=3D$price");
 				redo CHAIN;
 			}
+			elsif ($mod =3D~ s/(\w+)=3D(.*)//) {
+				my $tag =3D $1;
+				my(@args) =3D split /:/, $2;
+				my $sub	=3D   # $intrinsic_price{$tag} ||
+							$Vend::Cfg->{Sub}{$tag} || $Global::GlobalSub->{$tag};
+
+				my %i =3D %$item;
+=09=09=09
+				for(@args) {
+					my($k, $v) =3D split /=3D/, $_;
+					$i{$k} =3D $v;
+				}
+
+				$i{final} =3D $final;
+				$i{passed_key} =3D $passed_key if $passed_key;
+
+				if ($sub) {
+					$price =3D $sub->(\%i);
+				}
+				else {
+					$price =3D Vend::Tags->$tag(\%i);
+				}
+				redo CHAIN;
+			}
 			elsif ($mod =3D~ s/^[&]//) {
 				$Vend::Interpolate::item =3D $item;
 				$Vend::Interpolate::s =3D $final;
@@ -1652,7 +1677,7 @@
 				$final +=3D $1 if $1;
 				my ($attribute, $table, $field, $key) =3D split /:/, $2;
 				if($item->{$attribute}) {
-					$key =3D $field ? $item->{$attribute} : $item->{'code'}
+					$key =3D $field ? $item->{$attribute} : $item->{code}
 						unless $key;
 					$price =3D database_field( ( $table ||
 												$item->{mv_ib} ||
@@ -1734,7 +1759,7 @@
 		$master =3D $item;
 		my $mv_mp =3D $item->{mv_mi}
 			or do {
-				::logError("Bad modular item %s: ", ::uneval_it($item));
+				logError("Bad modular item %s: ", uneval_it($item));
 				return 0;
 			};
 		for(@$Vend::Items) {
@@ -1763,7 +1788,7 @@
 		if($Vend::Cfg->{PriceDivide} =3D=3D 0) {
 			my $msg =3D "Locale %s PriceDivide non-numeric or zero [%s].";
 			$msg .=3D " Possibly bad locale data.",
-			::logError(
+			logError(
 				$msg,
 				$::Scratch->{mv_currency} || $::Scratch->{mv_locale},
 				$Vend::Cfg->{PriceDivide},
@@ -1824,6 +1849,527 @@
 sub item_subtotal {
 	item_price($_[0]) * $_[0]->{quantity};
 }
+
+sub set_db {
+	my ($base, $thing) =3D @_;
+	return ($base, $thing) unless $thing =3D~ /^(\w+):+(.*)/;
+	my $t =3D $1;
+	my $c =3D $2;
+
+	# Security handled before this in update_data
+	$Vend::WriteDatabase{$t} =3D 1;
+
+	my $db =3D database_exists_ref($t);
+	return undef unless $db;
+	return ($db->ref(), $c);
+}
+
+## Update the user-entered fields.
+sub update_data {
+	my($key,$value);
+	my @cgi_keys =3D keys %CGI::values;
+    # Update a database record
+	# Check to see if this is allowed
+#::logDebug("mv_data_enable=3D$::Scratch->{mv_data_enable}");
+	if(! $::Scratch->{mv_data_enable}) {
+		logError(
+			 "Attempted database update without permission, table=3D%s key=3D%s.",
+			 $CGI::values{mv_data_table},
+			 $CGI::values{$CGI::values{mv_data_key}},
+		);
+		return undef;
+	}
+	unless (defined $CGI::values{mv_data_table} and=20
+		    defined $CGI::values{mv_data_key}      ) {
+		logError("Attempted database operation without table, fields, or key.\n"=
 .
+					 "Table: '%s'\n" .
+					 "Fields:'%s'\n" .
+					 "Key:   '%s'\n",
+					 $CGI::values{mv_data_table},
+					 $CGI::values{mv_data_fields},
+					 $CGI::values{mv_data_key},
+				 );
+
+		return undef;
+	}
+
+	my $function	=3D lc (delete $CGI::values{mv_data_function});
+	if($function eq 'delete' and ! delete $CGI::values{mv_data_verify}) {
+		logError("update_data: DELETE without VERIFY, abort");
+		return undef;
+	}
+	my $table		=3D $CGI::values{mv_data_table};
+	my $prikey		=3D $CGI::values{mv_data_key};
+	my $decode		=3D is_yes($CGI::values{mv_data_decode});
+	my ($ref, $db, $database);
+
+	my $en_col;
+#::logDebug("data_enable=3D$::Scratch->{mv_data_enable}, checking");
+	if($::Scratch->{mv_data_enable} =3D~ /^(\w+):(.*?):/) {
+		# check for single key and possible set of columns
+		my $en_table =3D $1;
+		$en_col   =3D $2;
+		my $en_key   =3D $::Scratch->{mv_data_enable_key};
+#::logDebug("en_table=3D$en_table en_col=3D$en_col, en_key=3D$en_key, chec=
king");
+		if(  $en_table ne $table
+			 or=20
+			 ($en_key and $CGI::values{$prikey} ne $en_key)
+			)
+		{
+			logError("Attempted database operation without permission:\n" .
+						 "Permission: '%s' (key=3D'$en_key')\n" .
+						 "Table: '%s'\n" .
+						 "Fields:'%s'\n" .
+						 "Key:   '%s'\n",
+						 $::Scratch->{mv_data_enable},
+						 $CGI::values{mv_data_table},
+						 $CGI::values{mv_data_fields},
+						 $CGI::values{$CGI::values{mv_data_key}},
+				 );
+			return undef;
+		}
+	}
+
+
+	$Vend::WriteDatabase{$table} =3D 1;
+
+    my $base_db =3D database_exists_ref($table)
+        or die "Not a defined database '$table': $!\n";
+    $base_db =3D $base_db->ref();
+
+	my @fields		=3D grep $_ && $_ ne $prikey,
+						split /[\s\0,]+/, $CGI::values{mv_data_fields};
+	unshift(@fields, $prikey);
+
+    my @file_fields =3D split /[\s\0,]+/, $CGI::values{mv_data_file_field};
+    my @file_paths =3D split /[\s\0,]+/, $CGI::values{mv_data_file_path};
+    my @file_oldfiles =3D split /[\s\0,]+/, $CGI::values{mv_data_file_oldf=
ile};
+
+	if($en_col) {
+		$en_col =3D~ s/^\s+//;
+		$en_col =3D~ s/\s+$//;
+		my %col_present;
+		@col_present{ grep /\S/, split /[\s\0,]+/, $en_col } =3D ();
+		$col_present{$prikey} =3D 1;
+		for(@fields, $CGI::values{mv_blob_field}, $CGI::values{mv_blob_pointer})=
 {
+			next unless $_;
+			next if exists $col_present{$_};
+			next if /:/ and $::Scratch->{mv_data_enable} =3D~ / $_ /;
+			logError("Attempted database operation without permission:\n" .
+						 "Permission: '%s'\n" .
+						 "Table: '%s'\n" .
+						 "Fields:'%s'\n" .
+						 "Key:   '%s'\n",
+						 $::Scratch->{mv_data_enable},
+						 $CGI::values{mv_data_table},
+						 $CGI::values{mv_data_fields},
+						 $CGI::values{$CGI::values{mv_data_key}},
+				 );
+			return undef;
+		}
+	}
+	$function =3D 'update' unless $function;
+
+	my (%data);
+	for(@fields) {
+		$data{$_} =3D [];
+	}
+
+	my $count;
+	my $multi =3D $CGI::values{$prikey} =3D~ tr/\0/\0/;
+	my $max =3D 0;
+	my $min =3D 9999;
+	my ($minname, $maxname);
+
+	while (($key, $value) =3D each %CGI::values) {
+		next unless defined $data{$key};
+		if($CGI::values{"mv_data_prep_$key"}) {
+			$value =3D Vend::Interpolate::filter_value(
+						 $CGI::values{"mv_data_prep_$key"},
+						 $value
+						 );
+		}
+		$count =3D (@{$data{$key}} =3D split /\0/, $value, -1);
+		$max =3D $count, $maxname =3D $key if $count > $max;
+		$min =3D $count, $minname =3D $key if $count < $min;
+	}
+
+	if( $multi and ($max - $min) > 1 and ! $CGI::values{mv_data_force}) {
+		logError("probable bad form -- number of values min=3D%s (%s) max=3D%s (=
%s)", $min, $minname, $max, $maxname);
+		return;
+	}
+
+	my $autonumber;
+	if ($CGI::values{mv_data_auto_number}) {
+		$autonumber =3D 1;
+		my $ref =3D $data{$prikey};
+		while (scalar @$ref < $max) {
+			push @$ref, '';
+		}
+		$base_db->config('AUTO_NUMBER', '000001')
+			if ! $base_db->config('_Auto_number');
+		$CGI::values{mv_data_return_key} =3D $prikey
+			unless $CGI::values{mv_data_return_key};
+	}
+	elsif($function eq 'insert' and $base_db->config('_Auto_number') ) {
+			$autonumber =3D 1;
+	}
+=20
+
+ 	if(@file_fields) {
+		my $Tag =3D new Vend::Tags;
+		my $acl_func;
+		my $outfile;
+		if($Vend::Session->{logged_in} and $Vend::admin) {
+			$acl_func =3D sub {
+				return $Tag->if_mm('files', shift);
+			};
+		}
+		elsif($Vend::Session->{logged_in} and ! $Vend::admin) {
+			$acl_func =3D sub {
+				my $file =3D shift;
+				return 1 if $::Scratch->{$file} =3D=3D 1;
+				return $Tag->userdb(
+								function =3D> 'check_file_acl',
+								location =3D> $file,
+								mode =3D> 'w'
+								);
+			};
+		}
+		else {
+			$acl_func =3D sub { return $::Scratch->{shift(@_)} =3D=3D 1 }
+		}
+
+		for (my $i =3D 0; $i < @file_fields; $i++) {
+			unless (length($data{$file_fields[$i]}->[0])) {
+				# no need for a file update
+				$data{$file_fields[$i]}->[0] =3D $file_oldfiles[$i];
+				next;
+			}
+
+			# remove path components
+			$data{$file_fields[$i]}->[0] =3D~ s:.*/::;=20
+			$data{$file_fields[$i]}->[0] =3D~ s:.*\\::;=20
+
+			if (length ($file_paths[$i])) {
+				# real file upload
+				$outfile =3D join('/', $file_paths[$i], $data{$file_fields[$i]}->[0]);
+#::logDebug("file upload: field=3D$file_fields[$i] path=3D$file_paths[$i] =
outfile=3D$outfile");
+				my $ok;
+				if (-f $outfile) {
+					eval {
+						$ok =3D $acl_func->($outfile);
+					};
+				} else {
+					eval {
+						$ok =3D $acl_func->($file_paths[$i]);
+					};
+				}
+				if (! $ok) {
+					if($@) {
+						logError ("ACL function failed on '%s': %s", $outfile, $@);
+					}
+					else {
+						logError ("Not allowed to upload \"%s\"", $outfile);
+					}
+					next;
+				}=20
+				my $err;
+				Vend::Interpolate::tag_value_extended(
+										$file_fields[$i],
+										{
+											test =3D> 'isfile'
+										}
+										)
+					or do {
+						 logError("%s is not a file.", $data{$file_fields[$i]}->[0]);
+						 next;
+					};
+				Vend::Interpolate::tag_value_extended(
+										$file_fields[$i],
+										{
+											outfile =3D> $outfile,
+											umask =3D> '022',
+											yes =3D> '1',
+										}
+										)
+					or do {
+						 logError("failed to write %s: %s", $outfile, $!);
+						 next;
+					};
+			}
+			else {
+				# preparing to dump file contents into database column
+				$data{$file_fields[$i]}->[0]
+					=3D Vend::Interpolate::tag_value_extended ($file_fields[$i],
+						{file_contents =3D> 1});
+			}
+		}
+	}
+
+	if (not defined $data{$prikey}) {
+		logError("No key '%s' in field specifier %s", $prikey, 'mv_data_fields');
+		return undef;
+	}
+	elsif ( ! @{$data{$prikey}}) {
+		if($autonumber) {
+			@{$data{$prikey}} =3D map { '' } @{ $data{$fields[1]} };
+		}
+		else {
+			logError("No key '%s' found for function=3D'%s' table=3D'%s'",
+						$prikey, $function, $CGI::values{mv_data_table},
+						);
+			return undef;
+		}
+	}
+
+	my ($query,$i);
+	my (@k);
+	my (@v);
+	my (@c);
+	my (@rows_set);
+	my (@email_rows);
+
+	my $safe;
+	my $blob_field;
+	my $blob_nick;
+	my $blob_ptr;
+
+	# Fields to set in database despite mv_blob_only
+	my %blob_exception;
+
+	if($CGI::values{mv_blob_field} and $CGI::values{mv_blob_nick}) {
+#::logDebug("update_data: blob processing enabled");
+		$blob_field =3D $CGI::values{mv_blob_field};
+		$blob_nick  =3D $CGI::values{mv_blob_nick};
+		$blob_ptr   =3D $CGI::values{mv_blob_pointer};
+
+		%blob_exception   =3D
+				map { ($_, 1) } split /[\s,\0]+/, $CGI::values{mv_blob_exception};
+
+		if( ! $base_db->column_exists($blob_field) ) {
+			undef $blob_field;
+			undef $blob_nick;
+			logError("No blob field '%s' found for table=3D'%s', skipping blob save=
",
+						$CGI::values{mv_blob_field}, $CGI::values{mv_data_table},
+						);
+		}
+		elsif ($MVSAFE::Safe) {
+			$safe =3D $Vend::Interpolate::ready_safe;
+		}
+		else {
+			$safe =3D new Safe;
+		}
+		$base_db->column_exists($blob_ptr)
+			or undef $blob_ptr;
+#::logDebug("update_data: blob safe object=3D$safe");
+	}
+
+	my @multis;
+	if($CGI::values{mv_data_multiple}) {
+		my $re =3D qr/^\d+_$prikey$/;
+		@multis =3D grep $_ =3D~ $re, @cgi_keys;
+		for(@multis) {
+			s/_.*//;
+		}
+		@multis =3D sort { $a <=3D> $b } @multis;
+	}
+
+#::logDebug("update_data:db=3D$db key=3D$prikey VALUES=3D" . ::uneval(\%CG=
I::values));
+#::logDebug("update_data:db=3D$db key=3D$prikey data=3D" . ::uneval(\%data=
));
+	my $select_key;
+ SETDATA: {
+	for($i =3D 0; $i < @{$data{$prikey}}; $i++) {
+#::logDebug("iteration of update_data:db=3D$db key=3D$prikey data=3D" . ::=
uneval(\%data));
+		@k =3D (); @v =3D ();
+		for(keys %data) {
+#::logDebug("iteration of field $_");
+
+			next unless (length($value =3D $data{$_}->[$i]) || $CGI::values{mv_upda=
te_empty} );
+			push(@k, $_);
+# LEGACY
+			HTML::Entities::decode($value) if $decode;
+# END LEGACY
+			if($CGI::values{"mv_data_filter_$_"}) {
+				$value =3D Vend::Interpolate::filter_value(
+							 $CGI::values{"mv_data_filter_$_"},
+							 $value,
+							 $i,
+							 );
+			}
+			$select_key =3D $value if $_ eq $prikey;
+			push(@v, $value);
+		}
+
+		if(! length($select_key) ) {
+			next if  defined $CGI::values{mv_update_empty_key}
+					 and   ! $CGI::values{mv_update_empty_key};
+		}
+
+		if($function eq 'delete') {
+			$base_db->delete_record($select_key);
+		}
+		else {
+			my $field;
+			$key =3D $data{$prikey}->[$i];
+			if(! length($key) and $autonumber) {
+				## KEY IS possibly SET HERE=20
+				$key =3D $base_db->set_row($key);
+			}
+			push(@rows_set, $key);
+
+			# allow form submissions to go to database and to mail
+			if ($CGI::values{mv_data_email}) {
+				push( @email_rows,
+					[ errmsg("### Form Submission from %s", $key), $blob_nick, ],
+					[ $prikey, $key, ],
+				);
+			}
+
+			my $qd =3D {};
+			my $qf =3D {};
+			my $qv =3D {};
+			my $qret;
+
+			my $blob;
+			my $brec;
+			if($blob_field) {
+				my $string =3D $base_db->field($key, $blob_field);
+#::logDebug("update_data: blob string=3D$string");
+				$blob =3D $safe->reval($string);
+#::logDebug("update_data: blob object=3D$blob");
+				$blob =3D {} unless ref($blob) eq 'HASH';
+				$brec =3D $blob;
+				my @keys =3D split /::/, $blob_nick;
+				for(@keys) {
+					unless ( ref($brec->{$_}) eq 'HASH') {
+						$brec->{$_} =3D {};
+					}
+					$brec =3D $brec->{$_};
+				}
+			}
+			while($field =3D shift @k) {
+				$value =3D shift @v;
+				next if $field eq $prikey;
+=09=09=09=09
+				## DATA IS SET HERE
+				# We are going to set the field unless it is only for
+				# storing in a blob (and possibly emailing)
+				my  ($d, $f);
+				if ($CGI::values{mv_blob_only} and ! $blob_exception{$field}) {
+#::logDebug("$field not storing, only blob");
+					$f =3D $field;
+				}
+				else {
+#::logDebug("storing d=3D$d $field blob_only=3D$CGI::values{mv_blob_only}"=
);
+					($d, $f) =3D set_db($base_db, $field);
+#::logDebug("storing table=3D$table d=3D$d f=3D$f key=3D$key");
+					if(! defined $qd->{$d}) {
+						$qd->{$d} =3D $d;
+						$qf->{$d} =3D [$f];
+						$qv->{$d} =3D [$value];
+					}
+					else {
+						push @{$qf->{$d}}, $f;
+						push @{$qv->{$d}}, $value;
+					}
+					#$d->set_field($key, $f, $value);
+				}
+
+				push(@email_rows, [$f, $value])
+					if $CGI::values{mv_data_email};
+#::logDebug("update_data:db=3D$d key=3D$key field=3D$f value=3D$value");
+				$brec->{$f} =3D $value if $brec;
+			}
+
+			for(keys %$qd) {
+				$qret =3D $qd->{$_}->set_slice($key, $qf->{$_}, $qv->{$_});
+				$rows_set[$i] =3D $qret unless $rows_set[$i];
+			}
+			if($blob) {
+				$brec->{mv_data_fields} =3D join " ", @fields;
+				my $string =3D  uneval_it($blob);
+#::logDebug("update_data: blob saving string=3D$string");
+				$base_db->set_field($key, $blob_field, $string);
+				if($blob_ptr) {
+					$base_db->set_field($key, $blob_ptr, $blob_nick);
+				}
+			}
+			push(
+					@email_rows,
+					[ errmsg("### END FORM SUBMISSION %s", $key), $blob_nick, ]
+				)
+				if $CGI::values{mv_data_email};
+		}
+	}
+	if(my $new =3D shift(@multis)) {
+#::logDebug("Doing multi for $new");
+		last SETDATA unless length $CGI::values{"${new}_$prikey"};
+		for(@fields) {
+			my $value =3D $CGI::values{$_} =3D $CGI::values{"${new}_$_"};
+			$data{$_} =3D [ $value ];
+		}
+		redo SETDATA;
+	}
+ } # end SETDATA
+
+	if($CGI::values{mv_data_return_key}) {
+		my @keys =3D split /\0/, $CGI::values{mv_data_return_key};
+		for(@keys) {
+#::logDebug("return_key, setting $_");
+			$CGI::values{$_} =3D join("\0", @rows_set);
+		}
+	}
+
+	if($CGI::values{mv_auto_export}) {
+		Vend::Data::export_database($table);
+	}
+
+	if($CGI::values{mv_data_email}) {
+		push @email_rows, [ 'mv_data_fields', \@fields ];
+		Vend::Interpolate::tag_mail('', { log_error =3D> 1 }, \@email_rows);
+	}
+
+	# Allow setting in one then returning to another
+	if($CGI::values{mv_return_table}) {
+		$CGI::values{mv_data_table} =3D $CGI::values{mv_return_table};
+	}
+
+	my @reloads =3D grep /^mv_data_table__\d+$/, keys %CGI::values;
+	if(@reloads) {
+		@reloads =3D map { m/.*__(\d+)$/; $1 } @reloads;
+		@reloads =3D sort { $a <=3D> $b } @reloads;
+		my $new =3D shift @reloads;
+		my $this =3D qr{__$new$};
+		my $some =3D qr{__\d+$};
+#::logDebug("Reloading, new=3D$new this=3D$this some=3D$some");
+		my %cgiset;
+		my @death_row;
+		for(@cgi_keys) {
+			push(@death_row, $_), next unless $_ =3D~ $some;
+			if($_ =3D~ $this) {
+				my $k =3D $_;
+				$k =3D~ s/$this//;
+				$cgiset{$k} =3D delete $CGI::values{$_};
+			}
+		}
+
+		$::Scratch->{mv_data_enable} =3D delete $::Scratch->{"mv_data_enable__$n=
ew"};
+		delete $::Scratch->{mv_data_enable_key};
+
+		for(@death_row) {
+			next unless /^mv_(data|blob|update)_/ or $data{$_}; # Reprieve!
+			delete $CGI::values{$_};
+		}
+
+		@CGI::values{keys %cgiset} =3D values %cgiset;
+		update_data();
+	}
+
+	return;
+}
+
+*dbref =3D \&database_exists_ref;
=20
 1;
=20



2.5       +7 -7      interchange/lib/Vend/Error.pm


rev 2.5, prev_rev 2.4
Index: Error.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Error.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- Error.pm	21 Jul 2002 01:15:02 -0000	2.4
+++ Error.pm	16 Sep 2002 23:06:31 -0000	2.5
@@ -1,6 +1,6 @@
 # Vend::Error - Handle Interchange error pages and messages
 #=20
-# $Id: Error.pm,v 2.4 2002/07/21 01:15:02 mheins Exp $
+# $Id: Error.pm,v 2.5 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -37,7 +37,7 @@
=20
 use vars qw/$VERSION/;
=20
-$VERSION =3D substr(q$Revision: 2.4 $, 10);
+$VERSION =3D substr(q$Revision: 2.5 $, 10);
=20
 sub get_locale_message {
 	my ($code, $message, @arg) =3D @_;
@@ -112,7 +112,7 @@
 	my $out =3D '';
 	if($portion) {
 		$out .=3D "###### SESSION ($portion) #####\n";
-		$out .=3D ::uneval($Vend::Session->{$portion});
+		$out .=3D uneval($Vend::Session->{$portion});
 		$out .=3D "\n###### END SESSION    #####\n";
 		$out =3D~ s/\0/\\0/g;
 		return $out;
@@ -122,17 +122,17 @@
 	local($Data::Dumper::Indent) =3D 2;
 	$out .=3D "###### ENVIRONMENT     #####\n";
 	if(my $h =3D ::http()) {
-		$out .=3D ::uneval($h->{env});
+		$out .=3D uneval($h->{env});
 	}
 	else {
-		$out .=3D ::uneval(\%ENV);
+		$out .=3D uneval(\%ENV);
 	}
 	$out .=3D "\n###### END ENVIRONMENT #####\n";
 	$out .=3D "###### CGI VALUES      #####\n";
-	$out .=3D ::uneval(\%CGI::values);
+	$out .=3D uneval(\%CGI::values);
 	$out .=3D "\n###### END CGI VALUES  #####\n";
 	$out .=3D "###### SESSION         #####\n";
-	$out .=3D ::uneval($Vend::Session);
+	$out .=3D uneval($Vend::Session);
 	$out .=3D "\n###### END SESSION    #####\n";
 	$out =3D~ s/\0/\\0/g;
 	return $out;



2.110     +107 -107  interchange/lib/Vend/Interpolate.pm


rev 2.110, prev_rev 2.109
Index: Interpolate.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.109
retrieving revision 2.110
diff -u -r2.109 -r2.110
--- Interpolate.pm	7 Sep 2002 18:45:41 -0000	2.109
+++ Interpolate.pm	16 Sep 2002 23:06:31 -0000	2.110
@@ -1,6 +1,6 @@
 # Vend::Interpolate - Interpret Interchange tags
 #=20
-# $Id: Interpolate.pm,v 2.109 2002/09/07 18:45:41 mheins Exp $
+# $Id: Interpolate.pm,v 2.110 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -27,7 +27,7 @@
 require Exporter;
 @ISA =3D qw(Exporter);
=20
-$VERSION =3D substr(q$Revision: 2.109 $, 10);
+$VERSION =3D substr(q$Revision: 2.110 $, 10);
=20
 @EXPORT =3D qw (
=20
@@ -455,7 +455,7 @@
 	## If post_page routine processor returns true, return. Otherwise,
 	## continue image rewrite
 	if($::Pragma->{post_page}) {
-		::run_macro($::Pragma->{post_page}, $text)
+		Vend::Dispatch::run_macro($::Pragma->{post_page}, $text)
 			and return;
 	}
=20
@@ -524,7 +524,7 @@
 	$parse->parse($html);
 	while($parse->{_buf}) {
 		substitute_image(\$parse->{OUT});
-		::response( \$parse->{OUT});
+		Vend::Dispatch::response( \$parse->{OUT});
 		$full .=3D $parse->{OUT};
 		$parse->{OUT} =3D '';
 		$parse->parse('');
@@ -586,7 +586,7 @@
 	undef $Vend::PageInit unless $::Pragma->{init_page};
=20
 	if(defined $Vend::PageInit and ! $Vend::PageInit++) {
-		::run_macro($::Pragma->{init_page}, $html);
+		Vend::Dispatch::run_macro($::Pragma->{init_page}, $html);
 	}
=20
 	# Substitute in Variable values
@@ -605,7 +605,7 @@
 	}
=20
 	if($::Pragma->{pre_page}) {
-		::run_macro($::Pragma->{pre_page}, $html);
+		Vend::Dispatch::run_macro($::Pragma->{pre_page}, $html);
 	}
=20
 	# Strip out [comment] [/comment] blocks
@@ -629,7 +629,7 @@
 	defined $::Variable->{MV_AUTOLOAD}
 		and $html =3D~ s/^/$::Variable->{MV_AUTOLOAD}/;
=20
-#::logDebug("opt=3D" . ::uneval($opt));
+#::logDebug("opt=3D" . uneval($opt));
 	vars_and_comments(\$html)
 		unless $opt and $opt->{onfly};
=20
@@ -679,7 +679,7 @@
 			next;
 		}
 		unless (defined $Filter{$_}) {
-			::logError ("Unknown filter '%s'", $_);
+			logError ("Unknown filter '%s'", $_);
 			next;
 		}
 		unshift @args, $value, $tag;
@@ -784,7 +784,7 @@
 				return $db->delete_column($field, $opt->{value});
 			}
 			else {
-				::logError("alter function '%s' not found", $opt->{alter});
+				logError("alter function '%s' not found", $opt->{alter});
 				return undef;
 			}
 		}
@@ -999,7 +999,7 @@
 				},
 	'crypt' =3D> sub {
 					my $val =3D shift;
-					return crypt($val, ::random_string(2));
+					return crypt($val, random_string(2));
 				},
 	'html2text' =3D> sub {
 					my $val =3D shift;
@@ -1125,7 +1125,7 @@
=20
 	loc =3D> sub {
 					my $val =3D shift;
-					return ::errmsg($val);
+					return errmsg($val);
 				},
=20
 	restrict_html =3D> sub {
@@ -1147,7 +1147,7 @@
=20
 sub input_filter_do {
 	my($varname, $opt, $routine) =3D @_;
-#::logDebug("filter var=3D$varname opt=3D" . ::uneval_it($opt));
+#::logDebug("filter var=3D$varname opt=3D" . uneval_it($opt));
 	return undef unless defined $CGI::values{$varname};
 #::logDebug("before filter=3D$CGI::values{$varname}");
 	$routine =3D $opt->{routine} || ''
@@ -1345,7 +1345,7 @@
 	elsif($base eq 'validcc') {
 		$CacheInvalid =3D 1;
 		no strict 'refs';
-		$status =3D ::validate_whole_cc($term, $operator, $comp);
+		$status =3D Vend::Order::validate_whole_cc($term, $operator, $comp);
 	}
     elsif($base eq 'config') {
 		$op =3D qq%$Vend::Cfg->{$term}%;
@@ -1515,7 +1515,7 @@
=20
 sub tag_profile {
 	my($profile, $opt) =3D @_;
-#::logDebug("in tag_profile=3D$profile opt=3D" . ::uneval_it($opt));
+#::logDebug("in tag_profile=3D$profile opt=3D" . uneval_it($opt));
=20
 	$opt =3D {} if ! $opt;
 	my $tag =3D $opt->{tag} || 'default';
@@ -1543,7 +1543,7 @@
 	}
=20
 	if( "$profile$tag" =3D~ /\W/ ) {
-		::logError(
+		logError(
 			"profile: invalid characters (tag=3D%s profile=3D%s), must be [A-Za-z_]=
+",
 			$tag,
 			$profile,
@@ -1555,7 +1555,7 @@
 #::logDebug("running profile=3D$profile tag=3D$tag");
 		my $prof =3D $Vend::Cfg->{Profile_repository}{$profile};
 	    if (not $prof) {
-			::logError( "profile %s (%s) non-existant.", $profile, $tag );
+			logError( "profile %s (%s) non-existant.", $profile, $tag );
 			return $opt->{failure};
 		}=20
 #::logDebug("found profile=3D$profile");
@@ -1586,10 +1586,10 @@
 			}
 			}
 			else {
-				::logError( "profile: cannot handle object of type %s.",
+				logError( "profile: cannot handle object of type %s.",
 							$Vend::Cfg->{$one},
 							);
-				::logError("profile: profile for $one not changed.");
+				logError("profile: profile for $one not changed.");
 				next;
 			}
=20
@@ -1597,7 +1597,7 @@
 			$val =3D $ready_safe->reval($string) if $string;
=20
 			if($@) {
-				::logError( "profile: bad object %s: %s", $one, $string );
+				logError( "profile: bad object %s: %s", $one, $string );
 				next;
 			}
 			$Vend::Session->{Profile_save}{$one} =3D $Vend::Cfg->{$one}
@@ -1627,7 +1627,7 @@
 	}
 	$al =3D [] if ! $al;
 	push @$al, "$tag-$profile";
-#::logDebug("profile=3D$profile Autoload=3D" . ::uneval_it($al));
+#::logDebug("profile=3D$profile Autoload=3D" . uneval_it($al));
 	$Vend::Session->{Autoload} =3D $al;
=20
 	return $opt->{success};
@@ -1931,7 +1931,7 @@
 			or next;
 		my @new =3D $1 .. $2;
 		if(@new > $max) {
-			::logError(
+			logError(
 				"Refuse to add %d options to option list via range, max %d.",
 				scalar(@new),
 				$max,
@@ -1959,7 +1959,7 @@
 	}
=20
 	# Had extra if got here
-#::logDebug("tag_accessories: code=3D$code opt=3D" . ::uneval_it($opt) . "=
 item=3D" . ::uneval_it($item) . " extra=3D$extra");
+#::logDebug("tag_accessories: code=3D$code opt=3D" . uneval_it($opt) . " i=
tem=3D" . uneval_it($item) . " extra=3D$extra");
 	my($attribute, $type, $field, $db, $name, $outboard, $passed);
 	$opt =3D {} if ! $opt;
 	if($extra) {
@@ -2034,22 +2034,22 @@
 sub tag_perl {
 	my ($tables, $opt,$body) =3D @_;
 	my ($result,@share);
-#::logDebug("tag_perl MVSAFE=3D$MVSAFE::Safe opts=3D" . ::uneval($opt));
+#::logDebug("tag_perl MVSAFE=3D$MVSAFE::Safe opts=3D" . uneval($opt));
=20
 	if($Vend::NoInterpolate) {
-		::logGlobal({ level =3D> 'alert' },
+		logGlobal({ level =3D> 'alert' },
 					"Attempt to interpolate perl/ITL from RPC, no permissions."
 					);
 		return undef;
 	}
=20
 	if ($MVSAFE::Safe) {
-		::logGlobal({ level =3D> 'alert' }, "Attempt to call perl from within Sa=
fe.");
+		logGlobal({ level =3D> 'alert' }, "Attempt to call perl from within Safe=
");
 		return undef;
 	}
=20
-#::logDebug("tag_perl: tables=3D$tables opt=3D" . ::uneval($opt) . " body=
=3D$body");
-#::logDebug("tag_perl initialized=3D$Vend::Calc_initialized: carts=3D" . :=
:uneval($::Carts));
+#::logDebug("tag_perl: tables=3D$tables opt=3D" . uneval($opt) . " body=3D=
$body");
+#::logDebug("tag_perl initialized=3D$Vend::Calc_initialized: carts=3D" . u=
neval($::Carts));
 	if($opt->{subs} || (defined $opt->{arg} and $opt->{arg} =3D~ /\bsub\b/)) {
 		no strict 'refs';
 		for(keys %{$Global::GlobalSub}) {
@@ -2097,7 +2097,7 @@
 	if($Vend::Cfg->{Tie_Watch}) {
 		eval {
 			for(@{$Vend::Cfg->{Tie_Watch}}) {
-				::logGlobal("touching $_");
+				logGlobal("touching $_");
 				my $junk =3D $Config->{$_};
 			}
 		};
@@ -2167,7 +2167,7 @@
         }
 		return $opt->{failure};
 	}
-#::logDebug("tag_perl initialized=3D$Vend::Calc_initialized: carts=3D" . :=
:uneval($::Carts));
+#::logDebug("tag_perl initialized=3D$Vend::Calc_initialized: carts=3D" . u=
neval($::Carts));
=20
 	if ($opt->{no_return}) {
 		$Vend::Session->{mv_perl_result} =3D $result;
@@ -2223,7 +2223,7 @@
 	my $fmt =3D $opt->{status} || '';
 	my @status;
=20
-#::logDebug("tag flag=3D$flag text=3D$text value=3D$value opt=3D". ::uneva=
l_it($opt));
+#::logDebug("tag flag=3D$flag text=3D$text value=3D$value opt=3D". uneval_=
it($opt));
 	if($flag eq 'write' || $flag eq 'read') {
 		my $arg =3D $opt->{table} || $text;
 		$value =3D 0 if $flag eq 'read';
@@ -2279,11 +2279,11 @@
 			next unless $db->isopen();
 			next unless $db->config('Transactions');
 			if( ! $db ) {
-				::logError("attempt to $method on unknown database: %s", $dbname);
+				logError("attempt to $method on unknown database: %s", $dbname);
 				return undef;
 			}
 			if( ! $db->$method() ) {
-				::logError("problem doing $method for table: %s", $dbname);
+				logError("problem doing $method for table: %s", $dbname);
 				return undef;
 			}
 		}
@@ -2347,7 +2347,7 @@
=20
 	my $out;
=20
-#::logDebug("mime call, opt=3D" . ::uneval($opt));
+#::logDebug("mime call, opt=3D" . uneval($opt));
 	$Vend::TIMESTAMP =3D POSIX::strftime("%y%m%d%H%M%S", localtime())
 		unless defined $Vend::TIMESTAMP;
=20
@@ -2551,7 +2551,7 @@
 							my $table =3D shift;
 							my $opt =3D shift;
 							$opt->{search} =3D "ra=3Dyes\nst=3Ddb\nml=3D100000\nfi=3D$table";
-#::logDebug("tag each: table=3D$table opt=3D" . ::uneval($opt));
+#::logDebug("tag each: table=3D$table opt=3D" . uneval($opt));
 							return tag_loop_list('', $opt, shift);
 						},
 			MIME	=3D> \&mime,
@@ -2560,10 +2560,10 @@
=20
 sub do_tag {
 	my $op =3D uc $_[0];
-#::logDebug("tag op: op=3D$op opt=3D" . ::uneval(\@_));
+#::logDebug("tag op: op=3D$op opt=3D" . uneval(\@_));
 	return $_[3] if !  defined $Tag_op_map{$op};
 	shift;
-#::logDebug("tag args now: op=3D$op opt=3D" . ::uneval(\@_));
+#::logDebug("tag args now: op=3D$op opt=3D" . uneval(\@_));
 	return &{$Tag_op_map{$op}}(@_);
 }
=20
@@ -2704,14 +2704,14 @@
 			}
 		}
 		if($opt->{maxsize} and length($CGI::file{$var}) > $opt->{maxsize}) {
-			::logError(
+			logError(
 				"Uploaded file write of %s bytes greater than maxsize %s. Aborted.",
 				length($CGI::file{$var}),
 				$opt->{maxsize},
 			);
 			return $opt->{no} || '';
 		}
-#::logDebug(">$file \$CGI::file{$var}" . ::uneval($opt));=20
+#::logDebug(">$file \$CGI::file{$var}" . uneval($opt));=20
 		Vend::Util::writefile(">$file", \$CGI::file{$var}, $opt)
 			and return $opt->{yes} || '';
 		return $opt->{'no'} || '';
@@ -2743,7 +2743,7 @@
 		@ary =3D @$val;
 	}
 	else {
-		::logError( "value-extended %s: passed non-scalar, non-array object", $v=
ar);
+		logError( "value-extended %s: passed non-scalar, non-array object", $var=
);
 	}
=20
 	return join " ", 0 .. $#ary if $opt->{elements};
@@ -2751,7 +2751,7 @@
 	eval {
 		@ary =3D @ary[$ready_safe->reval( $index eq '*' ? "0 .. $#ary" : $index =
)];
 	};
-	::logError("value-extended $var: bad index") if $@;
+	logError("value-extended $var: bad index") if $@;
=20
 	if($opt->{filter}) {
 		for(@ary) {
@@ -2764,7 +2764,7 @@
 sub format_auto_transmission {
 	my $ref =3D shift;
=20
-	## Auto-transmission from ::update_data
+	## Auto-transmission from Vend::Data::update_data
 	## Looking for structure like:
 	##
 	##	[ '### BEGIN submission from', 'ckirk' ],
@@ -2842,13 +2842,13 @@
=20
 	unless($opt->{raw}) {
 		for my $header (@todo) {
-			::logError("invalid email header: %s", $header)
+			logError("invalid email header: %s", $header)
 				if $header =3D~ /[^-\w]/;
 			my $key =3D lc $header;
 			$key =3D~ tr/-/_/;
 			my $val =3D $opt->{$key} || $setsub->($key);=20
 			if($key eq 'subject' and ! length($val) ) {
-				$val =3D ::errmsg('<no subject>');
+				$val =3D errmsg('<no subject>');
 			}
 			next unless length $val;
 			$found{$key} =3D $val;
@@ -2915,7 +2915,7 @@
 # Returns the text of a user entered field named VAR.
 sub tag_value {
     my($var,$opt) =3D @_;
-#::logDebug("called value args=3D" . ::uneval(\@_));
+#::logDebug("called value args=3D" . uneval(\@_));
     my($value);
=20
 	local($^W) =3D 0;
@@ -2972,8 +2972,8 @@
 			$scan =3D Vend::Scan::sql_statement($scan, $ref || \%CGI::values)
 		};
 		if($@) {
-			my $msg =3D ::errmsg("SQL query failed: %s\nquery was: %s", $@, $scan);
-			::logError($msg);
+			my $msg =3D errmsg("SQL query failed: %s\nquery was: %s", $@, $scan);
+			logError($msg);
 			$scan =3D 'se=3DBAD_SQL';
 		}
 	}
@@ -3192,7 +3192,7 @@
 	my($body) =3D @_;
 	my $result;
 	if($Vend::NoInterpolate) {
-		::logGlobal({ level =3D> 'alert' },
+		logGlobal({ level =3D> 'alert' },
 					"Attempt to interpolate perl/ITL from RPC, no permissions."
 					);
 	}
@@ -3287,7 +3287,7 @@
 				 $_[1] =3D~ s:^/(.*)/$:$1:;
    				 eval { $re =3D qr/$_[1]/ };
 				 if($@) {
-					::logError("bad regex %s in if-PREFIX-data", $_[1]);
+					logError("bad regex %s in if-PREFIX-data", $_[1]);
 					return undef;
 				 }
 				 return $_[0] =3D~ $re;
@@ -3297,7 +3297,7 @@
 				 $_[1] =3D~ s:^/(.*)/$:$1:;
    				 eval { $re =3D qr/$_[1]/ };
 				 if($@) {
-					::logError("bad regex %s in if-PREFIX-data", $_[1]);
+					logError("bad regex %s in if-PREFIX-data", $_[1]);
 					return undef;
 				 }
 				 return $_[0] !~ $re;
@@ -3310,7 +3310,7 @@
 	my ($op, $rhs) =3D split /\s+/, $cond;
 	$rhs =3D~ s/^(["'])(.*)\1$/$2/;
 	if(! defined $cond_op{$op} ) {
-		::logError("bad conditional operator %s in if-PREFIX-data", $op);
+		logError("bad conditional operator %s in if-PREFIX-data", $op);
 		return pull_else($string, $reverse);
 	}
 	return 	$cond_op{$op}->($lhs, $rhs)
@@ -3368,7 +3368,7 @@
     my($opts, $list) =3D (@_);=20
     $opts =3D~ s/^\s+//;=20
     $opts =3D~ s/\s+$//;=20
-#::logDebug("tag_sort_ary: opts=3D$opts list=3D" . ::uneval($list));
+#::logDebug("tag_sort_ary: opts=3D$opts list=3D" . uneval($list));
 	my @codes;
 	my $key =3D 0;
=20
@@ -3441,7 +3441,7 @@
 	if(defined $num) {
 		splice(@codes, $num);
 	}
-#::logDebug("tag_sort_ary routine returns: " . ::uneval(\@codes));
+#::logDebug("tag_sort_ary routine returns: " . uneval(\@codes));
 	return \@codes;
 }
=20
@@ -3449,7 +3449,7 @@
     my($opts, $list) =3D (@_);=20
     $opts =3D~ s/^\s+//;=20
     $opts =3D~ s/\s+$//;=20
-#::logDebug("tag_sort_hash: opts=3D$opts list=3D" . ::uneval($list));
+#::logDebug("tag_sort_hash: opts=3D$opts list=3D" . uneval($list));
 	my @codes;
 	my $key =3D 'code';
=20
@@ -3489,7 +3489,7 @@
  	}
=20
 	if (! defined $list->[0]->{$key}) {
-		::logError("sort key '$key' not defined in list. Skipping sort.");
+		logError("sort key '$key' not defined in list. Skipping sort.");
 		return $list;
 	}
=20
@@ -3527,7 +3527,7 @@
 	if(defined $num) {
 		splice(@codes, $num);
 	}
-#::logDebug("tag_sort_hash routine returns: " . ::uneval(\@codes));
+#::logDebug("tag_sort_hash routine returns: " . uneval(\@codes));
 	return \@codes;
 }
=20
@@ -3723,7 +3723,7 @@
 			$first_anchor =3D $1;
 		}
 		else {
-			$first_anchor =3D ::errmsg('First');
+			$first_anchor =3D errmsg('First');
 		}
 		unless ($first_anchor eq 'none') {
 			$arg =3D $session;
@@ -3738,7 +3738,7 @@
 				$prev_anchor =3D $1;
 			}
 			else {
-				$prev_anchor =3D ::errmsg('Previous');
+				$prev_anchor =3D errmsg('Previous');
 			}
 		}
 		elsif ($prev_anchor ne 'none') {
@@ -3766,7 +3766,7 @@
 				$next_anchor =3D $1;
 			}
 			else {
-				$next_anchor =3D ::errmsg('Next');
+				$next_anchor =3D errmsg('Next');
 			}
 		}
 		else {
@@ -3782,7 +3782,7 @@
 			$last_anchor =3D $1;
 		}
 		else {
-			$last_anchor =3D ::errmsg('Last');
+			$last_anchor =3D errmsg('Last');
 		}
 		unless ($last_anchor eq 'none') {
 			$last =3D $total - 1;
@@ -3809,7 +3809,7 @@
=20
 	$page_anchor =3D~ s/\$(MIN|MAX)?PAGE\$/__${1}PAGE__/g;
=20
-	my $more_string =3D ::errmsg('more');
+	my $more_string =3D errmsg('more');
 	my ($decade_next, $decade_prev, $decade_div);
 	if( $q->{mv_more_decade} or $r =3D~ m:\[decade[-_]next\]:) {
 		$r =3D~ s:\[decade[-_]next\]($All)\[/decade[-_]next\]::i
@@ -4005,7 +4005,7 @@
 	$Safe_data =3D 1 if $opt->{safe_data};
=20
 #	if($opt->{prefix} eq 'item') {
-#::logDebug("labeled list: opt:\n" . ::uneval($opt) . "\nobj:" . ::uneval(=
$obj) . "text:" . substr($text,0,100));
+#::logDebug("labeled list: opt:\n" . uneval($opt) . "\nobj:" . uneval($obj=
) . "text:" . substr($text,0,100));
 #	}
 	$Orig_prefix =3D $Prefix =3D $opt->{prefix} || 'item';
=20
@@ -4125,7 +4125,7 @@
 	if(! ref $hash) {
 		$hash =3D string_to_ref($hash);
 		if($@) {
-			::logDebug("eval error: $@");
+			logDebug("eval error: $@");
 		}
 		return undef if ! ref $hash;
 	}
@@ -4198,7 +4198,7 @@
 		%$addr =3D %{ $::Values };
 	}
=20
-#::logDebug("addr=3D" . ::uneval($addr));
+#::logDebug("addr=3D" . uneval($addr));
=20
 	$addr->{mv_an} =3D $nick;
 	my @nick =3D sort keys %$blob;
@@ -4358,7 +4358,7 @@
 	}
 	else {
 		$attrhash->{body} =3D $this_tag unless defined $attrhash->{body};
-#::logDebug("calling do_tag tag=3D$tag this_tag=3D$this_tag attrhash=3D" .=
 ::uneval($attrhash));
+#::logDebug("calling do_tag tag=3D$tag this_tag=3D$this_tag attrhash=3D" .=
 uneval($attrhash));
 		$Tag ||=3D new Vend::Tags;
 		$out =3D $Tag->$tag($attrhash);
 	}
@@ -4461,7 +4461,7 @@
=20
 	my ($run, $row, $code, $return);
 my $once =3D 0;
-#::logDebug("iterating array $i to $end. count=3D$count opt_select=3D$opt_=
select ary=3D" . ::uneval($ary));
+#::logDebug("iterating array $i to $end. count=3D$count opt_select=3D$opt_=
select ary=3D" . uneval($ary));
 	if($text =3D~ m/^$B$QR{_line}\s*$/is) {
 		my $i =3D $1 || 0;
 		my $count =3D scalar values %$fh;
@@ -4474,7 +4474,7 @@
 		my $name =3D $1;
 		my $routine =3D $2;
 		## Not necessary?
-		## $Vend::Cfg->{Sub}{''} =3D sub { ::errmsg('undefined sub') }
+		## $Vend::Cfg->{Sub}{''} =3D sub { errmsg('undefined sub') }
 		##	unless defined $Vend::Cfg->{Sub}{''};
 		$routine =3D 'sub { ' . $routine . ' }' unless $routine =3D~ /^\s*sub\s*=
{/;
 		my $sub;
@@ -4482,8 +4482,8 @@
 			$sub =3D $ready_safe->reval($routine);
 		};
 		if($@) {
-			::logError( ::errmsg("syntax error on %s-sub %s]: $@", $B, $name) );
-			$sub =3D sub { ::errmsg('ERROR') };
+			logError( errmsg("syntax error on %s-sub %s]: $@", $B, $name) );
+			$sub =3D sub { errmsg('ERROR') };
 		}
 #::logDebug("sub $name: $sub --> $routine");
 		$Vend::Cfg->{Sub}{$name} =3D $sub;
@@ -4520,9 +4520,9 @@
 	$run =3D $text;
 	if(! $opt->{ignore_undefined}) {
 	$run =3D~ s#$B$QR{_param}# defined $fh->{$1} ||
-		::logOnce(@field_msg, $1, "$Orig_prefix-param") #ige;
+		logOnce(@field_msg, $1, "$Orig_prefix-param") #ige;
 	$run =3D~ s#$IB$QR{_param_if}# defined $fh->{$3} ||
-		::logOnce(@field_msg, $3, "if-$Orig_prefix-param") #ige;
+		logOnce(@field_msg, $3, "if-$Orig_prefix-param") #ige;
 	}
=20
 	for( ; $i <=3D $end ; $i++, $count++ ) {
@@ -4548,7 +4548,7 @@
 						?	pull_if($5,$2,$4,$row->[$3])
 						:	pull_else($5,$2,$4,$row->[$3])#ige;
 	    $run =3D~ s#$B$QR{_pos}#ed($row->[$1])#ige;
-#::logDebug("fh: " . ::uneval($fh) . ::uneval($row)) unless $once++;
+#::logDebug("fh: " . uneval($fh) . uneval($row)) unless $once++;
 		1 while $run =3D~ s#$IB$QR{_field_if}$IE[-_]field\1\]#
 				  my $tmp =3D product_field($3, $code);
 				  $tmp	?	pull_if($5,$2,$4,$tmp)
@@ -4626,12 +4626,12 @@
=20
 	$nc and local(@Hash_code{keys %$nc}) =3D values %$nc;
=20
-#::logDebug("iterating hash $i to $end. count=3D$count opt_select=3D$opt_s=
elect hash=3D" . ::uneval($hash));
+#::logDebug("iterating hash $i to $end. count=3D$count opt_select=3D$opt_s=
elect hash=3D" . uneval($hash));
 	while($text =3D~ s#$B$QR{_sub}$E$QR{'/_sub'}##i) {
 		my $name =3D $1;
 		my $routine =3D $2;
 		## Not necessary?
-		## $Vend::Cfg->{Sub}{''} =3D sub { ::errmsg('undefined sub') }
+		## $Vend::Cfg->{Sub}{''} =3D sub { errmsg('undefined sub') }
 		##	unless defined $Vend::Cfg->{Sub}{''};
 		$routine =3D 'sub { ' . $routine . ' }' unless $routine =3D~ /^\s*sub\s*=
{/;
 		my $sub;
@@ -4639,8 +4639,8 @@
 			$sub =3D $ready_safe->reval($routine);
 		};
 		if($@) {
-			::logError( ::errmsg("syntax error on %s-sub %s]: $@", $B, $name) );
-			$sub =3D sub { ::errmsg('ERROR') };
+			logError( errmsg("syntax error on %s-sub %s]: $@", $B, $name) );
+			$sub =3D sub { errmsg('ERROR') };
 		}
 		$Vend::Cfg->{Sub}{$name} =3D $sub;
 	}
@@ -4814,7 +4814,7 @@
 	my $msg =3D errmsg(@args);
 	$msg =3D "$opt->{error_id}: $msg" if $opt->{error_id};
 	if($opt->{log_error}) {
-		::logError($msg);
+		logError($msg);
 	}
 	return $msg if $opt->{show_error};
 	return undef;
@@ -5005,7 +5005,7 @@
 			find_search_params();
 			delete $CGI::values{mv_more_matches};
=20
-			#::logDebug("more object =3D " . ::uneval($c));
+#::logDebug("more object =3D " . uneval($c));
=20
 		}
 		elsif ($opt->{search}) {
@@ -5063,7 +5063,7 @@
 		$mprefix =3D "";
 	}
=20
-#::logDebug("region: opt:\n" . ::uneval($opt) . "\npage:" . substr($page,0=
,100));
+#::logDebug("region: opt:\n" . uneval($opt) . "\npage:" . substr($page,0,1=
00));
=20
 	if($opt->{ml} and ! defined $obj->{mv_matchlimit} ) {
 		$obj->{mv_matchlimit} =3D $opt->{ml};
@@ -5121,7 +5121,7 @@
 	$opt->{label}  =3D  "loop" . $List_it++ . $Global::Variable->{MV_PAGE}
 						unless defined $opt->{label};
=20
-#::logDebug("list is: " . ::uneval($list) );
+#::logDebug("list is: " . uneval($list) );
=20
 	## Thanks to Kaare Rasmussen for this suggestion
 	## about passing embedded Perl objects to a list
@@ -5135,9 +5135,9 @@
 	#	[loop list=3D`$Scratch->{ary}`] [loop-code]
 	#	[/loop]
 	if (ref $list) {
-#::logDebug("opt->list in: " . ::uneval($list) );
+#::logDebug("opt->list in: " . uneval($list) );
 		unless (ref $list eq 'ARRAY' and ref $list->[0] eq 'ARRAY') {
-			::logError("loop was passed invalid list=3D`...` argument");
+			logError("loop was passed invalid list=3D`...` argument");
 			return;
 		}
 		my ($ary, $fh, $fa) =3D @$list;
@@ -5199,7 +5199,7 @@
 				push @rows, [ $o, $l ];
 			}
 		};
-#::logDebug("rows:" . ::uneval(\@rows));
+#::logDebug("rows:" . uneval(\@rows));
 	}
 	elsif($opt->{quoted}) {
 #::logDebug("loop resolve quoted");
@@ -5220,7 +5220,7 @@
 	}
=20
 	if($@) {
-		::logError("bad split delimiter in loop list: $@");
+		logError("bad split delimiter in loop list: $@");
 #::logDebug("loop resolve error $@");
 	}
=20
@@ -5239,7 +5239,7 @@
 			mv_field_names =3D> $fn,
 	};
=20=09
-#::logDebug("loop object: " . ::uneval($opt));
+#::logDebug("loop object: " . uneval($opt));
 	return region($opt, $text);
 }
=20
@@ -5568,7 +5568,7 @@
 					$line[OPT]->{$k} =3D $v;
 				}
 			};
-			::logError(
+			logError(
 				"bad shipping index %s for mode %s in $file",
 				$k,
 				$line[0],
@@ -5580,7 +5580,7 @@
 		if @line;
=20
 	if($waiting) {
-		::logError(
+		logError(
 			"Failed to find end-of-line termination '%s' in shipping read",
 			$waiting,
 		);
@@ -5781,7 +5781,7 @@
 		if($saved_file) {
 			$file =3D $saved_file;
 			$file =3D~ s:^scan/::;
-			$file =3D ::generate_key($file);
+			$file =3D generate_key($file);
 			$file =3D "scan/$file";
 		}
 		else {
@@ -5812,7 +5812,7 @@
 		$opt->{umask} =3D '22' unless defined $opt->{umask};
         Vend::Util::writefile(">$file", $out, $opt );
 # STATICPAGE
-		if ($Vend::Cfg->{StaticDBM} and ::tie_static_dbm(1) ) {
+		if ($Vend::Cfg->{StaticDBM} and Vend::Session::tie_static_dbm(1) ) {
 			if ($opt->{scan}) {
 				$saved_file =3D~ s!=3D([^/]+)=3D!=3D$1%3d!g;
 				$saved_file =3D~ s!=3D([^/]+)-!=3D$1%2d!g;
@@ -5834,7 +5834,7 @@
 sub update {
 	my ($func, $opt) =3D @_;
 	if($func eq 'quantity') {
-		::update_quantity();
+		Vend::Order::update_quantity();
 	}
 	elsif($func eq 'cart') {
 		my $cart;
@@ -5848,13 +5848,13 @@
 		Vend::Cart::toss_cart($cart, $opt->{name});
 	}
 	elsif ($func eq 'process') {
-		::do_process();
+		Vend::Dispatch::do_process();
 	}
 	elsif ($func eq 'values') {
-		::update_user();
+		Vend::Dispatch::update_user();
 	}
 	elsif ($func eq 'data') {
-		::update_data();
+		Vend::Data::update_data();
 	}
 	return;
 }
@@ -5891,7 +5891,7 @@
 	else {
 		@bin =3D @$Vend::Items;
 	}
-#::logDebug("doing shipping, mode=3D$mode bin=3D" . ::uneval(\@bin));
+#::logDebug("doing shipping, mode=3D$mode bin=3D" . uneval(\@bin));
=20
 	$Vend::Session->{ship_message} =3D '' if $opt->{reset_message};
=20
@@ -5932,7 +5932,7 @@
 	my @lines;
 	@lines =3D grep $_->[0] =3D~ /^$mode/, @{$Vend::Cfg->{Shipping_line}};
 	goto SHIPFORMAT unless @lines;
-#::logDebug("shipping lines selected: " . ::uneval(\@lines));
+#::logDebug("shipping lines selected: " . uneval(\@lines));
 	my $q;
 	if($lines[0][QUERY]) {
 		my $q =3D interpolate_html($lines[0][QUERY]);
@@ -5941,7 +5941,7 @@
 		my $ary =3D query($q, { wantarray =3D> 1 });
 		if(ref $ary) {
 			@lines =3D @$ary;
-#::logDebug("shipping lines reselected with SQL: " . ::uneval(\@lines));
+#::logDebug("shipping lines reselected with SQL: " . uneval(\@lines));
 		}
 		else {
 #::logDebug("shipping lines failed reselect with SQL query '$q'");
@@ -5950,7 +5950,7 @@
=20
 	my $o =3D get_option_hash($lines[0][OPT]) || {};
=20
-#::logDebug("shipping opt=3D" . ::uneval($o));
+#::logDebug("shipping opt=3D" . uneval($o));
=20
 	if($o->{limit}) {
 		$o->{filter} =3D '(?i)\s*[1ty]' if ! $o->{filter};
@@ -5962,7 +5962,7 @@
=20
 	tag_cart('mv_shipping');
=20
-#::logDebug("Check 2, must get to FINAL. Vend::Items=3D" . ::uneval($Vend:=
:Items) . " main=3D" . ::uneval($::Carts->{main}) . " mv_shipping=3D" . ::u=
neval($::Carts->{mv_shipping}));
+#::logDebug("Check 2, must get to FINAL. Vend::Items=3D" . uneval($Vend::I=
tems) . " main=3D" . uneval($::Carts->{main}) . " mv_shipping=3D" . uneval(=
$::Carts->{mv_shipping}));
=20
 	if($o->{perl}) {
 		$Vend::Interpolate::Shipping   =3D $lines[0];
@@ -6189,7 +6189,7 @@
 		$Vend::Items =3D $save;
 #::logDebug("Check FINAL. Vend::Items=3D$Vend::Items main=3D$::Carts->{mai=
n}");
 		last SHIPFORMAT unless defined $final;
-#::logDebug("ship options: " . ::uneval($o) );
+#::logDebug("ship options: " . uneval($o) );
 		$final /=3D $Vend::Cfg->{PriceDivide}
 			if $o->{PriceDivide} and $Vend::Cfg->{PriceDivide} !=3D 0;
 		unless ($o->{free}) {
@@ -6219,7 +6219,7 @@
 		}
 		else {
 			return $final unless $opt->{label};
-#::logDebug("actual options: " . ::uneval($o));
+#::logDebug("actual options: " . uneval($o));
 			$number =3D Vend::Util::currency(=20
 											$final,
 											$opt->{noformat},
@@ -6423,7 +6423,7 @@
=20
 sub tax_vat {
 	my($type, $opt) =3D @_;
-#::logDebug("entering VAT, opts=3D" . ::uneval($opt));
+#::logDebug("entering VAT, opts=3D" . uneval($opt));
 	my $cfield =3D $::Variable->{MV_COUNTRY_FIELD} || 'country';
 	my $country =3D $opt->{country} || $::Values->{$cfield};
=20
@@ -6475,9 +6475,9 @@
 			$ary =3D $db->query($q);
 		};
 		if($@) {
-			::logError("error on state tax query %s", $q);
+			logError("error on state tax query %s", $q);
 		}
-#::logDebug("query returns " . ::uneval($ary));
+#::logDebug("query returns " . uneval($ary));
 		return 0 unless ref $ary;
 		for(@$ary) {
 			next unless $_->[0];
@@ -6515,7 +6515,7 @@
 	else {
 			$tax =3D Vend::Util::get_option_hash($t);
 	}
-#::logDebug("tax hash=3D" . ::uneval($tax));
+#::logDebug("tax hash=3D" . uneval($tax));
 	my $pfield   =3D $opt->{tax_category_field}
 				|| $::Variable->{MV_TAX_CATEGORY_FIELD}
 				|| 'tax_category';
@@ -6568,11 +6568,11 @@
 	}
 	elsif($Vend::Cfg->{SalesTaxFunction}) {
 		$tax_hash =3D tag_calc($Vend::Cfg->{SalesTaxFunction});
-#::logDebug("found custom tax function: " . ::uneval($tax_hash));
+#::logDebug("found custom tax function: " . uneval($tax_hash));
 	}
 	else {
 		$tax_hash =3D $Vend::Cfg->{SalesTaxTable};
-#::logDebug("looking for tax function: " . ::uneval($tax_hash));
+#::logDebug("looking for tax function: " . uneval($tax_hash));
 	}
=20
 # if we have a cost from previous routines, return it
@@ -6585,7 +6585,7 @@
 		$cost =3D fly_tax();
 	}
=20
-#::logDebug("got to tax function: " . ::uneval($tax_hash));
+#::logDebug("got to tax function: " . uneval($tax_hash));
 	my $amount =3D taxable_amount();
 	my($r, $code);
 	# Make it upper case for state and overseas postal
@@ -6728,7 +6728,7 @@
 	my(@fieldnames);
 	my($i,$point,$zone);
=20
-#::logDebug("tag_ups: type=3D$type zip=3D$zip weight=3D$weight code=3D$cod=
e opt=3D" . ::uneval($opt));
+#::logDebug("tag_ups: type=3D$type zip=3D$zip weight=3D$weight code=3D$cod=
e opt=3D" . uneval($opt));
 	$code =3D 'u' unless $code;
=20
 	unless (defined $Vend::Database{$type}) {



2.32      +172 -2    interchange/lib/Vend/Order.pm


rev 2.32, prev_rev 2.31
Index: Order.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Order.pm,v
retrieving revision 2.31
retrieving revision 2.32
diff -u -r2.31 -r2.32
--- Order.pm	10 Sep 2002 15:38:49 -0000	2.31
+++ Order.pm	16 Sep 2002 23:06:31 -0000	2.32
@@ -1,6 +1,6 @@
 # Vend::Order - Interchange order routing routines
 #
-# $Id: Order.pm,v 2.31 2002/09/10 15:38:49 mheins Exp $
+# $Id: Order.pm,v 2.32 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -28,12 +28,13 @@
 package Vend::Order;
 require Exporter;
=20
-$VERSION =3D substr(q$Revision: 2.31 $, 10);
+$VERSION =3D substr(q$Revision: 2.32 $, 10);
=20
 @ISA =3D qw(Exporter);
=20
 @EXPORT =3D qw (
 	add_items
+	do_order
 	check_order
 	check_required
 	cyber_charge
@@ -41,6 +42,7 @@
 	mail_order
 	onfly
 	route_order
+	update_quantity
 	validate_whole_cc
 );
=20
@@ -1819,6 +1821,174 @@
 		return ($status, $::Values->{mv_order_number}, $main);
 	}
 	return (undef, $::Values->{mv_order_number}, $main);
+}
+
+## DO ORDER
+
+# Order an item
+sub do_order {
+    my($path) =3D @_;
+	my $code        =3D $CGI::values{mv_arg};
+#::logDebug("do_order: path=3D$path");
+	my $cart;
+	my $page;
+# LEGACY
+	if($path =3D~ s:/(.*)::) {
+		$cart =3D $1;
+		if($cart =3D~ s:/(.*)::) {
+			$page =3D $1;
+		}
+	}
+# END LEGACY
+	if(defined $CGI::values{mv_pc} and $CGI::values{mv_pc} =3D~ /_(\d+)/) {
+		$CGI::values{mv_order_quantity} =3D $1;
+	}
+	$CGI::values{mv_cartname} =3D $cart if $cart;
+	$CGI::values{mv_nextpage} =3D $page if $page;
+# LEGACY
+	$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
+								|| find_special_page('order')
+		if ! $CGI::values{mv_nextpage};
+# END LEGACY
+	add_items($code);
+    return 1;
+}
+
+my @Scan_modifiers =3D qw/
+		mv_ad
+		mv_an
+		mv_bd
+		mv_bd
+/;
+
+# Returns undef if interaction error
+sub update_quantity {
+    return 1 unless defined  $CGI::values{"quantity0"}
+		|| $CGI::values{mv_quantity_update};
+	my($h, $i, $quantity, $modifier, $cart);
+
+	if ($CGI::values{mv_cartname}) {
+		$cart =3D $::Carts->{$CGI::values{mv_cartname}} ||=3D [];
+	}
+	else {
+		$cart =3D $Vend::Items;
+	}
+
+	my @mods;
+	@mods =3D @{$Vend::Cfg->{UseModifier}} if $Vend::Cfg->{UseModifier};
+
+#::logDebug("adding modifiers");
+	push(@mods, (grep $_ !~ /^mv_/, split /\0/, $CGI::values{mv_item_option}))
+		if defined $CGI::values{mv_item_option};
+
+	my %seen;
+	push @mods, grep defined $CGI::values{"${_}0"}, @Scan_modifiers;
+	@mods =3D grep ! $seen{$_}++, @mods;
+
+	foreach $h (@mods) {
+		delete @{$::Values}{grep /^$h\d+$/, keys %$::Values};
+		foreach $i (0 .. $#$cart) {
+#::logDebug("updating line $i modifiers: " . ::uneval($cart->[$i]));
+#::logDebug(qq{CGI value=3D$CGI::values{"$h$i"}});
+			$modifier =3D $CGI::values{"$h$i"}
+					  || (defined $cart->[$i]{$h} ? '' : undef);
+#::logDebug("line $i modifier $h now $modifier");
+			if (defined($modifier)) {
+				$modifier =3D~ s/\0+/\0/g;
+				$modifier =3D~ s/\0$//;
+				$modifier =3D~ s/^\0//;
+				$modifier =3D~ s/\0/, /g;
+				$cart->[$i]->{$h} =3D $modifier;
+				$::Values->{"$h$i"} =3D $modifier;
+				delete $CGI::values{"$h$i"};
+			}
+		}
+	}
+
+	foreach $i (0 .. $#$cart) {
+#::logDebug("updating line $i quantity: " . ::uneval($cart->[$i]));
+		my $line =3D $cart->[$i];
+		$line->{mv_ip} =3D $i;
+    	$quantity =3D $CGI::values{"quantity$i"};
+    	next unless defined $quantity;
+    	if ($quantity =3D~ m/^\d*$/) {
+        	$line->{'quantity'} =3D $quantity || 0;
+    	}
+    	elsif ($quantity =3D~ m/^[\d.]+$/
+				and $Vend::Cfg->{FractionalItems} ) {
+        	$line->{'quantity'} =3D $quantity;
+    	}
+		# This allows a last-positioned input of item quantity to
+		# remove the item
+		elsif ($quantity =3D~ s/.*\00$/0/) {
+			$CGI::values{"quantity$i"} =3D $quantity;
+			redo;
+		}
+		# This allows a multiple input of item quantity to
+		# pass -- FIRST ONE CONTROLS
+		elsif ($quantity =3D~ s/\0.*//) {
+			$CGI::values{"quantity$i"} =3D $quantity;
+			redo;
+		}
+		else {
+			my $item =3D $line->{'code'};
+			$line->{quantity} =3D int $line->{quantity};
+        	$Vend::Session->{errors}{mv_order_quantity} =3D
+				errmsg("'%s' for item %s is not numeric/integer", $quantity, $item);
+    	}
+    	$::Values->{"quantity$i"} =3D delete $CGI::values{"quantity$i"};
+		SKUSET: {
+			my $sku;
+			my $found_option;
+			last SKUSET unless $sku =3D delete $CGI::values{"mv_sku$i"};
+			my @sku =3D split /\0/, $sku, -1;
+			for(@sku[1..$#sku]) {
+				if (not length $_) {
+				$_ =3D $::Variable->{MV_VARIANT_JOINER} || '0';
+				next;
+				}
+				$found_option++;
+			}
+
+			if(@sku > 1 and ! $found_option) {
+				splice @sku, 1;
+			}
+
+			$sku =3D join "-", @sku;
+
+			my $ib;
+			unless($ib 	=3D ::product_code_exists_tag($sku)) {
+				push @{$Vend::Session->{warnings} ||=3D []},
+					errmsg("Not a valid option combination: %s", $sku);
+					last SKUSET;
+			}
+
+			$line->{mv_ib} =3D $ib;
+
+			if($sku ne $line->{code}) {
+				if($line->{mv_mp}) {
+					$line->{mv_sku} =3D $line->{code} =3D $sku;
+				}
+				elsif (! $line->{mv_sku}) {
+					$line->{mv_sku} =3D $line->{code};
+					$line->{code} 	=3D $sku;
+				}
+				else {
+					$line->{code}	=3D $sku;
+				}
+			}
+		}
+    }
+#::logDebug("after update, cart is: " . ::uneval($cart));
+
+	# If the user has put in "0" for any quantity, delete that item
+    # from the order list. Handles sub-items.
+    Vend::Cart::toss_cart($cart, $CGI::values{mv_cartname});
+
+#::logDebug("after toss, cart is: " . ::uneval($cart));
+
+	1;
+
 }
=20
 sub add_items {



2.2       +3 -3      interchange/lib/Vend/SOAP.pm


rev 2.2, prev_rev 2.1
Index: SOAP.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/SOAP.pm,v
retrieving revision 2.1
retrieving revision 2.2
diff -u -r2.1 -r2.2
--- SOAP.pm	17 Jun 2002 22:24:08 -0000	2.1
+++ SOAP.pm	16 Sep 2002 23:06:31 -0000	2.2
@@ -1,6 +1,6 @@
 # Vend::SOAP - Handle SOAP connections for Interchange
 #
-# $Id: SOAP.pm,v 2.1 2002/06/17 22:24:08 jon Exp $
+# $Id: SOAP.pm,v 2.2 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -34,7 +34,7 @@
 use strict;
=20
 use vars qw($VERSION @ISA $AUTOLOAD);
-$VERSION =3D substr(q$Revision: 2.1 $, 10);
+$VERSION =3D substr(q$Revision: 2.2 $, 10);
 @ISA =3D qw/SOAP::Server/;
=20
 my %Allowed_tags;
@@ -99,7 +99,7 @@
 	my $self =3D shift;
 	my @args =3D @_;
 	return "hello from the Vend::SOAP server, pid $$, world!\nreceived args:\=
n"
-		. ::uneval(\@args);
+		. uneval(\@args);
 }
=20
 sub soaptest {



2.12      +9 -9      interchange/lib/Vend/Search.pm


rev 2.12, prev_rev 2.11
Index: Search.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Search.pm,v
retrieving revision 2.11
retrieving revision 2.12
diff -u -r2.11 -r2.12
--- Search.pm	1 Sep 2002 23:19:51 -0000	2.11
+++ Search.pm	16 Sep 2002 23:06:31 -0000	2.12
@@ -1,6 +1,6 @@
 # Vend::Search - Base class for search engines
 #
-# $Id: Search.pm,v 2.11 2002/09/01 23:19:51 mheins Exp $
+# $Id: Search.pm,v 2.12 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -21,7 +21,7 @@
=20
 package Vend::Search;
=20
-$VERSION =3D substr(q$Revision: 2.11 $, 10);
+$VERSION =3D substr(q$Revision: 2.12 $, 10);
=20
 use strict;
 use vars qw($VERSION);
@@ -213,15 +213,15 @@
 			$msg,
             $s->{mv_coordinate},
 			scalar @$specs,
-			::uneval($specs),
+			Vend::Util::uneval($specs),
 			scalar @{$s->{mv_search_field}},
-			::uneval($s->{mv_search_field}),
+			Vend::Util::uneval($s->{mv_search_field}),
 			scalar @{$s->{mv_column_op}},
-			::uneval($s->{mv_column_op}),
+			Vend::Util::uneval($s->{mv_column_op}),
 			scalar @{$s->{mv_numeric}},
-			::uneval($s->{mv_numeric}),
+			Vend::Util::uneval($s->{mv_numeric}),
 			scalar @{$s->{mv_negate}},
-			::uneval($s->{mv_negate}),
+			Vend::Util::uneval($s->{mv_negate}),
 			;
 }
=20
@@ -988,7 +988,7 @@
 	for (@save) {
 		$return->{$_} =3D $s->{$_};
 	}
-	::uneval_fast($return);
+	Vend::Util::uneval_fast($return);
 }
=20
 sub dump_options {
@@ -998,7 +998,7 @@
 		$Data::Dumper::Indent =3D 3;
 		$Data::Dumper::Terse =3D 1;
 	}
-	return ::uneval($s);
+	return Vend::Util::uneval($s);
 }
=20
 sub search_error {



2.14      +9 -5      interchange/lib/Vend/Server.pm


rev 2.14, prev_rev 2.13
Index: Server.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.13
retrieving revision 2.14
diff -u -r2.13 -r2.14
--- Server.pm	7 Sep 2002 20:05:10 -0000	2.13
+++ Server.pm	16 Sep 2002 23:06:31 -0000	2.14
@@ -1,6 +1,6 @@
 # Vend::Server - Listen for Interchange CGI requests as a background server
 #
-# $Id: Server.pm,v 2.13 2002/09/07 20:05:10 mheins Exp $
+# $Id: Server.pm,v 2.14 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -25,7 +25,7 @@
 package Vend::Server;
=20
 use vars qw($VERSION);
-$VERSION =3D substr(q$Revision: 2.13 $, 10);
+$VERSION =3D substr(q$Revision: 2.14 $, 10);
=20
 use POSIX qw(setsid strftime);
 use Vend::Util;
@@ -1058,8 +1058,12 @@
                 }
=20
 				eval {
-					$c =3D ::config_named_catalog($cat->{CatalogName},
-                                    "from running server ($$)", $table, $c=
file);
+					$c =3D Vend::Config::config_named_catalog(
+									$cat->{CatalogName},
+                                    "from running server ($$)",
+									$table,
+									$cfile
+								);
 				};
=20
 				if (defined $c) {
@@ -2225,7 +2229,7 @@
 sub cron_job {
 	my ($cat, @jobs) =3D @_;
 	for my $job (@jobs) {
-		::run_in_catalog($cat, $job);
+		Vend::Dispatch::run_in_catalog($cat, $job);
 	}
 }
=20



2.7       +59 -4     interchange/lib/Vend/Session.pm


rev 2.7, prev_rev 2.6
Index: Session.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Session.pm,v
retrieving revision 2.6
retrieving revision 2.7
diff -u -r2.6 -r2.7
--- Session.pm	15 Jul 2002 14:20:00 -0000	2.6
+++ Session.pm	16 Sep 2002 23:06:31 -0000	2.7
@@ -1,6 +1,6 @@
 # Vend::Session - Interchange session routines
 #
-# $Id: Session.pm,v 2.6 2002/07/15 14:20:00 mheins Exp $
+# $Id: Session.pm,v 2.7 2002/09/16 23:06:31 mheins Exp $
 #=20
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -26,7 +26,7 @@
 require Exporter;
=20
 use vars qw($VERSION);
-$VERSION =3D substr(q$Revision: 2.6 $, 10);
+$VERSION =3D substr(q$Revision: 2.7 $, 10);
=20
 @ISA =3D qw(Exporter);
=20
@@ -38,9 +38,12 @@
 close_session
 get_session
 init_session
+is_retired
 new_session
 put_session
+retire_id
 session_name
+tie_static_dbm
=20
 );
=20
@@ -205,6 +208,25 @@
 	return Vend::CounterFile->new($fn)->value();
 }
=20
+sub is_retired {
+	my $id =3D shift;
+	mkdir "$Vend::Cfg->{ScratchDir}/retired", 0777
+		unless -d "$Vend::Cfg->{ScratchDir}/retired";
+	my $fn =3D Vend::Util::get_filename($id, 2, 1, "$Vend::Cfg->{ScratchDir}/=
retired");
+	return -f $fn ? 1 : 0;
+}
+
+sub retire_id {
+	my $id =3D shift;
+	return unless $id =3D~ /^\w+$/;
+	mkdir "$Vend::Cfg->{ScratchDir}/retired", 0777
+		unless -d "$Vend::Cfg->{ScratchDir}/retired";
+	my $fn =3D Vend::Util::get_filename($id, 2, 1, "$Vend::Cfg->{ScratchDir}/=
retired");
+	open(TMPRET, ">$fn")
+		or die "retire id open: $!\n";
+	close(TMPRET);
+	return;
+}
=20
 sub new_session {
     my($seed) =3D @_;
@@ -218,8 +240,8 @@
 			undef $Vend::CookieID;
 		}
 		undef $seed;
-		if (::is_retired($Vend::SessionID)) {
-			::retire_id($Vend::SessionID);
+		if (is_retired($Vend::SessionID)) {
+			retire_id($Vend::SessionID);
 			next;
 		}
 		$name =3D session_name();
@@ -544,6 +566,39 @@
=20
 	return ($expire > $time);
 }=09
+
+sub tie_static_dbm {
+	my $rw =3D shift;
+	untie(%Vend::StaticDBM) if $rw;
+	if($Global::GDBM) {
+        my $flags =3D $rw ? &GDBM_WRITER : &GDBM_READER;
+        $flags =3D &GDBM_NEWDB
+            if $rw && (! -f "$Vend::Cfg->{StaticDBM}.gdbm");
+        tie(%Vend::StaticDBM,
+            'GDBM_File',
+            "$Vend::Cfg->{StaticDBM}.gdbm",
+            $flags,
+            $Vend::Cfg->{'FileCreationMask'},
+        )
+        or $Vend::Cfg->{SaveStaticDBM} =3D delete $Vend::Cfg->{StaticDBM};
+	}
+	elsif ($Global::DB_File) {
+		tie(%Vend::StaticDBM,
+			'DB_File',
+			"$Vend::Cfg->{StaticDBM}.db",
+			($rw ? &O_RDWR | &O_CREAT : &O_RDONLY),
+			$Vend::Cfg->{'FileCreationMask'},
+			)
+		or undef $Vend::Cfg->{StaticDBM};
+	}
+	else {
+        $Vend::Cfg->{SaveStaticDBM} =3D delete $Vend::Cfg->{StaticDBM};
+	}
+	::logError("Failed to create StaticDBM %s", $Vend::Cfg->{StaticDBM})
+		if $rw && ! $Vend::Cfg->{StaticDBM};
+	return $Vend::Cfg->{StaticDBM} || undef;
+}
+
=20
 1;
=20



2.10      +5 -5      interchange/lib/Vend/UserDB.pm


rev 2.10, prev_rev 2.9
Index: UserDB.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/UserDB.pm,v
retrieving revision 2.9
retrieving revision 2.10
diff -u -r2.9 -r2.10
--- UserDB.pm	20 Jul 2002 14:43:28 -0000	2.9
+++ UserDB.pm	16 Sep 2002 23:06:31 -0000	2.10
@@ -1,6 +1,6 @@
 # Vend::UserDB - Interchange user database functions
 #
-# $Id: UserDB.pm,v 2.9 2002/07/20 14:43:28 mheins Exp $
+# $Id: UserDB.pm,v 2.10 2002/09/16 23:06:31 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -16,7 +16,7 @@
=20
 package Vend::UserDB;
=20
-$VERSION =3D substr(q$Revision: 2.9 $, 10);
+$VERSION =3D substr(q$Revision: 2.10 $, 10);
=20
 use vars qw!
 	$VERSION
@@ -500,7 +500,7 @@
 	else {
 		$f->{$options{location}} =3D $options{mode} || 'rw';
 	}
-	my $return =3D $self->{DB}->set_field( $self->{USERNAME}, $loc, Vend::Uti=
l::uneval_it($f) );
+	my $return =3D $self->{DB}->set_field( $self->{USERNAME}, $loc, uneval_it=
($f) );
 	return $return if $options{show};
 	return;
 }
@@ -897,7 +897,7 @@
 		return undef;
 	}
=20
-	my $s =3D ::uneval_it($self->{$name});
+	my $s =3D uneval_it($self->{$name});
=20
 	$self->{DB}->set_field( $self->{USERNAME}, $field_name, $s);
=20
@@ -935,7 +935,7 @@
 		return undef;
 	}
=20
-	my $s =3D ::uneval_it($self->{$name});
+	my $s =3D uneval_it($self->{$name});
=20
 	$self->{DB}->set_field( $self->{USERNAME}, $field_name, $s);
=20



2.36      +8 -2      interchange/lib/Vend/Util.pm


rev 2.36, prev_rev 2.35
Index: Util.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Util.pm,v
retrieving revision 2.35
retrieving revision 2.36
diff -u -r2.35 -r2.36
--- Util.pm	13 Sep 2002 20:46:21 -0000	2.35
+++ Util.pm	16 Sep 2002 23:06:31 -0000	2.36
@@ -1,6 +1,6 @@
 # Vend::Util - Interchange utility functions
 #
-# $Id: Util.pm,v 2.35 2002/09/13 20:46:21 mheins Exp $
+# $Id: Util.pm,v 2.36 2002/09/16 23:06:31 mheins Exp $
 #=20
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -32,6 +32,7 @@
 	check_security
 	copyref
 	currency
+	dbref
 	dump_structure
 	errmsg
 	escape_chars
@@ -82,7 +83,7 @@
 use Safe;
 use subs qw(logError logGlobal);
 use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION =3D substr(q$Revision: 2.35 $, 10);
+$VERSION =3D substr(q$Revision: 2.36 $, 10);
=20
 BEGIN {
 	eval {
@@ -113,6 +114,11 @@
 		'0123456789'				 .
 		'-_./~=3D'
 	;
+
+## This is an alias for a commonly-used function
+sub dbref {
+	return Vend::Data::database_exists_ref(@_);
+}
=20
 ## This is a character class for HTML::Entities
 $ESCAPE_CHARS::std =3D "^\n\t !\#\$%\'-;=3D?-Z\\\]-~";



1.7       +12 -12    interchange/lib/Vend/Accounting/SQL_Ledger.pm


rev 1.7, prev_rev 1.6
Index: SQL_Ledger.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Accounting/SQL_Ledger.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- SQL_Ledger.pm	28 Jul 2002 05:15:28 -0000	1.6
+++ SQL_Ledger.pm	16 Sep 2002 23:06:32 -0000	1.7
@@ -73,7 +73,7 @@
 		$cfg->{counter} =3D "$tab:id";
 	}
     bless $self, $class;
-#::logDebug("Accounting self=3D" . ::uneval($self) );
+#::logDebug("Accounting self=3D" . uneval($self) );
 	return $self;
 }
=20
@@ -276,7 +276,7 @@
 			logError($msg);
 #::logDebug($msg);
 		}
-#::logDebug("passing rec=3D" . ::uneval($rec));
+#::logDebug("passing rec=3D" . uneval($rec));
 		$self->save_customer_data($id, $rec);
 		my $on =3D $rec->{order_number};
 		my $query =3D "select * from $tab where order_number =3D '$on'";
@@ -322,7 +322,7 @@
 				handling =3D> $rec->{handling} || 0,
 				total_cost =3D> $rec->{total_cost} || 0,
 			};
-#::logDebug("Getting ready to create order entry: " . ::uneval($o));
+#::logDebug("Getting ready to create order entry: " . uneval($o));
 		$obj->create_order_entry($o);
 		$count++;
 	}
@@ -397,11 +397,11 @@
=20
=20
 	my @charges;
-#::logDebug("Levies=3D" . ::uneval($Vend::Cfg->{Levies}));
+#::logDebug("Levies=3D" . uneval($Vend::Cfg->{Levies}));
 	if($Vend::Cfg->{Levies}) {
 		$Tag->levies(1);
 		my $lcart =3D $::Levies;
-#::logDebug("levy cart=3D" . ::uneval($lcart));
+#::logDebug("levy cart=3D" . uneval($lcart));
 		for my $levy (@$lcart) {
 			my $pid =3D $levy->{part_number};
 			$pid ||=3D uc($levy->{group} || $levy->{type});
@@ -410,7 +410,7 @@
 						description =3D> $levy->{description},
 						mv_price =3D> $levy->{cost},
 			};
-#::logDebug("levy result=3D" . ::uneval($lresult));
+#::logDebug("levy result=3D" . uneval($lresult));
 			push @charges, $lresult;
 		}
 	}
@@ -679,7 +679,7 @@
 				$res->{currency},
 				);
=20=09
-#::logDebug("ready to execute tquery=3D$tq with values=3D" . ::uneval(\@va=
ls));
+#::logDebug("ready to execute tquery=3D$tq with values=3D" . uneval(\@vals=
));
 	$tsth->execute(@vals)=20
 		or die errmsg("Statement '%s' failed.", $tq);
=20
@@ -720,7 +720,7 @@
 	}
=20=09=09
 	$res->{rowcount} =3D $idx;
-#::logDebug("past accounting, ready to return res=3D" . ::uneval($res));
+#::logDebug("past accounting, ready to return res=3D" . uneval($res));
=20
 	if($opt->{do_payment}) {
 		$res->{paid_1} =3D $opt->{total_cost};
@@ -962,7 +962,7 @@
=20
 sub enter_payment {
     my ($self, $string) =3D @_;
-	my $datastuff =3D ::uneval(\@_);
+	my $datastuff =3D uneval(\@_);
 	`echo "This is a enter_customer_payment test... $datastuff" >> testlog.tx=
t`;
     return $string;
 }
@@ -975,7 +975,7 @@
 	my $myconfig =3D $self->myconfig();
 	my $cfg =3D $self->{Config};
=20
-#::logDebug("have myconfig=3D" . ::uneval($myconfig));
+#::logDebug("have myconfig=3D" . uneval($myconfig));
 	$form->{AR}				||=3D $cfg->{default_ar}			|| 1200;
 	$form->{AR_paid}		||=3D $cfg->{default_ar_paid}		|| 1060;
 	$form->{fxgain_accno}	||=3D $cfg->{default_fxgain_accno}|| 4450;
@@ -1003,9 +1003,9 @@
 	  $form->{"shipto$key"} =3D~ s/"/&quot;/g;
 	}
=20
-#::logDebug("customer details back, form set up=3D" . ::uneval($form));
+#::logDebug("customer details back, form set up=3D" . uneval($form));
 	my $status =3D IS->post_invoice($myconfig, $form);
-#::logDebug("post_status=3D$status, form now=3D" . ::uneval($form));
+#::logDebug("post_status=3D$status, form now=3D" . uneval($form));
 	return $form;
 }
=20



1.2       +5 -5      interchange/lib/Vend/Payment/MCVE.pm


rev 1.2, prev_rev 1.1
Index: MCVE.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Payment/MCVE.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- MCVE.pm	24 Jul 2002 15:30:58 -0000	1.1
+++ MCVE.pm	16 Sep 2002 23:06:32 -0000	1.2
@@ -1,6 +1,6 @@
 # Vend::Payment::MCVE - Interchange MCVE support
 #
-# $Id: MCVE.pm,v 1.1 2002/07/24 15:30:58 kwalsh Exp $
+# $Id: MCVE.pm,v 1.2 2002/09/16 23:06:32 mheins Exp $
 #
 # Author: Tom Friedel (tom@readyink.com) for Carlc Internet Services (http=
://www.carlc.com)
 #
@@ -22,11 +22,11 @@
 package Vend::Payment::MCVE;
=20
 use vars qw($VERSION);
-$VERSION =3D substr(q$Revision: 1.1 $, 10);
+$VERSION =3D substr(q$Revision: 1.2 $, 10);
=20
 =3Dhead1 Interchange MCVE support
=20
-Vend::Payment::MCVE $Revision: 1.1 $
+Vend::Payment::MCVE $Revision: 1.2 $
=20
 =3Dhead1 SYNOPSIS
=20
@@ -217,7 +217,7 @@
 sub mcve {
     my ($opt) =3D @_;
=20
-    ::logDebug("mcve called, args=3D" . ::uneval(\@_));
+#::logDebug("mcve called, args=3D" . ::uneval(\@_));
=20
     my $sess;
     my %result;
@@ -471,7 +471,7 @@
     &MCVE::MCVE_DestroyConn($conn);
     &MCVE::MCVE_DestroyEngine();
=20
-    ::logDebug("mcve returns, result=3D" . ::uneval(\%result));
+#::logDebug("mcve returns, result=3D" . ::uneval(\%result));
     return %result;
 }
=20



2.32      +4 -4      interchange/lib/Vend/Table/DBI.pm


rev 2.32, prev_rev 2.31
Index: DBI.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/lib/Vend/Table/DBI.pm,v
retrieving revision 2.31
retrieving revision 2.32
diff -u -r2.31 -r2.32
--- DBI.pm	10 Sep 2002 17:29:09 -0000	2.31
+++ DBI.pm	16 Sep 2002 23:06:32 -0000	2.32
@@ -1,6 +1,6 @@
 # Vend::Table::DBI - Access a table stored in an DBI/DBD database
 #
-# $Id: DBI.pm,v 2.31 2002/09/10 17:29:09 mheins Exp $
+# $Id: DBI.pm,v 2.32 2002/09/16 23:06:32 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -20,7 +20,7 @@
 # MA  02111-1307  USA.
=20
 package Vend::Table::DBI;
-$VERSION =3D substr(q$Revision: 2.31 $, 10);
+$VERSION =3D substr(q$Revision: 2.32 $, 10);
=20
 use strict;
=20
@@ -647,8 +647,8 @@
 	$config->{KEY_INDEX} =3D $config->{COLUMN_INDEX}{lc $key}
 		if ! $config->{KEY_INDEX};
 	die ::errmsg("Bad key specification: %s"  .
-					::uneval_it($config->{NAME}) .
-					::uneval_it($config->{COLUMN_INDEX}),
+					Vend::Util::uneval_it($config->{NAME}) .
+					Vend::Util::uneval_it($config->{COLUMN_INDEX}),
 					$key
 		)
 		if ! defined $config->{KEY_INDEX};



2.59      +3 -2270   interchange/scripts/interchange.PL


rev 2.59, prev_rev 2.58
Index: interchange.PL
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /var/cvs/interchange/scripts/interchange.PL,v
retrieving revision 2.58
retrieving revision 2.59
diff -u -r2.58 -r2.59
--- interchange.PL	12 Sep 2002 15:56:32 -0000	2.58
+++ interchange.PL	16 Sep 2002 23:06:33 -0000	2.59
@@ -3,7 +3,7 @@
 #
 # Interchange version 4.9.3
 #
-# $Id: interchange.PL,v 2.58 2002/09/12 15:56:32 mheins Exp $
+# $Id: interchange.PL,v 2.59 2002/09/16 23:06:33 mheins Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. and others.
 # http://www.icdevgroup.org/
@@ -258,10 +258,6 @@
=20
 # END AUTOUSE
=20
-# GLIMPSE
-use Vend::Glimpse;
-# END GLIMPSE
-
 # TRACK
 use Vend::Track;
 # END TRACK
@@ -272,6 +268,7 @@
 use Vend::Interpolate;
 use Vend::Page;
 use Vend::CounterFile;
+use Vend::Dispatch;
=20
 if($ENV{INTERCHANGE_REQUIRE}) {
 	my @mods =3D split /[;\s]+/, $ENV{INTERCHANGE_REQUIRE};
@@ -306,2236 +303,6 @@
 ## would act properly by default
 undef $Vend::ExternalProgram;
=20
-my $H;
-sub http {
-	return $H;
-}
-
-sub response {
-	my ($output) =3D @_;
-	my $out =3D ref $output ? $output : \$output;
-	if (defined $Vend::CheckHTML) {
-		require Vend::External;
-		Vend::External::check_html($out);
-	}
-	$H->respond($out);
-}
-
-## DO ORDER
-
-# Order an item with product code CODE.
-
-sub do_order {
-    my($path) =3D @_;
-	my $code        =3D $CGI::values{mv_arg};
-#::logDebug("do_order: path=3D$path");
-	my $cart;
-	my $page;
-# LEGACY
-	if($path =3D~ s:/(.*)::) {
-		$cart =3D $1;
-		if($cart =3D~ s:/(.*)::) {
-			$page =3D $1;
-		}
-	}
-# END LEGACY
-	if(defined $CGI::values{mv_pc} and $CGI::values{mv_pc} =3D~ /_(\d+)/) {
-		$CGI::values{mv_order_quantity} =3D $1;
-	}
-	$CGI::values{mv_cartname} =3D $cart if $cart;
-	$CGI::values{mv_nextpage} =3D $page if $page;
-# LEGACY
-	$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
-								|| find_special_page('order')
-		if ! $CGI::values{mv_nextpage};
-# END LEGACY
-	add_items($code);
-    return 1;
-}
-
-my @Scan_modifiers =3D qw/
-		mv_ad
-		mv_an
-		mv_bd
-		mv_bd
-/;
-
-# Returns undef if interaction error
-sub update_quantity {
-    return 1 unless defined  $CGI::values{"quantity0"}
-		|| $CGI::values{mv_quantity_update};
-	my($h, $i, $quantity, $modifier, $cart);
-
-	if ($CGI::values{mv_cartname}) {
-		$cart =3D $::Carts->{$CGI::values{mv_cartname}} ||=3D [];
-	}
-	else {
-		$cart =3D $Vend::Items;
-	}
-
-	my @mods;
-	@mods =3D @{$Vend::Cfg->{UseModifier}} if $Vend::Cfg->{UseModifier};
-
-#::logDebug("adding modifiers");
-	push(@mods, (grep $_ !~ /^mv_/, split /\0/, $CGI::values{mv_item_option}))
-		if defined $CGI::values{mv_item_option};
-
-	my %seen;
-	push @mods, grep defined $CGI::values{"${_}0"}, @Scan_modifiers;
-	@mods =3D grep ! $seen{$_}++, @mods;
-
-	foreach $h (@mods) {
-		delete @{$::Values}{grep /^$h\d+$/, keys %$::Values};
-		foreach $i (0 .. $#$cart) {
-#::logDebug("updating line $i modifiers: " . ::uneval($cart->[$i]));
-#::logDebug(qq{CGI value=3D$CGI::values{"$h$i"}});
-			$modifier =3D $CGI::values{"$h$i"}
-					  || (defined $cart->[$i]{$h} ? '' : undef);
-#::logDebug("line $i modifier $h now $modifier");
-			if (defined($modifier)) {
-				$modifier =3D~ s/\0+/\0/g;
-				$modifier =3D~ s/\0$//;
-				$modifier =3D~ s/^\0//;
-				$modifier =3D~ s/\0/, /g;
-				$cart->[$i]->{$h} =3D $modifier;
-				$::Values->{"$h$i"} =3D $modifier;
-				delete $CGI::values{"$h$i"};
-			}
-		}
-	}
-
-	foreach $i (0 .. $#$cart) {
-#::logDebug("updating line $i quantity: " . ::uneval($cart->[$i]));
-		my $line =3D $cart->[$i];
-		$line->{mv_ip} =3D $i;
-    	$quantity =3D $CGI::values{"quantity$i"};
-    	next unless defined $quantity;
-    	if ($quantity =3D~ m/^\d*$/) {
-        	$line->{'quantity'} =3D $quantity || 0;
-    	}
-    	elsif ($quantity =3D~ m/^[\d.]+$/
-				and $Vend::Cfg->{FractionalItems} ) {
-        	$line->{'quantity'} =3D $quantity;
-    	}
-		# This allows a last-positioned input of item quantity to
-		# remove the item
-		elsif ($quantity =3D~ s/.*\00$/0/) {
-			$CGI::values{"quantity$i"} =3D $quantity;
-			redo;
-		}
-		# This allows a multiple input of item quantity to
-		# pass -- FIRST ONE CONTROLS
-		elsif ($quantity =3D~ s/\0.*//) {
-			$CGI::values{"quantity$i"} =3D $quantity;
-			redo;
-		}
-		else {
-			my $item =3D $line->{'code'};
-			$line->{quantity} =3D int $line->{quantity};
-        	$Vend::Session->{errors}{mv_order_quantity} =3D
-				errmsg("'%s' for item %s is not numeric/integer", $quantity, $item);
-    	}
-    	$::Values->{"quantity$i"} =3D delete $CGI::values{"quantity$i"};
-		SKUSET: {
-			my $sku;
-			my $found_option;
-			last SKUSET unless $sku =3D delete $CGI::values{"mv_sku$i"};
-			my @sku =3D split /\0/, $sku, -1;
-			for(@sku[1..$#sku]) {
-				if (not length $_) {
-				$_ =3D $::Variable->{MV_VARIANT_JOINER} || '0';
-				next;
-				}
-				$found_option++;
-			}
-
-			if(@sku > 1 and ! $found_option) {
-				splice @sku, 1;
-			}
-
-			$sku =3D join "-", @sku;
-
-			my $ib;
-			unless($ib 	=3D ::product_code_exists_tag($sku)) {
-				push @{$Vend::Session->{warnings} ||=3D []},
-					errmsg("Not a valid option combination: %s", $sku);
-					last SKUSET;
-			}
-
-			$line->{mv_ib} =3D $ib;
-
-			if($sku ne $line->{code}) {
-				if($line->{mv_mp}) {
-					$line->{mv_sku} =3D $line->{code} =3D $sku;
-				}
-				elsif (! $line->{mv_sku}) {
-					$line->{mv_sku} =3D $line->{code};
-					$line->{code} 	=3D $sku;
-				}
-				else {
-					$line->{code}	=3D $sku;
-				}
-			}
-		}
-    }
-#::logDebug("after update, cart is: " . ::uneval($cart));
-
-	# If the user has put in "0" for any quantity, delete that item
-    # from the order list. Handles sub-items.
-    Vend::Cart::toss_cart($cart, $CGI::values{mv_cartname});
-
-#::logDebug("after toss, cart is: " . ::uneval($cart));
-
-	1;
-
-}
-
-sub set_db {
-	my ($base, $thing) =3D @_;
-	return ($base, $thing) unless $thing =3D~ /^(\w+):+(.*)/;
-	my $t =3D $1;
-	my $c =3D $2;
-
-	# Security handled before this in update_data
-	$Vend::WriteDatabase{$t} =3D 1;
-
-	my $db =3D ::database_exists_ref($t);
-	return undef unless $db;
-	return ($db->ref(), $c);
-}
-
-## Update the user-entered fields.
-sub update_data {
-	my($key,$value);
-	my @cgi_keys =3D keys %CGI::values;
-    # Update a database record
-	# Check to see if this is allowed
-#::logDebug("mv_data_enable=3D$::Scratch->{mv_data_enable}");
-	if(! $::Scratch->{mv_data_enable}) {
-		logError(
-			 "Attempted database update without permission, table=3D%s key=3D%s.",
-			 $CGI::values{mv_data_table},
-			 $CGI::values{$CGI::values{mv_data_key}},
-		);
-		return undef;
-	}
-	unless (defined $CGI::values{mv_data_table} and=20
-		    defined $CGI::values{mv_data_key}      ) {
-		logError("Attempted database operation without table, fields, or key.\n"=
 .
-					 "Table: '%s'\n" .
-					 "Fields:'%s'\n" .
-					 "Key:   '%s'\n",
-					 $CGI::values{mv_data_table},
-					 $CGI::values{mv_data_fields},
-					 $CGI::values{mv_data_key},
-				 );
-
-		return undef;
-	}
-
-	my $function	=3D lc (delete $CGI::values{mv_data_function});
-	if($function eq 'delete' and ! delete $CGI::values{mv_data_verify}) {
-		logError("update_data: DELETE without VERIFY, abort");
-		return undef;
-	}
-	my $table		=3D $CGI::values{mv_data_table};
-	my $prikey		=3D $CGI::values{mv_data_key};
-	my $decode		=3D is_yes($CGI::values{mv_data_decode});
-	my ($ref, $db, $database);
-
-	my $en_col;
-#::logDebug("data_enable=3D$::Scratch->{mv_data_enable}, checking");
-	if($::Scratch->{mv_data_enable} =3D~ /^(\w+):(.*?):/) {
-		# check for single key and possible set of columns
-		my $en_table =3D $1;
-		$en_col   =3D $2;
-		my $en_key   =3D $::Scratch->{mv_data_enable_key};
-#::logDebug("en_table=3D$en_table en_col=3D$en_col, en_key=3D$en_key, chec=
king");
-		if(  $en_table ne $table
-			 or=20
-			 ($en_key and $CGI::values{$prikey} ne $en_key)
-			)
-		{
-			logError("Attempted database operation without permission:\n" .
-						 "Permission: '%s' (key=3D'$en_key')\n" .
-						 "Table: '%s'\n" .
-						 "Fields:'%s'\n" .
-						 "Key:   '%s'\n",
-						 $::Scratch->{mv_data_enable},
-						 $CGI::values{mv_data_table},
-						 $CGI::values{mv_data_fields},
-						 $CGI::values{$CGI::values{mv_data_key}},
-				 );
-			return undef;
-		}
-	}
-
-
-	$Vend::WriteDatabase{$table} =3D 1;
-
-    my $base_db =3D database_exists_ref($table)
-        or die "Not a defined database '$table': $!\n";
-    $base_db =3D $base_db->ref();
-
-	my @fields		=3D grep $_ && $_ ne $prikey,
-						split /[\s\0,]+/, $CGI::values{mv_data_fields};
-	unshift(@fields, $prikey);
-
-    my @file_fields =3D split /[\s\0,]+/, $CGI::values{mv_data_file_field};
-    my @file_paths =3D split /[\s\0,]+/, $CGI::values{mv_data_file_path};
-    my @file_oldfiles =3D split /[\s\0,]+/, $CGI::values{mv_data_file_oldf=
ile};
-
-	if($en_col) {
-		$en_col =3D~ s/^\s+//;
-		$en_col =3D~ s/\s+$//;
-		my %col_present;
-		@col_present{ grep /\S/, split /[\s\0,]+/, $en_col } =3D ();
-		$col_present{$prikey} =3D 1;
-		for(@fields, $CGI::values{mv_blob_field}, $CGI::values{mv_blob_pointer})=
 {
-			next unless $_;
-			next if exists $col_present{$_};
-			next if /:/ and $::Scratch->{mv_data_enable} =3D~ / $_ /;
-			logError("Attempted database operation without permission:\n" .
-						 "Permission: '%s'\n" .
-						 "Table: '%s'\n" .
-						 "Fields:'%s'\n" .
-						 "Key:   '%s'\n",
-						 $::Scratch->{mv_data_enable},
-						 $CGI::values{mv_data_table},
-						 $CGI::values{mv_data_fields},
-						 $CGI::values{$CGI::values{mv_data_key}},
-				 );
-			return undef;
-		}
-	}
-	$function =3D 'update' unless $function;
-
-	my (%data);
-	for(@fields) {
-		$data{$_} =3D [];
-	}
-
-	my $count;
-	my $multi =3D $CGI::values{$prikey} =3D~ tr/\0/\0/;
-	my $max =3D 0;
-	my $min =3D 9999;
-	my ($minname, $maxname);
-
-	while (($key, $value) =3D each %CGI::values) {
-		next unless defined $data{$key};
-		if($CGI::values{"mv_data_prep_$key"}) {
-			$value =3D Vend::Interpolate::filter_value(
-						 $CGI::values{"mv_data_prep_$key"},
-						 $value
-						 );
-		}
-		$count =3D (@{$data{$key}} =3D split /\0/, $value, -1);
-		$max =3D $count, $maxname =3D $key if $count > $max;
-		$min =3D $count, $minname =3D $key if $count < $min;
-	}
-
-	if( $multi and ($max - $min) > 1 and ! $CGI::values{mv_data_force}) {
-		logError("probable bad form -- number of values min=3D%s (%s) max=3D%s (=
%s)", $min, $minname, $max, $maxname);
-		return;
-	}
-
-	my $autonumber;
-	if ($CGI::values{mv_data_auto_number}) {
-		$autonumber =3D 1;
-		my $ref =3D $data{$prikey};
-		while (scalar @$ref < $max) {
-			push @$ref, '';
-		}
-		$base_db->config('AUTO_NUMBER', '000001')
-			if ! $base_db->config('_Auto_number');
-		$CGI::values{mv_data_return_key} =3D $prikey
-			unless $CGI::values{mv_data_return_key};
-	}
-	elsif($function eq 'insert' and $base_db->config('_Auto_number') ) {
-			$autonumber =3D 1;
-	}
-=20
-
- 	if(@file_fields) {
-		my $Tag =3D new Vend::Tags;
-		my $acl_func;
-		my $outfile;
-		if($Vend::Session->{logged_in} and $Vend::admin) {
-			$acl_func =3D sub {
-				return $Tag->if_mm('files', shift);
-			};
-		}
-		elsif($Vend::Session->{logged_in} and ! $Vend::admin) {
-			$acl_func =3D sub {
-				my $file =3D shift;
-				return 1 if $::Scratch->{$file} =3D=3D 1;
-				return $Tag->userdb(
-								function =3D> 'check_file_acl',
-								location =3D> $file,
-								mode =3D> 'w'
-								);
-			};
-		}
-		else {
-			$acl_func =3D sub { return $::Scratch->{shift(@_)} =3D=3D 1 }
-		}
-
-		for (my $i =3D 0; $i < @file_fields; $i++) {
-			unless (length($data{$file_fields[$i]}->[0])) {
-				# no need for a file update
-				$data{$file_fields[$i]}->[0] =3D $file_oldfiles[$i];
-				next;
-			}
-
-			# remove path components
-			$data{$file_fields[$i]}->[0] =3D~ s:.*/::;=20
-			$data{$file_fields[$i]}->[0] =3D~ s:.*\\::;=20
-
-			if (length ($file_paths[$i])) {
-				# real file upload
-				$outfile =3D join('/', $file_paths[$i], $data{$file_fields[$i]}->[0]);
-#::logDebug("file upload: field=3D$file_fields[$i] path=3D$file_paths[$i] =
outfile=3D$outfile");
-				my $ok;
-				if (-f $outfile) {
-					eval {
-						$ok =3D $acl_func->($outfile);
-					};
-				} else {
-					eval {
-						$ok =3D $acl_func->($file_paths[$i]);
-					};
-				}
-				if (! $ok) {
-					if($@) {
-						::logError ("ACL function failed on '%s': %s", $outfile, $@);
-					}
-					else {
-						::logError ("Not allowed to upload \"%s\"", $outfile);
-					}
-					next;
-				}=20
-				my $err;
-				Vend::Interpolate::tag_value_extended(
-										$file_fields[$i],
-										{
-											test =3D> 'isfile'
-										}
-										)
-					or do {
-						 ::logError("%s is not a file.", $data{$file_fields[$i]}->[0]);
-						 next;
-					};
-				Vend::Interpolate::tag_value_extended(
-										$file_fields[$i],
-										{
-											outfile =3D> $outfile,
-											umask =3D> '022',
-											yes =3D> '1',
-										}
-										)
-					or do {
-						 ::logError("failed to write %s: %s", $outfile, $!);
-						 next;
-					};
-			}
-			else {
-				# preparing to dump file contents into database column
-				$data{$file_fields[$i]}->[0]
-					=3D Vend::Interpolate::tag_value_extended ($file_fields[$i],
-						{file_contents =3D> 1});
-			}
-		}
-	}
-
-	if (not defined $data{$prikey}) {
-		logError("No key '%s' in field specifier %s", $prikey, 'mv_data_fields');
-		return undef;
-	}
-	elsif ( ! @{$data{$prikey}}) {
-		if($autonumber) {
-			@{$data{$prikey}} =3D map { '' } @{ $data{$fields[1]} };
-		}
-		else {
-			logError("No key '%s' found for function=3D'%s' table=3D'%s'",
-						$prikey, $function, $CGI::values{mv_data_table},
-						);
-			return undef;
-		}
-	}
-
-	my ($query,$i);
-	my (@k);
-	my (@v);
-	my (@c);
-	my (@rows_set);
-	my (@email_rows);
-
-	my $safe;
-	my $blob_field;
-	my $blob_nick;
-	my $blob_ptr;
-
-	# Fields to set in database despite mv_blob_only
-	my %blob_exception;
-
-	if($CGI::values{mv_blob_field} and $CGI::values{mv_blob_nick}) {
-#::logDebug("update_data: blob processing enabled");
-		$blob_field =3D $CGI::values{mv_blob_field};
-		$blob_nick  =3D $CGI::values{mv_blob_nick};
-		$blob_ptr   =3D $CGI::values{mv_blob_pointer};
-
-		%blob_exception   =3D
-				map { ($_, 1) } split /[\s,\0]+/, $CGI::values{mv_blob_exception};
-
-		if( ! $base_db->column_exists($blob_field) ) {
-			undef $blob_field;
-			undef $blob_nick;
-			logError("No blob field '%s' found for table=3D'%s', skipping blob save=
",
-						$CGI::values{mv_blob_field}, $CGI::values{mv_data_table},
-						);
-		}
-		elsif ($MVSAFE::Safe) {
-			$safe =3D $Vend::Interpolate::ready_safe;
-		}
-		else {
-			$safe =3D new Safe;
-		}
-		$base_db->column_exists($blob_ptr)
-			or undef $blob_ptr;
-#::logDebug("update_data: blob safe object=3D$safe");
-	}
-
-	my @multis;
-	if($CGI::values{mv_data_multiple}) {
-		my $re =3D qr/^\d+_$prikey$/;
-		@multis =3D grep $_ =3D~ $re, @cgi_keys;
-		for(@multis) {
-			s/_.*//;
-		}
-		@multis =3D sort { $a <=3D> $b } @multis;
-	}
-
-#::logDebug("update_data:db=3D$db key=3D$prikey VALUES=3D" . ::uneval(\%CG=
I::values));
-#::logDebug("update_data:db=3D$db key=3D$prikey data=3D" . ::uneval(\%data=
));
-	my $select_key;
- SETDATA: {
-	for($i =3D 0; $i < @{$data{$prikey}}; $i++) {
-#::logDebug("iteration of update_data:db=3D$db key=3D$prikey data=3D" . ::=
uneval(\%data));
-		@k =3D (); @v =3D ();
-		for(keys %data) {
-#::logDebug("iteration of field $_");
-
-			next unless (length($value =3D $data{$_}->[$i]) || $CGI::values{mv_upda=
te_empty} );
-			push(@k, $_);
-# LEGACY
-			HTML::Entities::decode($value) if $decode;
-# END LEGACY
-			if($CGI::values{"mv_data_filter_$_"}) {
-				$value =3D Vend::Interpolate::filter_value(
-							 $CGI::values{"mv_data_filter_$_"},
-							 $value,
-							 $i,
-							 );
-			}
-			$select_key =3D $value if $_ eq $prikey;
-			push(@v, $value);
-		}
-
-		if(! length($select_key) ) {
-			next if  defined $CGI::values{mv_update_empty_key}
-					 and   ! $CGI::values{mv_update_empty_key};
-		}
-
-		if($function eq 'delete') {
-			$base_db->delete_record($select_key);
-		}
-		else {
-			my $field;
-			$key =3D $data{$prikey}->[$i];
-			if(! length($key) and $autonumber) {
-				## KEY IS possibly SET HERE=20
-				$key =3D $base_db->set_row($key);
-			}
-			push(@rows_set, $key);
-
-			# allow form submissions to go to database and to mail
-			if ($CGI::values{mv_data_email}) {
-				push( @email_rows,
-					[ ::errmsg("### Form Submission from %s", $key), $blob_nick, ],
-					[ $prikey, $key, ],
-				);
-			}
-
-			my $qd =3D {};
-			my $qf =3D {};
-			my $qv =3D {};
-			my $qret;
-
-			my $blob;
-			my $brec;
-			if($blob_field) {
-				my $string =3D $base_db->field($key, $blob_field);
-#::logDebug("update_data: blob string=3D$string");
-				$blob =3D $safe->reval($string);
-#::logDebug("update_data: blob object=3D$blob");
-				$blob =3D {} unless ref($blob) eq 'HASH';
-				$brec =3D $blob;
-				my @keys =3D split /::/, $blob_nick;
-				for(@keys) {
-					unless ( ref($brec->{$_}) eq 'HASH') {
-						$brec->{$_} =3D {};
-					}
-					$brec =3D $brec->{$_};
-				}
-			}
-			while($field =3D shift @k) {
-				$value =3D shift @v;
-				next if $field eq $prikey;
-=09=09=09=09
-				## DATA IS SET HERE
-				# We are going to set the field unless it is only for
-				# storing in a blob (and possibly emailing)
-				my  ($d, $f);
-				if ($CGI::values{mv_blob_only} and ! $blob_exception{$field}) {
-#::logDebug("$field not storing, only blob");
-					$f =3D $field;
-				}
-				else {
-#::logDebug("storing d=3D$d $field blob_only=3D$CGI::values{mv_blob_only}"=
);
-					($d, $f) =3D set_db($base_db, $field);
-#::logDebug("storing table=3D$table d=3D$d f=3D$f key=3D$key");
-					if(! defined $qd->{$d}) {
-						$qd->{$d} =3D $d;
-						$qf->{$d} =3D [$f];
-						$qv->{$d} =3D [$value];
-					}
-					else {
-						push @{$qf->{$d}}, $f;
-						push @{$qv->{$d}}, $value;
-					}
-					#$d->set_field($key, $f, $value);
-				}
-
-				push(@email_rows, [$f, $value])
-					if $CGI::values{mv_data_email};
-#::logDebug("update_data:db=3D$d key=3D$key field=3D$f value=3D$value");
-				$brec->{$f} =3D $value if $brec;
-			}
-
-			for(keys %$qd) {
-				$qret =3D $qd->{$_}->set_slice($key, $qf->{$_}, $qv->{$_});
-				$rows_set[$i] =3D $qret unless $rows_set[$i];
-			}
-			if($blob) {
-				$brec->{mv_data_fields} =3D join " ", @fields;
-				my $string =3D  ::uneval_it($blob);
-#::logDebug("update_data: blob saving string=3D$string");
-				$base_db->set_field($key, $blob_field, $string);
-				if($blob_ptr) {
-					$base_db->set_field($key, $blob_ptr, $blob_nick);
-				}
-			}
-			push(
-					@email_rows,
-					[ ::errmsg("### END FORM SUBMISSION %s", $key), $blob_nick, ]
-				)
-				if $CGI::values{mv_data_email};
-		}
-	}
-	if(my $new =3D shift(@multis)) {
-#::logDebug("Doing multi for $new");
-		last SETDATA unless length $CGI::values{"${new}_$prikey"};
-		for(@fields) {
-			my $value =3D $CGI::values{$_} =3D $CGI::values{"${new}_$_"};
-			$data{$_} =3D [ $value ];
-		}
-		redo SETDATA;
-	}
- } # end SETDATA
-
-	if($CGI::values{mv_data_return_key}) {
-		my @keys =3D split /\0/, $CGI::values{mv_data_return_key};
-		for(@keys) {
-#::logDebug("return_key, setting $_");
-			$CGI::values{$_} =3D join("\0", @rows_set);
-		}
-	}
-
-	if($CGI::values{mv_auto_export}) {
-		Vend::Data::export_database($table);
-	}
-
-	if($CGI::values{mv_data_email}) {
-		push @email_rows, [ 'mv_data_fields', \@fields ];
-		Vend::Interpolate::tag_mail('', { log_error =3D> 1 }, \@email_rows);
-	}
-
-	# Allow setting in one then returning to another
-	if($CGI::values{mv_return_table}) {
-		$CGI::values{mv_data_table} =3D $CGI::values{mv_return_table};
-	}
-
-	my @reloads =3D grep /^mv_data_table__\d+$/, keys %CGI::values;
-	if(@reloads) {
-		@reloads =3D map { m/.*__(\d+)$/; $1 } @reloads;
-		@reloads =3D sort { $a <=3D> $b } @reloads;
-		my $new =3D shift @reloads;
-		my $this =3D qr{__$new$};
-		my $some =3D qr{__\d+$};
-#::logDebug("Reloading, new=3D$new this=3D$this some=3D$some");
-		my %cgiset;
-		my @death_row;
-		for(@cgi_keys) {
-			push(@death_row, $_), next unless $_ =3D~ $some;
-			if($_ =3D~ $this) {
-				my $k =3D $_;
-				$k =3D~ s/$this//;
-				$cgiset{$k} =3D delete $CGI::values{$_};
-			}
-		}
-
-		$::Scratch->{mv_data_enable} =3D delete $::Scratch->{"mv_data_enable__$n=
ew"};
-		delete $::Scratch->{mv_data_enable_key};
-
-		for(@death_row) {
-			next unless /^mv_(data|blob|update)_/ or $data{$_}; # Reprieve!
-			delete $CGI::values{$_};
-		}
-
-		@CGI::values{keys %cgiset} =3D values %cgiset;
-		update_data();
-	}
-
-	return;
-}
-
-# Parse the mv_click and mv_check special variables
-sub parse_click {
-	my ($ref, $click, $extra) =3D @_;
-    my($codere) =3D '[-\w_#/.]+';
-	my $params;
-
-#::logDebug("Looking for click $click");
-	if($params =3D $::Scratch->{$click}) {
-		# Do nothing, we found the click
-#::logDebug("Found scratch click $click =3D |$params|");
-	}
-	elsif(defined ($params =3D $Vend::Cfg->{OrderProfileName}{$click}) ) {
-		# Do nothing, we found the click
-		$params =3D $Vend::Cfg->{OrderProfile}[$params];
-#::logDebug("Found profile click $click =3D |$params|");
-	}
-	elsif(defined ($params =3D $Global::ProfilesName->{$click}) ) {
-		# Do nothing, we found the click
-		$params =3D $Global::Profiles->[$params];
-#::logDebug("Found profile click $click =3D |$params|");
-	}
-	elsif($params =3D $::Scratch->{"mv_click $click"}) {
-		$::Scratch->{mv_click_arg} =3D $click;
-	}
-	elsif($params =3D $::Scratch->{mv_click}) {
-		$::Scratch->{mv_click_arg} =3D $click;
-	}
-	else {
-#::logDebug("Found NO click $click");
-		return 1;
-	} # No click processor
-
-	my($var,$val,$parameter);
-	$params =3D interpolate_html($params);
-	my(@param) =3D split /\n+/, $params;
-
-	for(@param) {
-		next unless /\S/;
-		next if /^\s*#/;
-		s/^[\r\s]+//;
-		s/[\r\s]+$//;
-		$parameter =3D $_;
-		($var,$val) =3D split /[\s=3D]+/, $parameter, 2;
-		$val =3D~ s/&#(\d+);/chr($1)/ge;
-		$ref->{$var} =3D $val;
-		$extra->{$var} =3D $val
-			if defined $extra;
-	}
-}
-
-# This is the set of CGI-passed variables to ignore, in other words
-# never set in the user session.  If set in the mv_check pass, though,
-# they will stick.
-%Global::Ignore =3D qw(
-	mv_todo  1
-	mv_todo.submit.x  1
-	mv_todo.submit.y  1
-	mv_todo.return.x  1
-	mv_todo.return.y  1
-	mv_todo.checkout.x  1
-	mv_todo.checkout.y  1
-	mv_todo.todo.x  1
-	mv_todo.todo.y  1
-	mv_todo.map  1
-	mv_doit  1
-	mv_check  1
-	mv_click  1
-	mv_nextpage  1
-	mv_failpage  1
-	mv_successpage  1
-	mv_more_ip  1
-	mv_credit_card_number  1
-	mv_credit_card_cvv2  1
-	);
-
-sub update_values {
-
-	my (@keys) =3D @_;
-
-	my $set;
-	if(@keys) {
-		$set =3D {};
-		@{$set}{@keys} =3D @CGI::values{@keys};
-	}
-	else {
-		$set =3D \%CGI::values;
-
-		if( $Vend::Cfg->{CreditCardAuto} and $CGI::values{mv_credit_card_number}=
 ) {
-			(
-				@{$::Values}{
-					qw/
-							mv_credit_card_valid
-							mv_credit_card_info
-							mv_credit_card_exp_month
-							mv_credit_card_exp_year
-							mv_credit_card_exp_all
-							mv_credit_card_type
-							mv_credit_card_reference
-							mv_credit_card_error
-					/ }
-			) =3D encrypt_standard_cc(\%CGI::values);
-		}=09
-	}
-
-	my $restrict;
-	if($restrict =3D $Vend::Session->{restrict_html} and ! ref $restrict) {
-		$restrict =3D [ map { lc $_ } split /\s+/, $restrict ];
-		$Vend::Session->{restrict_html} =3D $restrict;
-	}
-
-    while (my ($key, $value) =3D each %$set) {
-		# values explicly ignored in configuration
-        next if defined $Global::Ignore{$key};
-        next if defined $Vend::Cfg->{FormIgnore}{$key};
-
-#LEGACY
-		# We add any checkbox ordered items, but don't update --=20
-		# we don't want to order them twice
-        next if ($key =3D~ m/^quantity\d+$/);
-#END LEGACY
-
-		# Admins should know what they are doing
-		if($Vend::admin) {
-			$::Values->{$key} =3D $value;
-			next;
-		}
-		elsif ($restrict and $value =3D~ /</) {
-			# Allow designer to allow only certain HTML tags from trusted users
-			# Will go away when current session ends...
-			# [ script start character handled in [value ...] ITL tag
-			$value =3D Vend::Interpolate::filter_value(
-						'restrict_html',
-						$value,
-						undef,
-						@$restrict,
-					);
-			$::Values->{$key} =3D $value;
-			next;
-		}
-		$value =3D~ tr/<[//d;
-		$value =3D~ s/&lt;//ig;
-		$value =3D~ s/&#91;//g;
-        $::Values->{$key} =3D $value;
-    }
-}
-
-sub update_user {
-	my($key,$value);
-    # Update the user-entered fields.
-
-	add_items() if defined $CGI::values{mv_order_item};
-	update_values();
-
-	if($CGI::values{mv_check}) {
-		my(@checks) =3D split /\s*[,\0]+\s*/, delete $CGI::values{mv_check};
-		my($check);
-		foreach $check (@checks) {
-				parse_click $::Values, $check, \%CGI::values;=09
-		}
-	}
-
-	check_save if defined $CGI::values{mv_save_session};
-
-}
-
-## DO PROCESS
-
-sub do_click {
-	my($click, @clicks);
-	do {
-		if($CGI::values{mv_click}) {
-			@clicks =3D split /\s*[\0]+\s*/, delete $CGI::values{mv_click};
-		}
-
-		if(defined $CGI::values{mv_click_map}) {
-			my(@map) =3D split /\s*[\0]+\s*/, delete $CGI::values{mv_click_map};
-			foreach $click (@map) {
-				push (@clicks, $click)
-					if defined $CGI::values{"mv_click.$click.x"}
-					or defined $CGI::values{"$click.x"}
-					or $click =3D $CGI::values{"mv_click_$click"};
-			}
-		}
-
-		foreach $click (@clicks) {
-			parse_click \%CGI::values, $click;
-		}
-	} while $CGI::values{mv_click};
-	return 1;
-}
-
-sub do_deliver {
-	my $file =3D $CGI::values{mv_data_file};
-	my $mode =3D $CGI::values{mv_acl_mode} || '';
-	if($::Scratch->{mv_deliver} !~ m{(^|\s)$file(\s|$)}
-		and=20
-		! Vend::UserDB::userdb(
-							'check_file_acl',
-							location =3D> $file,
-							mode =3D> $mode,
-							)
-		)
-	{
-		$Vend::StatusLine =3D "Status: 403\nContent-Type: text/html";
-		my $msg =3D get_locale_message(403, <<EOF);
-<B>Authorization Required<B>
-<P>
-This server could not verify that you are authorized to access the document
-requested.=20
-EOF
-		::response($msg);
-		return 0;
-	}
-
-	if (! -f $file) {
-		$Vend::StatusLine =3D "Status: 404\nContent-Type: text/html";
-		my $msg =3D get_locale_message(404, <<EOF, $file);
-<B>Not Found<B>
-<P>
-The requested file %s was not found on this server.
-
-EOF
-		::response($msg);
-		return 0;
-	}
-
-	$Vend::StatusLine =3D "Content-Type: " .
-						($CGI::values{mv_content_type} || 'application/octet-stream');
-	::response(	Vend::Util::readfile (
-					$CGI::values{mv_data_file},
-					$Global::NoAbsolute,
-				)
-			);
-	return 0;
-}
-
-my %form_action =3D (
-
-	search	=3D> \&do_search,
-	deliver	=3D> \&do_deliver,
-	submit	=3D>
-				sub {
-					update_user();
-					update_quantity()
-						or return interaction_error("quantities");
-					my $ok;
-					my($missing,$next,$status,$final,$result_hash);
-
-					# Set shopping cart if necessary
-					# Vend::Items is tied, remember!
-					$Vend::Items =3D $CGI::values{mv_cartname}
-						if $CGI::values{mv_cartname};
-
-#::logDebug("Default order route=3D$::Values->{mv_order_route}");
-					## Determine the master order route, if routes
-					## are not set in CGI values (4.7.x default)
-					if(
-						$Vend::Cfg->{Route}
-						and ! defined $::Values->{mv_order_route}
-						)
-					{
-						my $curr =3D $Vend::Cfg->{Route};
-						my $repos =3D $Vend::Cfg->{Route_repository};
-
-						if($curr->{master}) {
-							# Default route is master
-
-							for(keys %$repos) {
-								next unless $curr eq $repos->{$_};
-								$::Values->{mv_order_route} =3D $_;
-								last;
-							}
-						}
-						else {
-							for(keys %$repos) {
-								next unless $repos->{$_}->{master};
-								$::Values->{mv_order_route} =3D $_;
-								last;
-							}
-						}
-					}
-
-#::logDebug("Default order route=3D$::Values->{mv_order_route}");
-
-				  CHECK_ORDER: {
-
-					# If the user sets this later, will be used
-					delete $Vend::Session->{mv_order_number};
-
-					if (defined $CGI::values{mv_order_profile}) {
-						($status,$final,$missing) =3D
-							check_order($CGI::values{mv_order_profile});
-					}
-					else {
-						$status =3D $final =3D 1;
-					}
-#::logDebug("Profile status status=3D$status final=3D$final errors=3D$miss=
ing");
-
-					my $provisional;
-					if ($status and defined $::Values->{mv_order_route}) {
-						# This checks only route order profiles
-#::logDebug("Routing order, pre-check");
-						($status, $provisional, $missing)
-										=3D route_order(
-												$::Values->{mv_order_route},
-												$Vend::Items,
-												'check',
-											);
-					}=20
-
-					$final =3D $provisional if ! $final;
-
-#::logDebug("Routing status status=3D$status final=3D$final errors=3D$miss=
ing");
-					if($status) {
-						$CGI::values{mv_nextpage} =3D $CGI::values{mv_successpage}=20
-							if $CGI::values{mv_successpage};
-						$CGI::values{mv_nextpage} =3D $::Values->{mv_orderpage}=20
-							if ! $CGI::values{mv_nextpage};
-					}
-					else {
-						$CGI::values{mv_nextpage} =3D $CGI::values{mv_failpage}
-							if $CGI::values{mv_failpage};
-						$CGI::values{mv_nextpage} =3D find_special_page('needfield')
-							if ! $CGI::values{mv_nextpage};
-						undef $final;
-					}
-
-					return 1 unless $final;
-
-					my $order_no;
-					if (defined $::Values->{mv_order_route}) {
-						# $ok will not be defined unless Route "supplant" was set
-						# $order_no will come back so we don't issue two of them
-#::logDebug("Routing order $::Values->{mv_order_route}");
-						($ok, $order_no, $result_hash) =3D route_order(
-											$::Values->{mv_order_route},
-											$Vend::Items
-											);
-						return 1 unless $ok;
-					}
-
-					$result_hash =3D {} unless $result_hash;
-
-# TRACK
-                    $Vend::Track->finish_order ();
-# END TRACK
-					# This function (followed down) now does the rudimentary
-					# backend ordering with AsciiTrack and the order report.
-					# If the "supplant" option was set in order routing it will
-					# not be used ($ok would have been defined)
-
-
-#::logDebug("Order number=3D$order_no\n");
-					$ok =3D mail_order(undef, $order_no || undef) unless defined $ok;
-#::logDebug("Order number=3D$order_no, result_hash=3D" . ::uneval($result_=
hash));
-
-					# Display a receipt if configured
-
-					my $not_displayed =3D 1;
-
-					if(! $ok) {
-						display_special_page(
-								find_special_page('failed'),
-								errmsg('Error transmitting order(%s): %s', $!, $@),
-						);
-					}
-					elsif (! $result_hash->{no_receipt} ) {
-						eval {
-
-							my $receipt =3D $result_hash->{receipt}
-										|| $::Values->{mv_order_receipt}
-										|| find_special_page('receipt');
-#::logDebug("selected receipt=3D$receipt");
-							display_special_page($receipt);
-						};
-						$not_displayed =3D 0;
-#::logDebug("not_displayed=3D$not_displayed");
-						if($@) {
-							my $msg =3D $@;
-							::logError(=20
-								'Display of receipt on order number %s failed: %s',
-								$::Values->{mv_order_number},
-								$msg,
-							);
-						}
-					}
-
-					# Remove the items
-					@$Vend::Items =3D ();
-#::logDebug("returning order_number=3D$order_no, not_displayed=3D$not_disp=
layed");
-					return $not_displayed;
-				  }
-			},
-	refresh	=3D> sub {
-					update_quantity()
-						or return interaction_error("quantities");
-# LEGACY
-					$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
-						if $CGI::values{mv_orderpage};
-# END LEGACY
-					$CGI::values{mv_nextpage} =3D $CGI::values{mv_orderpage}
-												|| find_special_page('order')
-						if ! $CGI::values{mv_nextpage};
-					update_user();
-					return 1;
-				},
-	set		=3D> sub {
-					update_user() unless $CGI::values{mv_data_auto_number};
-					update_data();
-					update_user() if $CGI::values{mv_data_auto_number};
-					return 1;
-				},
-	autoset	=3D> sub {
-					update_data();
-					update_user();
-					return 1;
-				},
-	back    =3D> sub { return 1 },
-	return	=3D> sub {
-					update_user();
-					update_quantity()
-						or return interaction_error("quantities");
-					return 1;
-				},
-	cancel	=3D> sub {
-					put_session();
-					get_session();
-					init_session();
-					$CGI::values{mv_nextpage} =3D find_special_page('canceled')
-						if ! $CGI::values{mv_nextpage};
-					return 1;
-				},
-);
-
-$form_action{go} =3D $form_action{return};
-
-# Process the completed order or search page.
-
-sub do_process {
-
-	if($CGI::values{mv_form_profile}) {
-#::logDebug("checking form profile $CGI::values{mv_form_profile} =3D $::Sc=
ratch->{$CGI::values{mv_form_profile}}");
-		my ($status) =3D check_order($CGI::values{mv_form_profile}, \%CGI::value=
s);
-#::logDebug("checked form profile=3D" . (defined $status ? $status : 'unde=
f') );
-		return 1 if defined $status and ! $status;
-	}
-
-#::logDebug("todo=3D$CGI::values{mv_todo} prior to mv_click=3D" . join ","=
, split /\0/, $CGI::values{mv_click});
-
-    my $orig_todo =3D $CGI::values{mv_todo};
-
-	do_click();
-
-    my $todo =3D $CGI::values{mv_todo};
-
-#::logDebug("todo=3D$todo after mv_click");
-
-	# Maybe we have an imagemap input, if not, use $doit
-	if($orig_todo ne $todo) {
-		# Don't mess with it, changed in click
-	}
-	elsif (defined $CGI::values{'mv_todo.x'}) {
-		my $x =3D $CGI::values{'mv_todo.x'};
-		my $y =3D $CGI::values{'mv_todo.y'};
-		my $map =3D $CGI::values{'mv_todo.map'};
-		# Called with action_map and not package id
-		# since "autouse" is possibly in force...found
-		# by Jeff Carnahan
-		$todo =3D action_map($x,$y,$map);
-	}
-	elsif( my @todo =3D grep /^mv_todo\.\w+(?:\.x)?$/, keys %CGI::values ) {
-		# Only one todo!
-		for(@todo) {
-			delete $CGI::values{$_};
-			s/^mv_todo\.(\w+)(?:\.[xy])?$/$1/;
-		}
-		$todo =3D shift @todo;
-	}
-
-	$todo =3D $CGI::values{mv_doit} || 'back' if ! $todo;
-
-#::logDebug("todo=3D$todo after mv_click");
-
-	my ($sub, $status);
-	#Now determine the action on the todo
-    if (defined $Vend::Cfg->{FormAction}{$todo}) {
-		$sub =3D $Vend::Cfg->{FormAction}{$todo};
-	}
-    elsif (not $sub =3D $form_action{$todo} ) {
-		interaction_error("No action passed for processing\n");
-		return;
-    }
-	eval {
-		$status =3D $sub->($todo);
-	};
-	if($@) {
-		undef $status;
-		my $err =3D $@;
-		my $template =3D <<EOF;
-Sorry, there was an error in processing this form action. Please=20
-report the error or try again later.
-EOF
-		$template .=3D "\n\nError: %s\n"
-				if $Global::DisplayErrors && $Vend::Cfg->{DisplayErrors}
-			;
-		$template =3D get_locale_message(500, $template, $err);
-		$template .=3D "($err)";
-		::logError($err);
-		::response($template);
-	}
-
-	return $status;
-}
-
-sub run_in_catalog {
-	my ($cat, $job, $itl) =3D @_;
-	my ($g,$c);
-
-#::logGlobal("running job in cat=3D$cat");
-	$g =3D $Global::Catalog{$cat};
-	unless (defined $g) {
-		logGlobal( "Can't find catalog '%s'" , $cat );
-		return undef;
-	}
-
-	#$Vend::Log_suppress =3D 1;
-
-	unless ($Vend::Quiet) {
-		logGlobal("Run catalog '%s' cron group=3D%s", $cat, $job || 'INTERNAL');
-	}
-	#undef $Vend::Log_suppress;
-
-	open_cat($cat);
-
-	logError("Run cron group=3D%s", $job || 'INTERNAL');
-
-	my $croncfg =3D $Vend::Cfg->{Cron};
-
-	my $dir;
-	my @itl;
-	if($job) {
-		my $ct =3D $croncfg->{base_directory} || 'etc/cron';
-		my $gt =3D '';
-		$gt =3D "$Global::ConfDir/$ct" if $croncfg->{use_global};
-
-		for my $d ($ct, $gt) {
-#::logGlobal("check directory=3D$d for $job");
-			next unless $d;
-			next unless -d "$d/$job";
-			$dir =3D "$d/$job";
-			last;
-		}
-		if($dir) {
-			my @f =3D glob("$dir/*");
-			@f =3D grep ! -d $_, @f;
-			@f =3D grep $_ !~ /$Vend::Cfg->{HTMLsuffix}$/, @f;
-			for(@f) {
-#::logGlobal("found cron piece file=3D$_");
-				push @itl, [$_, readfile($_)];
-			}
-		}
-	}
-
-	if ($itl) {
-		push @itl, ["Passed ITL", $itl];
-	}
-
-	my @out;
-
-	if(@itl) {
-		# Run once at beginning
-		run_macro($croncfg->{initialize});
-
-		# initialize or autoload can create session
-		# but must handle all aspects
-		init_session() unless $Vend::Session;
-
-		$CGI::remote_addr ||=3D 'none';
-		$CGI::useragent   ||=3D 'commandline';
-
-		for(@itl) {
-			# Run once at beginning of each job
-			run_macro($croncfg->{autoload});
-
-			push @out, interpolate_html($_->[1]);
-		}
-	}
-	else {
-		logGlobal("Empty cron job=3D%s", $job);
-	}
-	my $out =3D join "", @out;
-	$out =3D~ s/^\s+//;
-	$out =3D~ s/\s+$/\n/;
-	$out .=3D full_dump() if $croncfg->{add_session};
-=09
-	close_cat();
-
-	# don't send email and/or write log entry if cron job returns
-	# no output (in spirit of the real cron)
-	return unless $out;
-=09
-	if(my $addr =3D $Vend::CronEmail || $croncfg->{email}) {
-		my $subject =3D $croncfg->{subject} || 'Interchange cron results for job=
: %s';
-		$subject =3D errmsg($subject, $job);
-		my $from =3D $croncfg->{from} || $Vend::Cfg->{MailOrderTo};
-		Vend::Interpolate::tag_mail($addr,
-									{
-										from =3D> $from,
-										to =3D> $addr,
-										subject =3D> $subject,
-										reply_to =3D> $croncfg->{reply_to},
-										mailer =3D> "Interchange $::VERSION",
-										extra =3D> $croncfg->{extra_headers},
-									    log_error =3D> 1,
-									},
-									$out,
-								);
-	}
-
-	if($croncfg->{log}) {
-		logData($croncfg->{log}, $out);
-	}
-
-	return $out;
-}
-
-sub config_named_catalog {
-	my ($cat_name, $source, $db_only, $dbconfig) =3D @_;
-	my ($g,$c);
-
-	$g =3D $Global::Catalog{$cat_name};
-	unless (defined $g) {
-		logGlobal( "Can't find catalog '%s'" , $cat_name );
-		return undef;
-	}
-
-	$Vend::Log_suppress =3D 1;
-
-	unless ($db_only or $Vend::Quiet) {
-		logGlobal( "Config '%s' %s%s", $g->{'name'}, $source );
-	}
-	undef $Vend::Log_suppress;
-
-    chdir $g->{'dir'}
-            or die "Couldn't change to $g->{'dir'}: $!\n";
-
-	if($db_only) {
-		logGlobal(
-			"Config table '%s' (file %s) for catalog %s from %s",
-			$db_only,
-			$dbconfig,
-			$g->{'name'},
-			$source,
-			);
-		my $cfg =3D $Global::Selector{$g->{script}}
-			or die errmsg("'%s' not a catalog (%s).", $g->{name}, $g->{script});
-		undef $cfg->{Database}{$db_only};
-		$Vend::Cfg =3D config(
-				$g->{name},
-				$g->{dir},
-				undef,
-				undef,
-				$cfg,
-				$dbconfig,
-				)
-			or die errmsg("error configuring catalog %s table %s: %s",
-							$g->{name},
-							$db_only,
-							$@,
-					);
-		open_database();
-		close_database();
-		return $Vend::Cfg;
-	}
-
-    eval {
-        $c =3D config($g->{'name'},
-					$g->{'dir'},
-					undef,
-					$g->{'base'} || undef,
-# OPTION_EXTENSION
-#					$Vend::CommandLine->{$g->{'name'}} || undef
-# END OPTION_EXTENSION
-					);
-    };
-
-    if($@) {
-		my $msg =3D $@;
-        logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
-     	return undef;
-    }
-
-	if (defined $g->{base}) {
-		open_database(1);
-		dump_structure($c, $g->{name}) if $Global::DumpStructure;
-		return $c;
-	}
-
-	eval {
-		$Vend::Cfg =3D $c;=09
-		$::Variable =3D $Vend::Cfg->{Variable};
-		$::Pragma   =3D $Vend::Cfg->{Pragma};
-		Vend::Data::read_salestax();
-		Vend::Data::read_shipping();
-		open_database(1);
-		my $db;
-
-		LREAD: {
-			last LREAD unless $db =3D $Vend::Cfg->{LocaleDatabase};
-			$db =3D database_exists_ref($db)
-				or last LREAD;
-			$db =3D $db->ref();
-			my ($k, @f);	# key and fields
-			my @l;			# refs to locale repository
-			my @n;			# names of locales
-
-			@n =3D $db->columns();
-			my $extra;
-			for(@n) {
-				$Vend::Cfg->{Locale_repository}{$_} =3D {}
-					unless $Vend::Cfg->{Locale_repository}{$_};
-				push @l, $Vend::Cfg->{Locale_repository}{$_};
-			}
-			my $i;
-			while( ($k , @f ) =3D $db->each_record) {
-				for ($i =3D 0; $i < @f; $i++) {
-					next unless length($f[$i]);
-					$l[$i]->{$k} =3D $f[$i];
-				}
-			}
-			unless ($Vend::Cfg->{Locale}) {
-				for(@n) {
-					next unless $Vend::Cfg->{Locale_repository}{$_}{'default'};
-					$Vend::Cfg->{DefaultLocale} =3D $_;
-					$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$_};
-					last;
-				}
-				unless ($Vend::Cfg->{Locale}) {
-					$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$n[0]};
-					$Vend::Cfg->{DefaultLocale} =3D $n[0];
-				}
-			}
-		}
-
-		close_database();
-	};
-
-	undef $Vend::Cfg;
-    if($@) {
-		my $msg =3D $@;
-		$msg =3D~ s/\s+$//;
-        logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
-     	return undef;
-    }
-
-	dump_structure($c, $g->{name}) if $Global::DumpStructure;
-
-	my $stime =3D scalar localtime();
-	Vend::Util::writefile(">$Global::RunDir/status.$g->{name}", "$stime\n");
-	Vend::Util::writefile(">$c->{ConfDir}/status.$g->{name}", "$stime\n");
-
-	return $c;
-
-}
-
-sub is_retired {
-	my $id =3D shift;
-	mkdir "$Vend::Cfg->{ScratchDir}/retired", 0777
-		unless -d "$Vend::Cfg->{ScratchDir}/retired";
-	my $fn =3D Vend::Util::get_filename($id, 2, 1, "$Vend::Cfg->{ScratchDir}/=
retired");
-	return -f $fn ? 1 : 0;
-}
-
-sub retire_id {
-	my $id =3D shift;
-	return unless $id =3D~ /^\w+$/;
-	mkdir "$Vend::Cfg->{ScratchDir}/retired", 0777
-		unless -d "$Vend::Cfg->{ScratchDir}/retired";
-	my $fn =3D Vend::Util::get_filename($id, 2, 1, "$Vend::Cfg->{ScratchDir}/=
retired");
-	open(TMPRET, ">$fn")
-		or die "retire id open: $!\n";
-	close(TMPRET);
-	return;
-}
-
-sub tie_static_dbm {
-	my $rw =3D shift;
-	untie(%Vend::StaticDBM) if $rw;
-	if($Global::GDBM) {
-        my $flags =3D $rw ? &GDBM_WRITER : &GDBM_READER;
-        $flags =3D &GDBM_NEWDB
-            if $rw && (! -f "$Vend::Cfg->{StaticDBM}.gdbm");
-        tie(%Vend::StaticDBM,
-            'GDBM_File',
-            "$Vend::Cfg->{StaticDBM}.gdbm",
-            $flags,
-            $Vend::Cfg->{'FileCreationMask'},
-        )
-        or $Vend::Cfg->{SaveStaticDBM} =3D delete $Vend::Cfg->{StaticDBM};
-	}
-	elsif ($Global::DB_File) {
-		tie(%Vend::StaticDBM,
-			'DB_File',
-			"$Vend::Cfg->{StaticDBM}.db",
-			($rw ? &O_RDWR | &O_CREAT : &O_RDONLY),
-			$Vend::Cfg->{'FileCreationMask'},
-			)
-		or undef $Vend::Cfg->{StaticDBM};
-	}
-	else {
-        $Vend::Cfg->{SaveStaticDBM} =3D delete $Vend::Cfg->{StaticDBM};
-	}
-	::logError("Failed to create StaticDBM %s", $Vend::Cfg->{StaticDBM})
-		if $rw && ! $Vend::Cfg->{StaticDBM};
-	return $Vend::Cfg->{StaticDBM} || undef;
-}
-
-
-sub adjust_cgi {
-
-    my($host);
-
-    die "REQUEST_METHOD is not defined" unless defined $CGI::request_method
-		or @Global::argv;
-
-	# The great and really final AOL fix
-	#
-    $host      =3D $CGI::remote_host;
-    $CGI::ip   =3D $CGI::remote_addr;
-
-	if($Global::DomainTail and $host) {
-		$host =3D~ s/.*?([-A-Za-z0-9]+\.[A-Za-z]+)$/$1/;
-	}
-	elsif($Global::IpHead) {
-		$host =3D $Global::IpQuad =3D=3D 0 ? 'nobody' : '';
-		my @ip;
-		@ip =3D split /\./, $CGI::ip;
-		$CGI::ip =3D '';
-		$CGI::ip =3D join ".", @ip[0 .. ($Global::IpQuad - 1)] if $Global::IpQua=
d;
-	}
-	#
-	# end AOL fix
-
-	# Fix Cobalt/CGIwrap problem
-    if($Global::Variable->{CGIWRAP_WORKAROUND}) {
-        $CGI::path_info =3D~ s!^$CGI::script_name!!;
-    }
-
-    $CGI::host =3D $host || $CGI::ip;
-
-    $CGI::user =3D $CGI::remote_user if $CGI::remote_user;
-	undef $CGI::authorization if $CGI::remote_user;
-
-	unless ($Global::FullUrl) {
-		$CGI::script_name =3D $CGI::script_path;
-	}
-	else {
-		if($CGI::server_port eq '80') { $CGI::server_port =3D ''; }
-		else 		{ $CGI::server_port =3D ":$CGI::server_port"; }
-		$CGI::script_name =3D $CGI::server_name .
-							$CGI::server_port .
-							$CGI::script_path;
-	}
-}
-
-sub url_history {
-	$Vend::Session->{History} =3D []
-		unless defined $Vend::Session->{History};
-	shift @{$Vend::Session->{History}}
-		if $#{$Vend::Session->{History}} >=3D $Vend::Cfg->{History};
-	if(
-		($CGI::pragma =3D~ /\bno-cache\b/ and ! $CGI::values{mv_force_cache})
-		or $CGI::values{mv_no_cache}
-		)
-	{
-		push (@{$Vend::Session->{History}},  [ 'expired', {} ]);
-	}
-	else {
-		my $save_number =3D delete $CGI::values{mv_credit_card_number};
-		my $save_cvv2   =3D delete $CGI::values{mv_credit_card_cvv2};
-		push (@{$Vend::Session->{History}},  [ $CGI::path_info, \%CGI::values ]);
-		$CGI::values{mv_credit_card_number} =3D $save_number if length($save_num=
ber);
-		$CGI::values{mv_credit_card_cvv2}   =3D $save_cvv2   if length($save_cvv=
2);
-	}
-	return;
-}
-
-## DISPATCH
-
-# Parse the invoking URL and dispatch to the handling subroutine.
-
-my %action =3D (
-    process	=3D> \&do_process,
-	ui		=3D> sub {=20
-					&UI::Primitive::ui_acl_global();
-					&do_process(@_);
-				   },
-    scan	=3D> \&do_scan,
-    search	=3D> \&do_search,
-    order	=3D> \&do_order,
-    obtain	=3D> \&do_order,
-    silent	=3D> sub {
-						$Vend::StatusLine =3D "Status: 204 No content";
-						my $extra_click =3D $Vend::FinalPath;
-						$extra_click =3D~ s:/:\0:g;
-						$CGI::values{mv_click} =3D  $CGI::values{mv_click}
-											? "$CGI::values{mv_click}\0$extra_click"
-											:  $extra_click;
-						do_process(@_);
-						::respond('');
-						return 0;
-					},
-);
-
-sub open_cat {
-	my $cat =3D shift;
-
-	if($cat) {
-		%CGI::values =3D ();
-		if($Global::Catalog{$cat}) {
-			$CGI::script_path =3D $Global::Catalog{$cat}->{script};
-			$CGI::script_name =3D $CGI::script_path;
-		}
-	}
-
-	unless (defined $Global::Selector{$CGI::script_name}) {
-		my $msg =3D get_locale_message(
-						404,
-						"Undefined catalog: %s",
-						$CGI::script_name || $cat,
-						);
-		$Vend::StatusLine =3D <<EOF;
-Status: 404 Not Found
-Content-Type: text/plain
-EOF
-		if($H) {
-			::response($msg);
-		}
-		logGlobal($msg);
-		# No close_cat() necessary
-		return;
-	}
-
-	if($Global::Foreground) {
-		my %hash;
-		tie %hash, 'Tie::ShadowHash', $Global::Selector{$CGI::script_name} ;
-		$Vend::Cfg =3D \%hash;
-	}
-	else {
-		$Vend::Cfg =3D $Global::Selector{$CGI::script_name};
-	}
-
-	$Vend::Cat =3D $Vend::Cfg->{CatalogName};
-	my $catref =3D $Global::Catalog{$Vend::Cat};
-	if(! $Global::Foreground and defined $catref->{directive}) {
-		no strict 'refs';
-		my ($key, $val);
-		while ( ($key, $val) =3D each %{$catref->{directive}}) {
-#::logDebug("directive key=3D$key val=3D" . ::uneval($val));
-			${"Global::$key"} =3D $val;
-		}
-	}
-
-	# See if it is a subcatalog
-	if (defined $Vend::Cfg->{BaseCatalog}) {
-		my $name =3D $Vend::Cfg->{BaseCatalog};
-		my $ref =3D $Global::Catalog{$name};
-		my $c =3D $Vend::Cfg;
-		$Vend::Cfg =3D $Global::Selector{$ref->{'script'}};
-		for(keys %{$c->{Replace}}) {
-			undef $Vend::Cfg->{$_};
-		}
-		copyref $c, $Vend::Cfg;
-		if($Vend::Cfg->{Variable}{MV_LANG}) {
-			my $loc =3D $Vend::Cfg->{Variable}{MV_LANG};
-			$Vend::Cfg->{Locale} =3D $Vend::Cfg->{Locale_repository}{$loc}
-					if defined $Vend::Cfg->{Locale_repository}{$loc};
-		}
-		$Vend::Cfg->{StaticPage} =3D {}
-			unless $Vend::Cfg->{Static};
-	}
-	$::Variable =3D $Vend::Cfg->{Variable};
-	$::Pragma   =3D { %{ $Vend::Cfg->{Pragma} } };
-
-	if (defined $Global::SelectorAlias{$CGI::script_name}
-		and ! defined $Vend::InternalHTTP                 )
-	{
-		my $real =3D $Global::SelectorAlias{$CGI::script_name};
-		unless (	$CGI::secure                                        or
-					$Vend::Cfg->{SecureURL} =3D~ m{$CGI::script_name$}     and
-					$Vend::Cfg->{VendURL}   !~ m{/nph-[^/]+$} 		     and
-					$Vend::Cfg->{VendURL}   !~ m{$CGI::script_name$} 		)
-		{
-			$Vend::Cfg->{VendURL}   =3D~ s!$real!$CGI::script_name!;
-			$Vend::Cfg->{SecureURL} =3D~ s!$real!$CGI::script_name!;
-		}
-	}
-	elsif ($Vend::InternalHTTP) {
-		$Vend::Cfg->{VendURL} =3D "http://" .
-								$CGI::http_host .
-								$CGI::script_path;
-		$Vend::Cfg->{ImageDir} =3D $Vend::Cfg->{ImageDirInternal}
-			if  $Vend::Cfg->{ImageDirInternal};
-	}
-
-	if($Global::HitCount and ! $cat) {
-		my $ctr =3D new Vend::CounterFile
-					"$Global::ConfDir/hits.$Vend::Cat";
-        $ctr->inc();
-	}
-
-	if ($Vend::Cfg->{SetGroup}) {
-		eval {
-			$) =3D "$Vend::Cfg->{SetGroup} $Vend::Cfg->{SetGroup}";
-		};
-		if ($@) {
-			my $msg =3D $@;
-			logGlobal( "Can't set group to GID %s: %s",
-						$Vend::Cfg->{SetGroup}, $msg
-					);
-			logError("Can't set group to GID %s: %s",
-						$Vend::Cfg->{SetGroup}, $msg
-					);
-		}
-	}
-
-	chdir $Vend::Cfg->{VendRoot}=20
-		or die "Couldn't change to $Vend::Cfg->{VendRoot}: $!\n";
-	set_file_permissions();
-# STATICPAGE
-	tie_static_dbm() if $Vend::Cfg->{StaticDBM};
-# END STATICPAGE
-	umask $Vend::Cfg->{Umask};
-
-#show_times("end cgi and config mapping") if $Global::ShowTimes;
-	open_database();
-#show_times("end open_database") if $Global::ShowTimes;
-}
-
-sub close_cat {
-	put_session() if $Vend::HaveSession;
-	close_session() if $Vend::SessionOpen;
-	close_database();
-}
-
-sub run_macro {
-	my $macro =3D shift
-		or return;
-	my $content_ref =3D shift;
-
-	my @mac;
-	if(ref $macro eq 'ARRAY') {
-		@mac =3D @$macro;
-	}
-	elsif ($macro =3D~ /^[-\s\w,]+$/) {
-		@mac =3D grep /\S/, split /[\s,]+/, $macro;
-	}
-	else {
-		push @mac, $macro;
-	}
-
-	for my $m (@mac) {
-		if ($m =3D~ /^\w+$/) {
-			my $sub =3D $Vend::Cfg->{Sub}{$m} || $Global::GlobalSub->{$m}
-				or do {
-					logError("Unknown Autoload macro '%s'.", $macro);
-					next;
-				};
-			$sub->($content_ref);
-		}
-		elsif($m =3D~ /^\w+-\w+$/) {
-			Vend::Interpolate::tag_profile($m);
-		}
-		else {
-			interpolate_html($m);
-		}
-	}
-}
-
-sub dispatch {
-	my($http) =3D @_;
-	$H =3D $http;
-
-	adjust_cgi();
-
-	open_cat();
-
-	$CGI::user =3D Vend::Util::check_authorization($CGI::authorization)
-		if defined $CGI::authorization;
-
-    my($sessionid, $seed);
-
-	$sessionid =3D $CGI::values{mv_session_id} || undef;
-	$sessionid =3D~ s/\0.*//s;
-
-	$::Instance->{CookieName} =3D $Vend::Cfg->{CookieName};
-
-	if($CGI::values{mv_tmp_session}) {
-#::logDebug("setting tmp_session");
-		$Vend::tmp_session =3D $Vend::new_session =3D 1;
-		$sessionid =3D 'nsession';
-		$Vend::Cookie =3D 1;
-		$Vend::Cfg->{ScratchDefault}{mv_no_count} =3D 1;
-		$Vend::Cfg->{ScratchDefault}{mv_no_session_id} =3D 1;
-	}
-	elsif ($::Instance->{CookieName} and defined $CGI::cookie) {
-		$CGI::cookie =3D~ m{$::Instance->{CookieName}=3D($Vend::Cfg->{CookiePatt=
ern})};
-		$seed =3D $sessionid =3D $1;
-		$::Instance->{ExternalCookie} =3D $sessionid || 1;
-		$Vend::CookieID =3D $Vend::Cookie =3D 1;
-	}
-	elsif (defined $CGI::cookie and
-		 $CGI::cookie =3D~ /\bMV_SESSION_ID=3D(\w{8,32})
-								[:_] (
-									(	\d{1,3}\.   # An IP ADDRESS
-										\d{1,3}\.
-										\d{1,3}\.
-										\d{1,3})
-									# A user name or domain
-									|	([A-Za-z0-9][-\@A-Za-z.0-9]+) )?
-									\b/x)
-	{
-		$sessionid =3D $1
-			unless defined $CGI::values{mv_pc} and $CGI::values{mv_pc} eq 'RESET';
-		$CGI::cookiehost =3D $3;
-		$CGI::cookieuser =3D $4;
-		$Vend::CookieID =3D $Vend::Cookie =3D 1;
-    }
-
-	$::Instance->{CookieName} =3D 'MV_SESSION_ID' if ! $::Instance->{CookieNa=
me};
-
-	$CGI::host =3D 'nobody' if $Vend::Cfg->{WideOpen};
-
-	if(! $sessionid) {
-		my $id =3D $::Variable->{MV_SESSION_ID};
-		$sessionid =3D $CGI::values{$id} if $CGI::values{$id};
-		if (! $sessionid and $Vend::Cfg->{FallbackIP}) {
-			$sessionid =3D generate_key($CGI::remote_addr . $CGI::useragent);
-		}
-	}
-	elsif (! $::Instance->{ExternalCookie} and $sessionid !~ /^\w+$/) {
-		my $msg =3D get_locale_message(
-						403,
-						"Unauthorized for that session %s. Logged.",
-						$sessionid,
-						);
-		$Vend::StatusLine =3D <<EOF;
-Status: 403 Unauthorized
-Content-Type: text/plain
-EOF
-		::response($msg);
-		logGlobal($msg);
-		close_cat();
-		return;
-	}
-
-# DEBUG
-#::logDebug ("session=3D'$sessionid' cookie=3D'$CGI::cookie' chost=3D'$CGI=
::cookiehost'");
-# END DEBUG
-
-RESOLVEID: {
-    if ($sessionid) {
-		$Vend::SessionID =3D $sessionid;
-    	$Vend::SessionName =3D session_name();
-		if($Vend::tmp_session) {
-			$Vend::Session =3D {};
-			init_session;
-			last RESOLVEID;
-		}
-		# get_session will return a value if a session is read,
-		# if not it will return false and a new session has been created.
-		# The IP address will be counted for robot_resolution
-		if(! get_session($seed) and ! $::Instance->{ExternalCookie}) {
-			retire_id($sessionid);
-			last RESOLVEID;
-		}
-		my $now =3D time;
-		if(! $Vend::CookieID) {
-			if( is_retired($sessionid) ) {
-				new_session();
-				last RESOLVEID;
-			}
-			my $compare_host	=3D $CGI::secure
-								? ($Vend::Session->{shost})
-								: ($Vend::Session->{ohost});
-
-			if($Vend::Cfg->{WideOpen}) {
-				# do nothing, no host checking
-			}
-			elsif(! $compare_host) {
-				new_session($seed) unless $CGI::secure;
-				init_session();
-				$Vend::Session->{shost} =3D $CGI::remote_addr;
-			}
-			elsif ($compare_host ne $CGI::remote_addr) {
-				new_session($seed);
-				init_session();
-			}
-		}
-		if ($now - $Vend::Session->{'time'} > $Vend::Cfg->{SessionExpire}) {
-			if($::Instance->{ExternalCookie}) {
-				init_session();
-			}
-			else {
-				retire_id($sessionid);
-				new_session();
-			}
-			last RESOLVEID;
-		}
-		elsif($Vend::Cfg->{RobotLimit}) {
-			if ($now - $Vend::Session->{'time'} > 30) {
-				$Vend::Session->{accesses} =3D 0;
-			}
-			else {
-				$Vend::Session->{accesses}++;
-#::logDebug("accesses=3D$Vend::Session->{accesses} admin=3D$Vend::admin");
-				if($Vend::Session->{accesses} > $Vend::Cfg->{RobotLimit}
-					and ! $Vend::admin
-					)
-				{
-					my $msg =3D errmsg(
-			"WARNING: POSSIBLE BAD ROBOT. %s accesses with no 30 second pause.",
-			$Vend::Session->{accesses},
-					);
-					do_lockout($msg);
-				}
-			}
-		}
-    }
-	else {
-		if($Vend::Cfg->{RobotLimit}) {
-			if (Vend::Session::count_ip() > $Vend::Cfg->{RobotLimit}) {
-				my $msg;
-				# Here they can get it back if they pass expiration time
-				my $wait =3D $Global::Variable->{MV_ROBOT_EXPIRE} || 86400;
-				$wait /=3D 3600;
-				$msg =3D errmsg(<<EOF, $wait);=20
-Too many new ID assignments for this IP address. Please wait at least %d h=
ours
-before trying again. Only waiting that period will allow access. Terminati=
ng.
-EOF
-				$msg =3D Vend::Page::get_locale_message(403, $msg);
-				do_lockout($msg);
-				$Vend::StatusLine =3D <<EOF;
-Status: 403 Forbidden
-Content-Type: text/plain
-EOF
-					::response($msg);
-					close_cat();
-					return;
-			}
-		}
-		new_session();
-    }
-}
-
-#::logDebug("session name=3D'$Vend::SessionName'\n");
-
-	$Vend::Calc_initialized =3D 0;
-	$CGI::values{mv_session_id} =3D $Vend::Session->{id} =3D $Vend::SessionID;
-
-	if($Vend::Cfg->{CookieLogin}) {
-		COOKIELOGIN: {
-			last COOKIELOGIN if $Vend::Session->{logged_in};
-			last COOKIELOGIN if defined $CGI::values{mv_username};
-			last COOKIELOGIN unless
-				$CGI::values{mv_username} =3D Vend::Util::read_cookie('MV_USERNAME');
-			my $password;
-			last COOKIELOGIN unless
-				$password =3D Vend::Util::read_cookie('MV_PASSWORD');
-			$CGI::values{mv_password} =3D $password;
-			my $profile =3D Vend::Util::read_cookie('MV_USERPROFILE');
-			local(%SIG);
-			undef $SIG{__DIE__};
-			eval {
-				Vend::UserDB::userdb('login', profile =3D> $profile );
-			};
-			if($@) {
-				$Vend::Session->{failure} .=3D $@;
-			}
-		}
-	}
-
-	$Vend::Session->{'arg'} =3D $Vend::Argument =3D ($CGI::values{mv_arg} || =
undef);
-
-	if ($CGI::values{mv_pc} =3D~ /\D/) {
-		$Vend::Session->{source} =3D	$CGI::values{mv_pc} eq 'RESET'
-										? ''
-										: $CGI::values{mv_pc};
-	}
-	elsif($CGI::values{mv_source}) {
-		$Vend::Session->{source} =3D	$CGI::values{mv_source};
-	}
-
-	$Vend::Session->{'user'} =3D $CGI::user;
-
-	undef $Vend::Cookie if=20
-		$Vend::Session->{logged_in} && ! $Vend::Cfg->{StaticLogged};
-
-	$CGI::pragma =3D 'no-cache'
-		if delete $::Scratch->{mv_no_cache};
-#show_times("end session get") if $Global::ShowTimes;
-
-	$Vend::FinalPath =3D $Vend::Session->{last_url} =3D $CGI::path_info;
-
-	if( defined $Vend::Session->{path_alias}{$Vend::FinalPath}	) {
-		$CGI::path_info
-					=3D $Vend::FinalPath
-					=3D $Vend::Session->{path_alias}{$Vend::FinalPath};
-		delete $Vend::Session->{path_alias}{$Vend::FinalPath}
-			if delete $Vend::Session->{one_time_path_alias}{$Vend::FinalPath};
-	}
-
-    url_history($Vend::FinalPath) if $Vend::Cfg->{History};
-
-# TRACK
-    $Vend::Track =3D new Vend::Track;
-# END TRACK
-
-	if($Vend::Cfg->{DisplayErrors} and $Global::DisplayErrors) {
-		$SIG{"__DIE__"} =3D sub {
-							my $msg =3D shift;
-							put_session() if $Vend::HaveSession;
-							my $content =3D get_locale_message(500, <<EOF, $msg);
-<HTML><HEAD><TITLE>Fatal Interchange Error</TITLE></HEAD><BODY>
-<H1>FATAL error</H1>
-<PRE>%s</PRE>
-</BODY></HTML>
-EOF
-							::response(\$content);
-							exit 0;
-		};
-	}
-
-	# Do it here so we can use autoloads and such
-	Vend::Interpolate::reset_calc() if $Global::Foreground;
-	Vend::Interpolate::init_calc();
-	new Vend::Tags;
-# LEGACY
-	ROUTINES: {
-		last ROUTINES unless index($Vend::FinalPath, '/process/') =3D=3D 0;
-		while ($Vend::FinalPath =3D~ s:/process/(locale|language|currency)/([^/]=
*)/:/process/:) {
-			$::Scratch->{"mv_$1"} =3D $2;
-		}
-		$Vend::FinalPath =3D~ s:/process/page/:/:;
-	}
-	my $locale;
-	if($locale =3D $::Scratch->{mv_language}) {
-		$Global::Variable->{LANG}
-			=3D $::Variable->{LANG} =3D $locale;
-	}
-
-	if ($Vend::Cfg->{Locale}								and
-		$locale =3D $::Scratch->{mv_locale}	and
-		defined $Vend::Cfg->{Locale_repository}->{$locale}
-		)
-	{=20
-		$Global::Variable->{LANG}
-				=3D $::Variable->{LANG}
-				=3D $::Scratch->{mv_language}
-				=3D $locale
-			 if ! $::Scratch->{mv_language};
-		Vend::Util::setlocale(	$locale,
-								($::Scratch->{mv_currency} || undef),
-								{ persist =3D> 1 }
-							);
-	}
-# END LEGACY
-
-	run_macro($Vend::Cfg->{Autoload});
-#show_times("end global Autoload macro") if $Global::ShowTimes;
-
-	for my $macro ( $Vend::Cfg->{Filter}, $Vend::Session->{Filter}) {
-		next unless $macro;
-		if (ref($macro) ne 'HASH') {
-			logError("Bad CGI filter '%s'", $macro);
-		}
-		for(keys %$macro) {
-			Vend::Interpolate::input_filter_do($_, { op =3D> $macro->{$_} } );
-		}
-	}
-
-	run_macro($Vend::Session->{Autoload});
-#show_times("end session Autoload macro") if $Global::ShowTimes;
-
-    # If the cgi-bin program was invoked with no extra path info,
-    # just display the catalog page.
-    if (! $Vend::FinalPath || $Vend::FinalPath =3D~ m:^/+$:) {
-		$Vend::FinalPath =3D find_special_page('catalog');
-    }
-
-	$Vend::FinalPath =3D~ s:^/+::;
-	$Vend::FinalPath =3D~ s/(\.html?)$//;
-
-	my $record;
-	my $adb;
-
-	if(ref $Vend::Session->{alias_table}) {
-		$record =3D $Vend::Session->{alias_table}{$Vend::FinalPath};
-		$Vend::Cfg->{AliasTable} ||=3D 'alias';
-	}
-
-	if(
-		$Vend::Cfg->{AliasTable}
-			and
-		$record=20
-			or=20
-		(
-			$adb =3D database_exists_ref($Vend::Cfg->{AliasTable})
-			  and=20
-			$record =3D $adb->row_hash($Vend::FinalPath)
-		)
-	 )
-	{
-		$Vend::FinalPath =3D $record->{real_page};
-
-		# This prevents filesystem access when we never want it
-		# If base page is not passed we allow normal resolution
-		$record->{base_page}
-			and $Vend::ForceFlypage =3D $record->{base_page};
-
-		my $ref;
-
-		## Here we populate CGI variables if desired
-		## Explicitly passed variables override this
-		if(
-			$record->{base_control}
-				and
-			$ref =3D get_option_hash($record->{base_control})
-		  )
-		{
-			for(keys %$ref) {
-				next if defined $CGI::values{$_};
-				$CGI::values{$_} =3D $ref->{$_};
-			}
-		}
-
-	}
-
-	$Vend::Session->{extension} =3D $1 || '';
-#::logDebug("path=3D$Vend::FinalPath");
-
-  DOACTION: {
-    my @path =3D split('/', $Vend::FinalPath, 2);
-	if (defined $CGI::values{mv_action}) {
-		$CGI::values{mv_todo} =3D $CGI::values{mv_action}
-			if ! defined $CGI::values{mv_todo}
-			and ! defined $CGI::values{mv_doit};
-		$Vend::Action =3D 'process';
-		$CGI::values{mv_nextpage} =3D $Vend::FinalPath
-			if ! defined $CGI::values{mv_nextpage};
-	}
-	else {
-		$Vend::Action =3D shift @path;
-	}
-
-#::logGlobal("action=3D$Vend::Action path=3D$Vend::FinalPath");
-	my ($sub, $status, $action);
-	if(defined $Vend::Cfg->{ActionMap}{$Vend::Action}) {
-		$sub =3D $Vend::Cfg->{ActionMap}{$Vend::Action};
-		$CGI::values{mv_nextpage} =3D $Vend::FinalPath
-			if ! defined $CGI::values{mv_nextpage};
-		new Vend::Parse;
-	}
-	elsif ( defined ($sub =3D $action{$Vend::Action}) )  {
-		$Vend::FinalPath =3D join "", @path;
-	}
-
-#show_times("end path/action resolve") if $Global::ShowTimes;
-
-	eval {
-		if(defined $sub) {
-				$status =3D $sub->($Vend::FinalPath);
-#show_times("end action") if $Global::ShowTimes;
-		}
-		else {
-			$status =3D 1;
-		}
-	};
-	(undef $Vend::RedoAction, redo DOACTION) if $Vend::RedoAction;
-
-	if($@) {
-		undef $status;
-		my $err =3D $@;
-		my $template =3D <<EOF;
-Sorry, there was an error in processing this form action. Please=20
-report the error or try again later.
-EOF
-		$template .=3D "\n\nError: %s\n"
-				if $Global::DisplayErrors && $Vend::Cfg->{DisplayErrors}
-			;
-		$template =3D get_locale_message(500, $template, $err);
-		$template .=3D "($err)";
-		::response($template);
-	}
-
-	$CGI::values{mv_nextpage} =3D $Vend::FinalPath
-		if ! defined $CGI::values{mv_nextpage};
-
-	do_page() if $status;
-#show_times("end page display") if $Global::ShowTimes;
-
-
-	if(my $macro =3D $Vend::Cfg->{AutoEnd}) {
-		if($macro =3D~ /\[\w+/) {
-			interpolate_html($macro);
-		}
-		elsif ($macro =3D~ /^\w+$/) {
-			$sub =3D $Vend::Cfg->{Sub}{$macro} || $Global::GlobalSub->{$macro};
-			$sub->();
-		}
-#show_times("end AutoEnd macro") if $Global::ShowTimes;
-	}
-  }
-
-# TRACK
-	$Vend::Track->filetrack();
-# END TRACK
-
-	close_cat();
-
-	undef $H;
-
-#show_times("end dispatch cleanup") if $Global::ShowTimes;
-
-	return 1;
-}
-
 ## DEBUG
=20
 sub dontwarn {
@@ -2565,16 +332,6 @@
 	1;
 }
=20
-sub dump_env {
-    my($var, $value);
-
-    open(Vend::E, ">$Vend::Cfg->{'VendRoot'}/env");
-    while(($var, $value) =3D each %ENV) {
-	print Vend::E "export $var=3D'$value'\n";
-    }
-    close Vend::E;
-}
-
 sub version {
 	print "Interchange version $VERSION copyright 1996-2002 Red Hat, Inc. and=
 others.\n";
 }
@@ -2802,27 +559,6 @@
 END
 }
=20
-## FILE PERMISSIONS
-
-sub set_file_permissions {
-	my($r, $w, $p, $u);
-
-	$r =3D $Vend::Cfg->{'ReadPermission'};
-	if    ($r eq 'user')  { $p =3D 0400;   $u =3D 0277; }
-	elsif ($r eq 'group') { $p =3D 0440;   $u =3D 0227; }
-	elsif ($r eq 'world') { $p =3D 0444;   $u =3D 0222; }
-	else                  { die "Invalid value for ReadPermission\n"; }
-
-	$w =3D $Vend::Cfg->{'WritePermission'};
-	if    ($w eq 'user')  { $p +=3D 0200;  $u &=3D 0577; }
-	elsif ($w eq 'group') { $p +=3D 0220;  $u &=3D 0557; }
-	elsif ($w eq 'world') { $p +=3D 0222;  $u &=3D 0555; }
-	else                  { die "Invalid value for WritePermission\n"; }
-
-	$Vend::Cfg->{'FileCreationMask'} =3D $p;
-	$Vend::Cfg->{'Umask'} =3D $u;
-}
-
 ## MAIN
=20
 sub catch_warnings {
@@ -3067,10 +803,7 @@
 	# Select locking mode
 	set_lock_type();
=20
-	@action{keys %{$Global::ActionMap}} =3D (values %{$Global::ActionMap})
-		if $Global::ActionMap;
-	@form_action{keys %{$Global::FormAction}} =3D (values %{$Global::FormActi=
on})
-		if $Global::FormAction;
+	Vend::Dispatch::update_global_actions();
=20
 #::logDebug(::uneval(\%Global::Catalog));
=20