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

interchange-core@interchange.redhat.com interchange-core@interchange.redhat.com
Thu Nov 8 13:08:01 2001


User:      heins
Date:      2001-11-08 18:07:03 GMT
Modified:  lib/Vend Tag: STABLE_4_8-branch Order.pm
Log:
	* Add error message if order profile not found
	* Add "filter" order check type, runs value through
	  filter and checks that it is unchanged.

Revision  Changes    Path
No                   revision



No                   revision



2.6.2.3   +29 -4     interchange/lib/Vend/Order.pm


rev 2.6.2.3, prev_rev 2.6.2.2
Index: Order.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Order.pm,v
retrieving revision 2.6.2.2
retrieving revision 2.6.2.3
diff -u -r2.6.2.2 -r2.6.2.3
--- Order.pm	2001/09/28 14:20:31	2.6.2.2
+++ Order.pm	2001/11/08 18:07:03	2.6.2.3
@@ -1,6 +1,6 @@
 # Vend::Order - Interchange order routing routines
 #
-# $Id: Order.pm,v 2.6.2.2 2001/09/28 14:20:31 racke Exp $
+# $Id: Order.pm,v 2.6.2.3 2001/11/08 18:07:03 mheins Exp $
 #
 # Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -28,7 +28,7 @@
 package Vend::Order;
 require Exporter;
 
-$VERSION = substr(q$Revision: 2.6.2.2 $, 10);
+$VERSION = substr(q$Revision: 2.6.2.3 $, 10);
 
 @ISA = qw(Exporter);
 
@@ -115,6 +115,28 @@
 							}
 							return (1, $name, '');
 						},
+	'filter'			=> sub {		
+							my($name, $value, $code) = @_;
+							my $message;
+							my $filter;
+
+							$code =~ s/\\/\\\\/g;
+							if($code =~ /(["']).+?\1$/) {
+								my @code = Text::ParseWords::shellwords($code);
+								$message = pop(@code);
+								$filter = join " ", @code;
+							}
+							else {
+								($filter, $message) = split /\s+/, $code, 2;
+							}
+
+							my $test = Vend::Interpolate::filter_value($filter, $value, $name);
+							if($test ne $value) {
+								$message ||= errmsg("%s caught by filter %s", $name, $filter);
+								return ( 0, $name, $message);
+							}
+							return (1, $name, '');
+						},
 	'regex'			=>	sub {		
 							my($name, $value, $code) = @_;
 							my $message;
@@ -833,8 +855,11 @@
 	}
 	elsif(defined $::Scratch->{$profile}) {
 		$params = $::Scratch->{$profile};
+	}
+	else {
+		::logError("Order profile %s not found", $profile);
+		return undef;
 	}
-	else { return undef }
 	return undef unless $params;
 
 	my $ref = \%CGI::values;
@@ -1396,7 +1421,7 @@
 			$::Values->{mv_credit_card_info} = build_cc_info(\%attrlist);
 		}
 		elsif ($::Values->{mv_credit_card_info}) {
-			$::Values->{mv_credit_card_info} =~ /BEGIN\s+PGP\s+MESSAGE/
+			$::Values->{mv_credit_card_info} =~ /BEGIN\s+[PG]+\s+MESSAGE/
 				and $pre_encrypted = 1;
 		}