code/UI_Tag/if_mm.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: if_mm.coretag,v 1.6 2007-03-30 23:40:54 pajamian Exp $
   9
  10 UserTag if-mm Order      function name
  11 UserTag if-mm addAttr
  12 UserTag if-mm attrAlias  key name
  13 UserTag if-mm hasEndTag
  14 UserTag if-mm Version    $Revision: 1.6 $
  15 UserTag if-mm Routine    <<EOR
  16 sub {
  17         my($func, $field, $opt, $text) = @_;
  18
  19         my $record;
  20         my $status;
  21
  22         my $reverse;
  23         $reverse = $func =~ s/^\s*!\s*//;
  24
  25         my $extended = '';
  26         $extended = $1 if $field =~ s/(=.*)//;
  27
  28         my ($group, @groups);
  29         $text = 1 if ! $text;
  30   CHECKIT: {
  31         if ($group or ! ($record = $Vend::UI_entry) ) {
  32                 $record = ui_acl_enabled($group);
  33                 if ( ! ref $record) {
  34                         $status = $record;
  35                         last CHECKIT;
  36                 }
  37         }
  38         ($status = 0, last CHECKIT) if ! UI::Primitive::is_logged();
  39         ($status = 1, last CHECKIT) if $record->{super};
  40         $func = lc $func;
  41         ($status = 1, last CHECKIT) if $func eq 'logged_in';
  42
  43         my %acl_func = qw/
  44                                                 fields  fields
  45                                                 field   fields
  46                                                 columns fields
  47                                                 column  fields
  48                                                 col     fields
  49                                                 row             keys
  50                                                 rows    keys
  51                                                 key             keys
  52                                                 keys    keys
  53                                                 owner_field     owner_field
  54                                                 owner   owner_field
  55                                         /;
  56
  57         my %file_func = qw/
  58                                                 page    pages
  59                                                 file    files
  60                                                 pages   pages
  61                                                 files   files
  62                                         /;
  63
  64         my %bool_func = qw/
  65                                                 config   1
  66                                                 reconfig 1
  67                                         /;
  68
  69         my %paranoid = qw/
  70                                                 mml             1
  71                                                 sql             1
  72                                                 report          1
  73                                                 add_delete      1
  74                                                 add_field       1
  75                                                 journal_update  1
  76                                         /;
  77         my %yesno_func = qw/
  78                                                 functions  functions
  79                                                 advanced  functions
  80                                                 tables  tables
  81                                                 table   tables
  82                                         /;
  83         my %prefix_func = qw/
  84                                                 filematch  files
  85                                                 pagematch  pages
  86                                         /;
  87
  88         my $table = $CGI::values{mv_data_table} || $::Values->{mv_data_table};
  89
  90         if($yesno_func{$func} eq 'tables') {
  91                 $opt->{table} = $field if ! $opt->{table};
  92                 $opt->{table} =~ s/^=/$table/;
  93         }
  94         elsif($yesno_func{$func} eq 'functions') {
  95                 $opt->{table} = $field;
  96         }
  97
  98         $table = $opt->{table} || $table;
  99
 100         my $acl;
 101         my $check;
 102         $status = 0, last CHECKIT if $func eq 'super';
 103         if($check = $file_func{$func}) {
 104                 $status = 1, last CHECKIT unless $record->{$check};
 105                 my $file = $field || $Global::Variable->{MV_PAGE};
 106                 # strip trailing slashes for checks on directories
 107                 $file =~ s%/+$%%;
 108 #::logDebug("check=$check file=$file record=$record->{$check} prefix=$opt->{prefix}");
 109                 my @files =  UI::Primitive::list_glob($record->{$check}, $opt->{prefix});
 110 #::logDebug("check yielded files=" . join(",", @files));
 111                 if(! @files) {
 112                         $status = '';
 113                         last CHECKIT;
 114                 }
 115                 $status = ui_check_acl("$file$extended", join(" ", @files));
 116 #::logDebug("check status=$status");
 117                 last CHECKIT;
 118         }
 119         if($check = $prefix_func{$func}) {
 120                 $status = '', last CHECKIT unless $record->{$check};
 121                 my $file = $field;
 122                 # strip trailing slashes for checks on directories
 123 #::logDebug("check=$check file=$file record=$record->{$check}");
 124                 my @allow =  split /\s+/, $record->{$check};
 125                 $status = '';
 126                 for(@allow) {
 127 #::logDebug("check file=$file against allow=$_");
 128                         if(s/^\!//) {
 129                                 if ($file =~ /^$_/) {
 130 #::logDebug("denied based on $_");
 131                                         $status = '';
 132                                         last CHECKIT;
 133                                 }
 134                         }
 135                         else {
 136                                 next unless $file =~ /^$_\b/;
 137                                 $status = 1;
 138                         }
 139                 }
 140 #::logDebug("check Yielded status=$status");
 141                 last CHECKIT;
 142         }
 143         if($bool_func{$func} ) {
 144                 $status = $record->{$func};
 145                 last CHECKIT;
 146         }
 147         if($check = $yesno_func{$func} ) {
 148                 my $v;
 149                 if($v = $record->{"yes_$check"}) {
 150                         $status = ui_check_acl("$table$extended", $v);
 151                 }
 152                 else {
 153                         $status = 1;
 154                 }
 155                 if($v = $record->{"no_$check"}) {
 156                         $status &&= ! ui_check_acl("$table$extended", $v);
 157                 }
 158                 last CHECKIT;
 159         }
 160         if(! ($check = $acl_func{$func}) ) {
 161                 my $default = $func =~ /^no_/ ? 0 : 1;
 162                 $status = $default, last CHECKIT unless $record->{$func};
 163                 $status = ui_check_acl("$table$extended", $record->{$func});
 164                 last CHECKIT;
 165         }
 166
 167         # Now it is definitely a job for table_control;
 168         $acl = UI::Primitive::get_ui_table_acl($table);
 169
 170         $status = 1, last CHECKIT unless $acl;
 171         my $val;
 172         if($acl->{owner_field} and $check eq 'keys') {
 173                 $status = ::tag_data($table, $acl->{owner_field}, $field)
 174                                         eq $Vend::username;
 175                 last CHECKIT;
 176         }
 177         elsif ($check eq 'owner_field') {
 178                 $status = length $acl->{owner_field};
 179                 last CHECKIT;
 180         }
 181         $status = UI::Primitive::ui_acl_atom($acl, $check, $field);
 182   }
 183         if(! $status and $record and (@groups or $record->{groups}) ) {
 184                 goto CHECKIT if $group = shift @groups;
 185                 (@groups) = grep /\S/, split /[\0,\s]+/, $record->{groups};
 186                 ($group, @groups) = map { s/^/:/; $_ } @groups;
 187                 goto CHECKIT;
 188         }
 189         return $status
 190                 ? (
 191                         Vend::Interpolate::pull_if($text, $reverse)
 192                   )
 193                 : Vend::Interpolate::pull_else($text, $reverse);
 194 }
 195 EOR