code/UI_Tag/list_keys.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: list_keys.coretag,v 1.5 2007-03-30 23:40:54 pajamian Exp $
   9
  10 UserTag list-keys Order    table
  11 UserTag list-keys addAttr
  12 UserTag list-keys Version  $Revision: 1.5 $
  13 UserTag list-keys Routine  <<EOR
  14 sub {
  15         my $table = shift;
  16 #::logDebug("list-keys $table");
  17         $table = $::Values->{mv_data_table}
  18                 unless $table;
  19 #::logDebug("list-keys $table");
  20         my @keys;
  21         my $record;
  22         if(! ($record = $Vend::UI_entry) ) {
  23                 $record =  ui_acl_enabled();
  24         }
  25
  26         my $acl;
  27         my $keys;
  28         if($record) {
  29 #::logDebug("list_keys: record=$record");
  30                 $acl = get_ui_table_acl($table);
  31 #::logDebug("list_keys table=$table: acl=$acl");
  32                 if($acl and $acl->{yes_keys}) {
  33 #::logDebug("list_keys table=$table: yes.keys enabled");
  34                         @keys = grep /\S/, split /\s+/, $acl->{yes_keys};
  35                 }
  36         }
  37         unless (@keys) {
  38                 my $db = Vend::Data::database_exists_ref($table);
  39                 return '' unless $db;
  40                 $db = $db->ref() unless $Vend::Interpolate::Db{$table};
  41                 my $keyname = $db->config('KEY');
  42                 if($db->config('LARGE')) {
  43                         return ::errmsg('--not listed, too large--');
  44                 }
  45                 my $query = "select $keyname from $table order by $keyname";
  46 #::logDebug("list_keys: query=$query");
  47                 $keys = $db->query(
  48                                                 {
  49                                                         query => $query,
  50                                                         ml => $::Variable->{UI_ACCESS_KEY_LIMIT} || 500,
  51                                                         st => 'db',
  52                                                 }
  53                                         );
  54                 if(defined $keys) {
  55                         @keys = map {$_->[0]} @$keys;
  56                 }
  57                 else {
  58                         my $k;
  59                         while (($k) = $db->each_record()) {
  60                                 push(@keys, $k);
  61                         }
  62                         if( $db->numeric($db->config('KEY')) ) {
  63                                 @keys = sort { $a <=> $b } @keys;
  64                         }
  65                         else {
  66                                 @keys = sort @keys;
  67                         }
  68                 }
  69 #::logDebug("list_keys: query=returned " . ::uneval(\@keys));
  70         }
  71         if($acl) {
  72 #::logDebug("list_keys acl: ". ::uneval($acl));
  73                 @keys = UI::Primitive::ui_acl_grep( $acl, 'keys', @keys);
  74         }
  75         return @keys if wantarray;
  76         return join("\n", @keys);
  77 }
  78 EOR