code/SystemTag/record.coretag

   1 # Copyright 2002-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: record.coretag,v 1.4 2007-03-30 23:40:49 pajamian Exp $
   9
  10 UserTag record              addAttr
  11 UserTag record              attrAlias    column col
  12 UserTag record              attrAlias    code key
  13 UserTag record              attrAlias    field col
  14 UserTag record              PosNumber    0
  15 UserTag record              Version      $Revision: 1.4 $
  16 UserTag record              Routine      <<EOR
  17 sub {
  18         my ($opt) = @_;
  19         my $db = $Vend::Database{$opt->{table}};
  20         return undef if ! $db;
  21         $db = $db->ref();
  22         # This can be called from Perl
  23         my (@cols, @vals);
  24         my $hash   = $opt->{col};
  25         my $filter = $opt->{filter};
  26
  27         return undef unless defined $opt->{key};
  28         my $key = $opt->{key};
  29         return undef unless ref $hash;
  30         undef $filter unless ref $filter;
  31         @cols = keys %$hash;
  32         @vals = values %$hash;
  33
  34         RESOLVE: {
  35                 my $i = -1;
  36                 for(@cols) {
  37                         $i++;
  38                         if(! defined $db->test_column($_) ) {
  39                                 splice (@cols, $i, 1);
  40                                 my $tmp = splice (@vals, $i, 1);
  41                                 ::logError("bad field %s in record update, value=%s", $_, $tmp);
  42                                 redo RESOLVE;
  43                         }
  44                         next unless defined $filter->{$_};
  45                         $vals[$i] = filter_value($filter->{$_}, $vals[$i], $_);
  46                 }
  47         }
  48
  49         my $status;
  50         eval {
  51                 my $status = $db->set_slice($key, \@cols, \@vals);
  52         };
  53         if($@) {
  54                 return $@ if $opt->{show_error};
  55         }
  56         return $status;
  57 }
  58 EOR