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