lib/TWiki/If/Node.pm
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 # See bottom of file for copyright and license details
       
     2 
       
     3 =pod
       
     4 
       
     5 ---+ package TWiki::If::Node
       
     6 
       
     7 Node class for the result of an If statement parse
       
     8 
       
     9 =cut
       
    10 
       
    11 package TWiki::If::Node;
       
    12 use base 'TWiki::Query::Node';
       
    13 
       
    14 require TWiki::Infix::Node;
       
    15 
       
    16 sub newLeaf {
       
    17     my( $class, $val, $type ) = @_;
       
    18     if( $type == $TWiki::Infix::Node::NAME && $val =~ /^({\w+})+$/) {
       
    19         eval '$val = $TWiki::cfg'.$val;
       
    20         return $class->SUPER::newLeaf($val, $TWiki::Infix::Node::STRING);
       
    21     } else {
       
    22         return $class->SUPER::newLeaf($val, $type);
       
    23     }
       
    24 }
       
    25 
       
    26 # Used wherever a plain string is expected, this method suppresses automatic
       
    27 # lookup of names in meta-data
       
    28 sub _evaluate {
       
    29     my $this = shift;
       
    30     my $result;
       
    31 
       
    32     if (!ref( $this->{op})) {
       
    33         return $this->{params}[0];
       
    34     } else {
       
    35         return $this->evaluate(@_);
       
    36     }
       
    37 }
       
    38 
       
    39 sub OP_context {
       
    40     my $this = shift;
       
    41     my $a = $this->{params}->[0];
       
    42     my $text = $a->_evaluate(@_) || '';
       
    43     my %domain = @_;
       
    44     my $session = $domain{tom}->session;
       
    45     throw Error::Simple('No context in which to evaluate "'.
       
    46                           $a->stringify().'"') unless $session;
       
    47     return $session->inContext($text) || 0;
       
    48 }
       
    49 
       
    50 sub OP_allows {
       
    51     my $this = shift;
       
    52     my $a = $this->{params}->[0]; # topic name (string)
       
    53     my $b = $this->{params}->[1]; # access mode (string)
       
    54     my $mode = $b->_evaluate(@_) || 'view';
       
    55     my %domain = @_;
       
    56     my $session = $domain{tom}->session;
       
    57     throw Error::Simple('No context in which to evaluate "'.
       
    58                           $a->stringify().'"') unless $session;
       
    59     my $str = $a->evaluate(@_);
       
    60     return 0 unless $str;
       
    61     my ($web, $topic) = $session->normalizeWebTopicName(
       
    62         $session->{webName}, $str);
       
    63     my $ok = 0;
       
    64     if ($session->{store}->topicExists($web, $topic)) {
       
    65         $ok = $session->security->checkAccessPermission(
       
    66             uc($mode), $session->{user}, undef, undef, $topic, $web);
       
    67     } elsif ($session->{store}->webExists($str)) {
       
    68         $ok = $session->security->checkAccessPermission(
       
    69             uc($mode), $session->{user}, undef, undef, undef, $str);
       
    70     } else {
       
    71         $ok = 0;
       
    72     }
       
    73     return $ok ? 1 : 0;
       
    74 }
       
    75 
       
    76 sub OP_istopic {
       
    77     my $this = shift;
       
    78     my $a = $this->{params}->[0];
       
    79     my %domain = @_;
       
    80     my $session = $domain{tom}->session;
       
    81     throw Error::Simple('No context in which to evaluate "'.
       
    82                           $a->stringify().'"') unless $session;
       
    83     my ($web, $topic) = $session->normalizeWebTopicName(
       
    84         $session->{webName}, $a->_evaluate(@_) || '');
       
    85     return $session->{store}->topicExists($web, $topic) ? 1 : 0;
       
    86 }
       
    87 
       
    88 sub OP_isweb {
       
    89     my $this = shift;
       
    90     my $a = $this->{params}->[0];
       
    91     my %domain = @_;
       
    92     my $session = $domain{tom}->session;
       
    93     throw Error::Simple('No context in which to evaluate "'.
       
    94                           $a->stringify().'"') unless $session;
       
    95     my $web = $a->_evaluate(@_) || '';
       
    96     return $session->{store}->webExists($web) ? 1 : 0;
       
    97 }
       
    98 
       
    99 sub OP_dollar {
       
   100     my $this = shift;
       
   101     my $a = $this->{params}->[0];
       
   102     my %domain = @_;
       
   103     my $session = $domain{tom}->session;
       
   104     throw Error::Simple('No context in which to evaluate "'.
       
   105                           $a->stringify().'"') unless $session;
       
   106     my $text = $a->_evaluate(@_) || '';
       
   107     if( $text && defined( $session->{cgiQuery}->param( $text ))) {
       
   108         return $session->{cgiQuery}->param( $text );
       
   109     }
       
   110     $text = "%$text%";
       
   111     TWiki::expandAllTags($session, \$text,
       
   112                          $session->{topicName},
       
   113                          $session->{webName});
       
   114     return $text || '';
       
   115 }
       
   116 
       
   117 sub OP_defined {
       
   118     my $this = shift;
       
   119     my $a = $this->{params}->[0];
       
   120     my %domain = @_;
       
   121     my $session = $domain{tom}->session;
       
   122     throw Error::Simple('No context in which to evaluate "'.
       
   123                           $a->stringify().'"') unless $session;
       
   124     my $eval =  $a->_evaluate(@_);
       
   125     return 0 unless $eval;
       
   126     return 1 if( defined( $session->{cgiQuery}->param( $eval )));
       
   127     return 1 if( defined(
       
   128         $session->{prefs}->getPreferencesValue( $eval )));
       
   129     return 1 if( defined( $session->{SESSION_TAGS}{$eval} ));
       
   130     return 1 if( defined( $TWiki::functionTags{$eval} ));
       
   131     return 0;
       
   132 }
       
   133 
       
   134 sub OP_ingroup {
       
   135     my $this = shift;
       
   136     my $a = $this->{params}->[0]; # user cUID/ loginname / WikiName / WebDotWikiName :( (string)
       
   137     my $b = $this->{params}->[1]; # group name (string
       
   138     my %domain = @_;
       
   139     my $session = $domain{tom}->session;
       
   140     throw Error::Simple('No context in which to evaluate "'.
       
   141                           $a->stringify().'"') unless $session;
       
   142     my $user =  $session->{users}->getCanonicalUserID($a->evaluate(@_));
       
   143     return 0 unless $user;
       
   144     my $group =  $b->_evaluate(@_);
       
   145     return 0 unless $group;
       
   146     return 1 if( $session->{users}->isInGroup($user, $group) );
       
   147     return 0;
       
   148 }
       
   149 
       
   150 1;
       
   151 
       
   152 __DATA__
       
   153 
       
   154 Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
       
   155 
       
   156 Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved.
       
   157 TWiki Contributors are listed in the AUTHORS file in the root of
       
   158 this distribution. NOTE: Please extend that file, not this notice.
       
   159 
       
   160 This program is free software; you can redistribute it and/or
       
   161 modify it under the terms of the GNU General Public License
       
   162 as published by the Free Software Foundation; either version 2
       
   163 of the License, or (at your option) any later version. For
       
   164 more details read LICENSE in the root of this distribution.
       
   165 
       
   166 This program is distributed in the hope that it will be useful,
       
   167 but WITHOUT ANY WARRANTY; without even the implied warranty of
       
   168 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
       
   169 
       
   170 As per the GPL, removal of this notice is prohibited.
       
   171 
       
   172 Author: Crawford Currie http://c-dot.co.uk