code/OrderCheck/future.oc

   1 # Copyright 2005-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: future.oc,v 1.5 2007-03-30 23:40:48 pajamian Exp $
   9
  10 CodeDef future OrderCheck 1
  11 CodeDef future Description Future date
  12 CodeDef future Routine <<EOR
  13 sub {
  14         my($ref, $name, $value, $code) = @_;
  15         my $message;
  16
  17         my @code = Text::ParseWords::shellwords($code);
  18         if($code =~ /(["']).+?\1$/) {
  19                 $message = pop(@code);
  20         }
  21         my $adjust = join " ", @code;
  22         if(! $message) {
  23                 $message = errmsg(
  24                                                   "Date must be in the future at least %s",
  25                                                   $adjust,
  26                                                  );
  27         }
  28         if($value =~ /\0/) {
  29                 $value = Vend::Interpolate::filter_value(
  30                                                                                                  'date_change',
  31                                                                                                  $value,
  32                                                                                                 );
  33         }
  34         my $current = Vend::Interpolate::mvtime(
  35                                                                                         undef,
  36                                                                                         { adjust => $adjust },
  37                                                                                         "%Y%m%d%H%M",
  38                                                                                    );
  39
  40         # reject invalid dates
  41         if($value !~ /^[12]\d\d\d[01]\d[0123]\d(?:[0-2]\d[0-5]\d(?:[0-5]\d)?)?$/) {
  42                 return (0, $name, $message);
  43         }
  44
  45         if($value lt $current) {
  46                 return (0, $name, $message);
  47         }
  48         return (1, $name, '');
  49 }
  50 EOR