[interchange-cvs] interchange - racke modified 4 files

[interchange-cvs at icdevgroup.org]

User:      racke
Date:      2005-11-08 09:50:24 GMT
Modified:  .        MANIFEST
Modified:  lib/Vend Order.pm
Added:     code/OrderCheck filter.oc unique.oc
Log:
split out filter and unique order checks

Revision  Changes    Path
2.182     +2 -0      interchange/MANIFEST


rev 2.182, prev_rev 2.181
Index: MANIFEST
===================================================================
RCS file: /var/cvs/interchange/MANIFEST,v
retrieving revision 2.181
retrieving revision 2.182
diff -u -r2.181 -r2.182
--- MANIFEST	2 Nov 2005 15:26:40 -0000	2.181
+++ MANIFEST	8 Nov 2005 09:50:23 -0000	2.182
@@ -85,11 +85,13 @@
 code/JavaScriptCheck/required.jsc
 code/OrderCheck/email_only.oc
 code/OrderCheck/exists.oc
+code/OrderCheck/filter.oc
 code/OrderCheck/future.oc
 code/OrderCheck/length.oc
 code/OrderCheck/natural.oc
 code/OrderCheck/regex.oc
 code/OrderCheck/relative_filename.oc
+code/OrderCheck/unique.oc
 code/SystemTag/accessories.coretag
 code/SystemTag/accounting.coretag
 code/SystemTag/area.coretag



1.1                  interchange/code/OrderCheck/filter.oc


rev 1.1, prev_rev 1.0
Index: filter.oc
===================================================================
# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
# Licensed under the GNU GPL v2. See file LICENSE for details.
# $Id: filter.oc,v 1.1 2005/11/08 09:50:23 racke Exp $

CodeDef filter OrderCheck 1
CodeDef filter Routine <<EOR
sub {		
	my ($ref, $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, '');
}
EOR


1.1                  interchange/code/OrderCheck/unique.oc


rev 1.1, prev_rev 1.0
Index: unique.oc
===================================================================
# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
# Licensed under the GNU GPL v2. See file LICENSE for details.
# $Id: unique.oc,v 1.1 2005/11/08 09:50:24 racke Exp $

CodeDef unique OrderCheck 1
CodeDef unique Routine <<EOR
sub {
	my ($ref, $name, $value, $code) = @_;

	$code =~ s/(\w+)(:+(\w+))?\s*//;
	my $tab = $1
		or return (0, $name, errmsg("no table specified"));
	my $col = $3;
	my $msg = $code;

	my $db = database_exists_ref($tab)
		or do {
			$msg = errmsg(
						  "Table %s doesn't exist",
						  $tab,
						 );
			return(0, $name, $msg);
		};
	my $used;
	if(! $col) {
		$used = $db->record_exists($value);
	}
	else {
		#::logDebug("Doing foreign key check, tab=$tab col=$col value=$value");
		$used = $db->foreign($value, $col);
	}

	#::logDebug("Checking unique, tab=$tab col=$col, used=$used");
	if(! $used) {
		return (1, $name, '');
	}
	else {
		$msg = errmsg(
					  "Key %s already exists in %s, try again.",
					  $value,
					  $tab,
					 ) unless $msg;
		return(0, $name, $msg);
	}
}
EOR



2.83      +2 -64     interchange/lib/Vend/Order.pm


rev 2.83, prev_rev 2.82
Index: Order.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Order.pm,v
retrieving revision 2.82
retrieving revision 2.83
diff -u -r2.82 -r2.83
--- Order.pm	7 Nov 2005 21:53:55 -0000	2.82
+++ Order.pm	8 Nov 2005 09:50:24 -0000	2.83
@@ -1,6 +1,6 @@
 # Vend::Order - Interchange order routing routines
 #
-# $Id: Order.pm,v 2.82 2005/11/07 21:53:55 jon Exp $
+# $Id: Order.pm,v 2.83 2005/11/08 09:50:24 racke Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -29,7 +29,7 @@
 package Vend::Order;
 require Exporter;
 
-$VERSION = substr(q$Revision: 2.82 $, 10);
+$VERSION = substr(q$Revision: 2.83 $, 10);
 
 @ISA = qw(Exporter);
 
@@ -127,68 +127,6 @@
 								$params =~ s/\s+//g;
 								return $params;
 							},
-	'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, '');
-						},
-	'unique'			=> sub {
-							my($name, $value, $code) = @_;
-
-							$code =~ s/(\w+)(:+(\w+))?\s*//;
-							my $tab = $1
-								or return (0, $name, errmsg("no table specified"));
-							my $col = $3;
-							my $msg = $code;
-
-							my $db = database_exists_ref($tab)
-								or do {
-									$msg = errmsg(
-										"Table %s doesn't exist",
-										$tab,
-									);
-									return(0, $name, $msg);
-								};
-							my $used;
-							if(! $col) {
-								$used = $db->record_exists($value);
-							}
-							else {
-#::logDebug("Doing foreign key check, tab=$tab col=$col value=$value");
-								$used = $db->foreign($value, $col);
-							}
-
-#::logDebug("Checking unique, tab=$tab col=$col, used=$used");
-							if(! $used) {
-								return (1, $name, '');
-							}
-							else {
-								$msg = errmsg(
-										"Key %s already exists in %s, try again.",
-										$value,
-										$tab,
-									) unless $msg;
-								return(0, $name, $msg);
-							}
-
-						},
 	'&set'			=>	sub {		
 								my($ref,$params) = @_;
 								my ($var, $value) = split /\s+/, $params, 2;