[interchange-cvs] interchange - racke modified 6 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Fri Oct 14 10:18:36 EDT 2005
User: racke
Date: 2005-10-14 14:18:35 GMT
Modified: . MANIFEST
Modified: lib/Vend Order.pm
Added: code/OrderCheck future.oc length.oc natural.oc regex.oc
Log:
new order check natural for natural numbers
split out future,length,regex order checks
Revision Changes Path
2.179 +4 -0 interchange/MANIFEST
rev 2.179, prev_rev 2.178
Index: MANIFEST
===================================================================
RCS file: /var/cvs/interchange/MANIFEST,v
retrieving revision 2.178
retrieving revision 2.179
diff -u -r2.178 -r2.179
--- MANIFEST 14 Oct 2005 07:42:51 -0000 2.178
+++ MANIFEST 14 Oct 2005 14:18:35 -0000 2.179
@@ -85,6 +85,10 @@
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
1.1 interchange/code/OrderCheck/future.oc
rev 1.1, prev_rev 1.0
Index: future.oc
===================================================================
# 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
1.1 interchange/code/OrderCheck/length.oc
rev 1.1, prev_rev 1.0
Index: length.oc
===================================================================
# 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
1.1 interchange/code/OrderCheck/natural.oc
rev 1.1, prev_rev 1.0
Index: natural.oc
===================================================================
# 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
1.1 interchange/code/OrderCheck/regex.oc
rev 1.1, prev_rev 1.0
Index: regex.oc
===================================================================
# 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
2.79 +2 -92 interchange/lib/Vend/Order.pm
rev 2.79, prev_rev 2.78
Index: Order.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Order.pm,v
retrieving revision 2.78
retrieving revision 2.79
diff -u -r2.78 -r2.79
--- Order.pm 14 Oct 2005 07:42:50 -0000 2.78
+++ Order.pm 14 Oct 2005 14:18:35 -0000 2.79
@@ -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 @@
$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 @@
}
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 $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 {
More information about the interchange-cvs
mailing list