code/OrderCheck/exists.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: exists.oc,v 1.3 2007-03-30 23:40:48 pajamian Exp $
   9
  10 CodeDef exists OrderCheck 1
  11 CodeDef exists Description Existing record
  12 CodeDef exists Routine <<EOR
  13 sub {
  14         my($ref, $name, $value, $code) = @_;
  15
  16         $code =~ s/(\w+)(:+(\w+))?\s*//;
  17         my $tab = $1
  18                 or return (0, $name, errmsg("no table specified"));
  19         my $col = $3;
  20         my $msg = $code;
  21
  22         my $db = database_exists_ref($tab)
  23                 or do {
  24                         $msg = errmsg(
  25                                                   "Table %s doesn't exist",
  26                                                   $tab,
  27                                                  );
  28                         return(0, $name, $msg);
  29                 };
  30
  31         my $used;
  32         if(! $col) {
  33                 $used = $db->record_exists($value);
  34         }
  35         else {
  36                 #::logDebug("Doing foreign key check, tab=$tab col=$col value=$value");
  37                 $used = $db->foreign($value, $col);
  38         }
  39
  40         #::logDebug("Checking exists, tab=$tab col=$col, used=$used");
  41         if($used) {
  42                 return (1, $name, '');
  43         }
  44         else {
  45                 $msg = errmsg(
  46                                           "Key %s does not exist in %s, try again.",
  47                                           $value,
  48                                           $tab,
  49                                          ) unless $msg;
  50                 return(0, $name, $msg);
  51         }
  52
  53 }
  54 EOR