Permalink
Browse files

new order check natural for natural numbers

split out future,length,regex order checks
  • Loading branch information...
1 parent 23fb487 commit 1d26797609866296d8e0176d90937c89a35d0be2 @racke racke committed Oct 14, 2005
Showing with 134 additions and 92 deletions.
  1. +4 −0 MANIFEST
  2. +39 −0 code/OrderCheck/future.oc
  3. +33 −0 code/OrderCheck/length.oc
  4. +17 −0 code/OrderCheck/natural.oc
  5. +39 −0 code/OrderCheck/regex.oc
  6. +2 −92 lib/Vend/Order.pm
View
4 MANIFEST
@@ -85,6 +85,10 @@ code/Filter/zerofix.filter
code/JavaScriptCheck/required.jsc
code/OrderCheck/email_only.oc
code/OrderCheck/exists.oc
+code/OrderCheck/future.oc
+code/OrderCheck/length.oc
+code/OrderCheck/natural.oc
+code/OrderCheck/regex.oc
code/OrderCheck/relative_filename.oc
code/SystemTag/accessories.coretag
code/SystemTag/accounting.coretag
View
39 code/OrderCheck/future.oc
@@ -0,0 +1,39 @@
+# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
+# Licensed under the GNU GPL v2. See file LICENSE for details.
+# $Id: future.oc,v 1.1 2005-10-14 14:18:35 racke Exp $
+
+CodeDef future OrderCheck 1
+CodeDef future Routine <<EOR
+sub {
+ my($ref, $name, $value, $code) = @_;
+ my $message;
+
+ my @code = Text::ParseWords::shellwords($code);
+ if($code =~ /(["']).+?\1$/) {
+ $message = pop(@code);
+ }
+ my $adjust = join " ", @code;
+ if(! $message) {
+ $message = errmsg(
+ "Date must be in the future at least %s",
+ $adjust,
+ );
+ }
+ if($value =~ /\0/) {
+ $value = Vend::Interpolate::filter_value(
+ 'date_change',
+ $value,
+ );
+ }
+ my $current = Vend::Interpolate::mvtime(
+ undef,
+ { adjust => $adjust },
+ "%Y%m%d%H%M",
+ );
+ #::logDebug("current time: $current input value=$value");
+ if($value lt $current) {
+ return (0, $name, $message);
+ }
+ return (1, $name, '');
+}
+EOR
View
33 code/OrderCheck/length.oc
@@ -0,0 +1,33 @@
+# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
+# Licensed under the GNU GPL v2. See file LICENSE for details.
+# $Id: length.oc,v 1.1 2005-10-14 14:18:35 racke Exp $
+
+CodeDef length OrderCheck 1
+CodeDef length Routine <<EOR
+sub {
+ my($ref, $name, $value, $msg) = @_;
+ $msg =~ s/^(\d+)(?:\s*-(\d+))?\s*//
+ or return undef;
+ my $min = $1;
+ my $max = $2;
+ my $len = length($value);
+
+ if($len < $min) {
+ $msg = errmsg(
+ "%s length %s less than minimum length %s.",
+ $name,
+ $len,
+ $min) if ! $msg;
+ return(0, $name, $msg);
+ }
+ elsif($max and $len > $max) {
+ $msg = errmsg(
+ "%s length %s more than maximum length %s.",
+ $name,
+ $len,
+ $max) if ! $msg;
+ return(0, $name, $msg);
+ }
+ return (1, $name, '');
+}
+EOR
View
17 code/OrderCheck/natural.oc
@@ -0,0 +1,17 @@
+# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
+# Licensed under the GNU GPL v2. See file LICENSE for details.
+# $Id: natural.oc,v 1.1 2005-10-14 14:18:35 racke Exp $
+
+CodeDef natural OrderCheck
+CodeDef natural Routine <<EOR
+sub {
+ my ($ref, $name, $value, $code) = @_;
+
+ if ($value && $value eq int($value)) {
+ return (1, $name, '');
+ }
+
+ return (0, $name, 'no natural number');
+}
+EOR
+
View
39 code/OrderCheck/regex.oc
@@ -0,0 +1,39 @@
+# Copyright 2005 Interchange Development Group (http://www.icdevgroup.org/)
+# Licensed under the GNU GPL v2. See file LICENSE for details.
+# $Id: regex.oc,v 1.1 2005-10-14 14:18:35 racke Exp $
+
+CodeDef regex OrderCheck 1
+CodeDef regex Routine <<EOR
+sub {
+ my($ref, $name, $value, $code) = @_;
+ my $message;
+
+ $code =~ s/\\/\\\\/g;
+ my @code = Text::ParseWords::shellwords($code);
+ if($code =~ /(["']).+?\1$/) {
+ $message = pop(@code);
+ }
+
+ for(@code) {
+ my $negate;
+ s/^!\s*// and $negate = 1;
+ my $op = $negate ? "!~" : '=~';
+ my $regex = qr($_);
+ my $status;
+ if($negate) {
+ $status = ($value !~ $regex);
+ }
+ else {
+ $status = ($value =~ $regex);
+ }
+ if(! $status) {
+ $message = errmsg(
+ "failed pattern - %s",
+ "'$value' $op $_"
+ ) if ! $message;
+ return ( 0, $name, $message);
+ }
+ }
+ return (1, $name, '');
+}
+EOR
View
94 lib/Vend/Order.pm
@@ -1,6 +1,6 @@
# Vend::Order - Interchange order routing routines
#
-# $Id: Order.pm,v 2.78 2005-10-14 07:42:50 racke Exp $
+# $Id: Order.pm,v 2.79 2005-10-14 14:18:35 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.78 $, 10);
+$VERSION = substr(q$Revision: 2.79 $, 10);
@ISA = qw(Exporter);
@@ -127,32 +127,6 @@ my %Parse = (
$params =~ s/\s+//g;
return $params;
},
- 'length' => sub {
- my($name, $value, $msg) = @_;
- $msg =~ s/^(\d+)(?:\s*-(\d+))?\s*//
- or return undef;
- my $min = $1;
- my $max = $2;
- my $len = length($value);
-
- if($len < $min) {
- $msg = errmsg(
- "%s length %s less than minimum length %s.",
- $name,
- $len,
- $min) if ! $msg;
- return(0, $name, $msg);
- }
- elsif($max and $len > $max) {
- $msg = errmsg(
- "%s length %s more than maximum length %s.",
- $name,
- $len,
- $max) if ! $msg;
- return(0, $name, $msg);
- }
- return (1, $name, '');
- },
'filter' => sub {
my($name, $value, $code) = @_;
my $message;
@@ -175,38 +149,6 @@ my %Parse = (
}
return (1, $name, '');
},
- 'regex' => sub {
- my($name, $value, $code) = @_;
- my $message;
-
- $code =~ s/\\/\\\\/g;
- my @code = Text::ParseWords::shellwords($code);
- if($code =~ /(["']).+?\1$/) {
- $message = pop(@code);
- }
-
- for(@code) {
- my $negate;
- s/^!\s*// and $negate = 1;
- my $op = $negate ? "!~" : '=~';
- my $regex = qr($_);
- my $status;
- if($negate) {
- $status = ($value !~ $regex);
- }
- else {
- $status = ($value =~ $regex);
- }
- if(! $status) {
- $message = errmsg(
- "failed pattern - %s",
- "'$value' $op $_"
- ) if ! $message;
- return ( 0, $name, $message);
- }
- }
- return (1, $name, '');
- },
'unique' => sub {
my($name, $value, $code) = @_;
@@ -259,38 +201,6 @@ my %Parse = (
my $msg = errmsg("%s set failed.", $var);
return ($value, $var, $msg);
},
- future => sub {
- my($name, $value, $code) = @_;
- my $message;
-
- my @code = Text::ParseWords::shellwords($code);
- if($code =~ /(["']).+?\1$/) {
- $message = pop(@code);
- }
- my $adjust = join " ", @code;
- if(! $message) {
- $message = errmsg(
- "Date must be in the future at least %s",
- $adjust,
- );
- }
- if($value =~ /\0/) {
- $value = Vend::Interpolate::filter_value(
- 'date_change',
- $value,
- );
- }
- my $current = Vend::Interpolate::mvtime(
- undef,
- { adjust => $adjust },
- "%Y%m%d%H%M",
- );
-#::logDebug("current time: $current input value=$value");
- if($value lt $current) {
- return (0, $name, $message);
- }
- return (1, $name, '');
- },
);
sub _update {

0 comments on commit 1d26797

Please sign in to comment.