1# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ 2# 3# Copyright (C) 2005-2018 Peter Thoeny, peter[at]thoeny.org 4# and TWiki Contributors. All Rights Reserved. TWiki Contributors 5# are listed in the AUTHORS file in the root of this distribution. 6# NOTE: Please extend that file, not this notice. 7# 8# This program is free software; you can redistribute it and/or 9# modify it under the terms of the GNU General Public License 10# as published by the Free Software Foundation; either version 3 11# of the License, or (at your option) any later version. For 12# more details read LICENSE in the root of this distribution. 13# 14# This program is distributed in the hope that it will be useful, 15# but WITHOUT ANY WARRANTY; without even the implied warranty of 16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 17# 18# As per the GPL, removal of this notice is prohibited. 19# 20# Author: Crawford Currie http://c-dot.co.uk 21 22=pod 23 24---+ package TWiki::Query 25 26A Query object is a representation of a query over the TWiki database. 27 28Fields are given by name, and values by strings or numbers. Strings should always be surrounded by 'single-quotes'. Numbers can be signed integers or decimals. Single quotes in values may be escaped using backslash (\). 29 30See TWiki.QuerySearch for details of the query language. At the time of writing 31only a subset of the entire query language is supported, for use in searching. 32 33A query object implements the =evaluate= method as its general 34contract with the rest of the world. This method does a "hard work" evaluation 35of the parser tree. Of course, smarter Store implementations should be 36able to do it better.... 37 38=cut 39 40package TWiki::Query::Node; 41use base 'TWiki::Infix::Node'; 42 43use Assert; 44use Error qw( :try ); 45 46# 1 for debug 47sub MONITOR_EVAL { 0 }; 48 49=pod 50 51---++ PUBLIC $aliases 52A hash mapping short aliases for META: entry names. For example, this hash 53maps 'form' to 'META:FORM'. Published so extensions can extend the range 54of supported types. 55 56---++ PUBLIC %isArrayType 57Maps META: entry type names to true if the type is an array type (such as 58FIELD, ATTACHMENT or PREFERENCE). Published so extensions can extend the range 59or supported types. The type name should be given without the leading 'META:' 60 61=cut 62 63use vars qw ( %aliases %isArrayType ); 64 65%aliases = ( 66 attachments => 'META:FILEATTACHMENT', 67 fields => 'META:FIELD', 68 form => 'META:FORM', 69 info => 'META:TOPICINFO', 70 moved => 'META:TOPICMOVED', 71 parent => 'META:TOPICPARENT', 72 preferences => 'META:PREFERENCE', 73 ); 74 75%isArrayType = 76 map { $_ => 1 } ( 'FILEATTACHMENT', 'FIELD', 'PREFERENCE' ); 77 78# $data is the indexed object 79# $field is the scalar being used to index the object 80sub _getField { 81 my( $this, $data, $field ) = @_; 82 83 my $result; 84 if (UNIVERSAL::isa($data, 'TWiki::Meta')) { 85 # The object being indexed is a TWiki::Meta object, so 86 # we have to use a different approach to treating it 87 # as an associative array. The first thing to do is to 88 # apply our "alias" shortcuts. 89 my $realField = $field; 90 if( $aliases{$field} ) { 91 $realField = $aliases{$field}; 92 } 93 if ($realField =~ s/^META://) { 94 if ($isArrayType{$realField}) { 95 # Array type, have to use find 96 my @e = $data->find( $realField ); 97 $result = \@e; 98 } else { 99 $result = $data->get( $realField ); 100 } 101 } elsif ($realField eq 'name') { 102 # Special accessor to compensate for lack of a topic 103 # name anywhere in the saved fields of meta 104 return $data->topic(); 105 } elsif ($realField eq 'topictitle') { 106 # Special accessor to compensate for lack of a topic 107 # name anywhere in the saved fields of meta 108 return $data->topicTitle(); 109 } elsif ($realField eq 'text') { 110 # Special accessor to compensate for lack of the topic text 111 # name anywhere in the saved fields of meta 112 return $data->text(); 113 } elsif ($realField eq 'web') { 114 # Special accessor to compensate for lack of a web 115 # name anywhere in the saved fields of meta 116 return $data->web(); 117 } else { 118 # The field name isn't an alias, check to see if it's 119 # the form name 120 my $form = $data->get( 'FORM' ); 121 if( $form && $field eq $form->{name}) { 122 # SHORTCUT;it's the form name, so give me the fields 123 # as if the 'field' keyword had been used. 124 # TODO: This is where multiple form support needs to reside. 125 # Return the array of FIELD for further indexing. 126 my @e = $data->find( 'FIELD' ); 127 return \@e; 128 } else { 129 # SHORTCUT; not a predefined name; assume it's a field 130 # 'name' instead. 131 # SMELL: Needs to error out if there are multiple forms - 132 # or perhaps have a heuristic that gives access to the 133 # uniquely named field. 134 $result = $data->get( 'FIELD', $field ); 135 $result = $result->{value} if $result; 136 } 137 } 138 } elsif( ref( $data ) eq 'ARRAY' ) { 139 # Indexing an array object. The index will be one of: 140 # 1. An integer, which is an implicit index='x' query 141 # 2. A name, which is an implicit name='x' query 142 if( $field =~ /^\d+$/ ) { 143 # Integer index 144 $result = $data->[$field]; 145 } else { 146 # String index 147 my @res; 148 # Get all array entries that match the field 149 foreach my $f ( @$data ) { 150 my $val = $this->_getField( $f, $field ); 151 push( @res, $val ) if defined( $val ); 152 } 153 if (scalar( @res )) { 154 $result = \@res; 155 } else { 156 # The field name wasn't explicitly seen in any of the records. 157 # Try again, this time matching 'name' and returning 'value' 158 foreach my $f ( @$data ) { 159 next unless ref($f) eq 'HASH'; 160 if ($f->{name} && $f->{name} eq $field 161 && defined $f->{value}) { 162 push( @res, $f->{value} ); 163 } 164 } 165 if (scalar( @res )) { 166 $result = \@res; 167 } 168 } 169 } 170 } elsif( ref( $data ) eq 'HASH' ) { 171 $result = $data->{$this->{params}[0]}; 172 } else { 173 $result = $this->{params}[0]; 174 } 175 return $result; 176} 177 178# <DEBUG SUPPORT> 179sub toString { 180 my ($a) = @_; 181 return 'undef' unless defined($a); 182 if (ref($a) eq 'ARRAY') { 183 return '['.join(',', map { toString($_) } @$a).']' 184 } elsif (UNIVERSAL::isa($a, 'TWiki::Meta')) { 185 return $a->stringify(); 186 } elsif (ref($a) eq 'HASH') { 187 return '{'.join(',', map { "$_=>".toString($a->{$_}) } keys %$a).'}' 188 } else { 189 return $a; 190 } 191} 192 193my $ind = 0; 194# </DEBUG SUPPORT> 195 196# Evalute this node by invoking the operator function named in the 'exec' 197# field of the operator. The return result is either an array ref (for many 198# results) or a scalar (for a single result) 199sub evaluate { 200 my $this = shift; 201 ASSERT( scalar(@_) % 2 == 0); 202 my $result; 203 204 print STDERR ('-' x $ind).$this->stringify() if MONITOR_EVAL; 205 206 if (!ref( $this->{op})) { 207 my %domain = @_; 208 if ($this->{op} == $TWiki::Infix::Node::NAME && 209 defined $domain{data}) { 210 # a name; look it up in clientData 211 $result = $this->_getField( $domain{data}, $this->{params}[0]); 212 } else { 213 $result = $this->{params}[0]; 214 } 215 } else { 216 print STDERR " {\n" if MONITOR_EVAL; 217 $ind++ if MONITOR_EVAL; 218 $result = $this->{op}->evaluate( $this, @_ ); 219 $ind-- if MONITOR_EVAL; 220 print STDERR ('-' x $ind).'}' if MONITOR_EVAL; 221 } 222 print STDERR ' -> ',toString($result),"\n" if MONITOR_EVAL; 223 224 return $result; 225} 226 2271; 228