code/UI_Tag/db_hash.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: db_hash.coretag,v 1.5 2007-03-30 23:40:54 pajamian Exp $
   9
  10 UserTag db-hash Order      table column key
  11 UserTag db-hash PosNumber  3
  12 UserTag db-hash addAttr
  13 UserTag db-hash Version    $Revision: 1.5 $
  14 UserTag db-hash Routine    <<EOR
  15 sub {
  16         my($table, $col, $key, $opt) = @_;
  17         $col =~ s/:+(.*)//s;
  18         my $out;
  19         my $rest = $1;
  20         my $val = ::tag_data($table,$col,$key);
  21
  22         my $ref;
  23         if ($val !~ /\S/) {
  24                 $ref = {};
  25         }
  26         else {
  27                 $ref = $Vend::Interpolate::ready_safe->reval($val);
  28                 if (! ref $ref) {
  29                         $ref = {};
  30                 }
  31         }
  32         if (! $rest) {
  33                 return $val unless defined $opt->{value};
  34         }
  35         my @extra;
  36         @extra = split /:+/, $rest;
  37         my $final = pop @extra;
  38         my $curr = $ref;
  39         $out .= "Original key request: $rest\n";
  40         $out .= "\nFinal key: $final\n";
  41         for(@extra) {
  42                 $out .= "key --> $_\n";
  43                 $curr = $curr->{$_};
  44                 if (! ref $curr) {
  45                         return "BAD HASH: $out" if $opt->{show_error};
  46                         return;
  47                 }
  48         }
  49
  50         if($opt->{keys}) {
  51                 return join get_joiner($opt->{joiner}), sort keys %$curr;
  52         }
  53         elsif(! defined $opt->{value}) {
  54                 return $curr->{$final};
  55         }
  56         else {
  57                 $curr->{$final} = $opt->{value};
  58                 tag_data($table, $col, $key, { value => uneval_it($ref) });
  59                 return $curr->{$final};
  60         }
  61 }
  62 EOR