code/OrderCheck/unique.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: unique.oc,v 1.3 2007-03-30 23:40:48 pajamian Exp $
   9
  10 CodeDef unique OrderCheck 1
  11 CodeDef unique Description Unique record
  12 CodeDef unique 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         my $used;
  31         if(! $col) {
  32                 $used = $db->record_exists($value);
  33         }
  34         else {
  35                 #::logDebug("Doing foreign key check, tab=$tab col=$col value=$value");
  36                 $used = $db->foreign($value, $col);
  37         }
  38
  39         #::logDebug("Checking unique, tab=$tab col=$col, used=$used");
  40         if(! $used) {
  41                 return (1, $name, '');
  42         }
  43         else {
  44                 $msg = errmsg(
  45                                           "Key %s already exists in %s, try again.",
  46                                           $value,
  47                                           $tab,
  48                                          ) unless $msg;
  49                 return(0, $name, $msg);
  50         }
  51 }
  52 EOR