From: Kenneth L. <ke...@la...> - 2008-07-30 17:38:39
|
Have you gone out of your mind? I am supposed to build the release this Saturday, test the built package and release it Sunday. And then you check in a major refactoring of code just 2 days before giving me maybe 6 hours to test it. This is not reasonable! This should have been checked into trunk only. Kenneth de...@de... wrote: > Author: CrawfordCurrie > Date: 2008-07-30 11:37:29 -0500 (Wed, 30 Jul 2008) > New Revision: 17218 > Trac url: http://develop.twiki.org/trac/changeset/17218 > > Added: > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_allows.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_context.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_defined.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_dollar.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_ingroup.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_istopic.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_isweb.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/BinaryOP.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_and.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_d2n.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_dot.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_eq.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gt.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gte.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lc.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_length.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_like.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lt.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lte.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ne.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_not.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ob.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_or.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ref.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_uc.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_where.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/UnaryOP.pm > Modified: > twiki/branches/TWikiRelease04x02/lib/MANIFEST > twiki/branches/TWikiRelease04x02/lib/TWiki.spec > twiki/branches/TWikiRelease04x02/lib/TWiki/If/Node.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/If/Parser.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Infix/Parser.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/Node.pm > twiki/branches/TWikiRelease04x02/lib/TWiki/Query/Parser.pm > Log: > Item5852: refactored query and if operators into their own perl modules selected by a configure setting. This has no impact on users or admins (no functionality or spec changes and the settings are hidden in configure). Required to support adding new operators e.g. from extensions > > Modified: twiki/branches/TWikiRelease04x02/lib/MANIFEST > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/MANIFEST 2008-07-30 12:45:24 UTC (rev 17217) > +++ twiki/branches/TWikiRelease04x02/lib/MANIFEST 2008-07-30 16:37:29 UTC (rev 17218) > @@ -523,6 +523,13 @@ > lib/TWiki/I18N/Extract.pm 0444 > lib/TWiki/I18N/Fallback.pm 0444 > lib/TWiki/If/Node.pm 0444 > +lib/TWiki/If/OP_isweb.pm 0444 > +lib/TWiki/If/OP_istopic.pm 0444 > +lib/TWiki/If/OP_dollar.pm 0444 > +lib/TWiki/If/OP_defined.pm 0444 > +lib/TWiki/If/OP_allows.pm 0444 > +lib/TWiki/If/OP_ingroup.pm 0444 > +lib/TWiki/If/OP_context.pm 0444 > lib/TWiki/If/Parser.pm 0444 > lib/TWiki/Infix/Parser.pm 0444 > lib/TWiki/Infix/Error.pm 0444 > @@ -546,6 +553,26 @@ > lib/TWiki/Prefs/PrefsCache.pm 0444 > lib/TWiki/Query/Node.pm 0444 > lib/TWiki/Query/HoistREs.pm 0444 > +lib/TWiki/Query/OP_uc.pm 0444 > +lib/TWiki/Query/OP_where.pm 0444 > +lib/TWiki/Query/OP_gt.pm 0444 > +lib/TWiki/Query/OP_ref.pm 0444 > +lib/TWiki/Query/OP_gte.pm 0444 > +lib/TWiki/Query/OP_lt.pm 0444 > +lib/TWiki/Query/OP_or.pm 0444 > +lib/TWiki/Query/OP_length.pm 0444 > +lib/TWiki/Query/OP_d2n.pm 0444 > +lib/TWiki/Query/OP_like.pm 0444 > +lib/TWiki/Query/OP_lte.pm 0444 > +lib/TWiki/Query/BinaryOP.pm 0444 > +lib/TWiki/Query/OP_dot.pm 0444 > +lib/TWiki/Query/OP_lc.pm 0444 > +lib/TWiki/Query/UnaryOP.pm 0444 > +lib/TWiki/Query/OP_ob.pm 0444 > +lib/TWiki/Query/OP_not.pm 0444 > +lib/TWiki/Query/OP_and.pm 0444 > +lib/TWiki/Query/OP_ne.pm 0444 > +lib/TWiki/Query/OP_eq.pm 0444 > lib/TWiki/Query/Parser.pm 0444 > lib/TWiki/Render.pm 0444 > lib/TWiki/Sandbox.pm 0444 > > Modified: twiki/branches/TWikiRelease04x02/lib/TWiki/If/Node.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/Node.pm 2008-07-30 12:45:24 UTC (rev 17217) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/Node.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -38,126 +38,6 @@ > } > } > > -sub OP_context { > - my $this = shift; > - my $a = $this->{params}->[0]; > - my $text = $a->_evaluate(@_) || ''; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - return $session->inContext($text) || 0; > -} > - > -sub OP_allows { > - my $this = shift; > - my $a = $this->{params}->[0]; # topic name (string) > - my $b = $this->{params}->[1]; # access mode (string) > - my $mode = $b->_evaluate(@_) || 'view'; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my $str = $a->evaluate(@_); > - return 0 unless $str; > - my ($web, $topic) = $session->normalizeWebTopicName( > - $session->{webName}, $str); > - my $ok = 0; > - if ($session->{store}->topicExists($web, $topic)) { > - #try the non-precise name as an existant topic first. > - $ok = $session->security->checkAccessPermission( > - uc($mode), $session->{user}, undef, undef, $topic, $web); > - } elsif ($session->{store}->webExists($str)) { > - $ok = $session->security->checkAccessPermission( > - uc($mode), $session->{user}, undef, undef, undef, $str); > - } elsif ($session->{store}->webExists($web)) { > - #not an existing topic or web - assume any lone name is a topic without a web specified > - $ok = $session->security->checkAccessPermission( > - uc($mode), $session->{user}, undef, undef, $topic, $web); > - } else { > - $ok = 0; > - } > - return $ok ? 1 : 0; > -} > - > -sub OP_istopic { > - my $this = shift; > - my $a = $this->{params}->[0]; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my( $web, $topic) = ( $session->{webName}, $a->_evaluate(@_)); > - return 0 unless defined $topic; # null topic cannot possibly exist > - ($web, $topic) = $session->normalizeWebTopicName($web, $topic); > - > - return $session->{store}->topicExists($web, $topic) ? 1 : 0; > -} > - > -sub OP_isweb { > - my $this = shift; > - my $a = $this->{params}->[0]; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my $web = $a->_evaluate(@_) || ''; > - return $session->{store}->webExists($web) ? 1 : 0; > -} > - > -sub OP_dollar { > - my $this = shift; > - my $a = $this->{params}->[0]; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my $text = $a->_evaluate(@_) || ''; > - if( $text && defined( $session->{cgiQuery}->param( $text ))) { > - return $session->{cgiQuery}->param( $text ); > - } > - > - $text = "%$text%"; > - TWiki::expandAllTags($session, \$text, > - $session->{topicName}, > - $session->{webName}); > - > - return $text || ''; > -} > - > -sub OP_defined { > - my $this = shift; > - my $a = $this->{params}->[0]; > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my $eval = $a->_evaluate(@_); > - return 0 unless $eval; > - return 1 if( defined( $session->{cgiQuery}->param( $eval ))); > - return 1 if( defined( > - $session->{prefs}->getPreferencesValue( $eval ))); > - return 1 if( defined( $session->{SESSION_TAGS}{$eval} )); > - return 1 if( defined( $TWiki::functionTags{$eval} )); > - return 0; > -} > - > -sub OP_ingroup { > - my $this = shift; > - my $a = $this->{params}->[0]; # user cUID/ loginname / WikiName / WebDotWikiName :( (string) > - my $b = $this->{params}->[1]; # group name (string > - my %domain = @_; > - my $session = $domain{tom}->session; > - throw Error::Simple('No context in which to evaluate "'. > - $a->stringify().'"') unless $session; > - my $user = $session->{users}->getCanonicalUserID($a->evaluate(@_)); > - return 0 unless $user; > - my $group = $b->_evaluate(@_); > - return 0 unless $group; > - return 1 if( $session->{users}->isInGroup($user, $group) ); > - return 0; > -} > - > 1; > > __DATA__ > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_allows.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_allows.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_allows.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,73 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_allows > + > +=cut > + > +package TWiki::If::OP_allows; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'allows', prec => 600 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; # topic name (string) > + my $b = $node->{params}->[1]; # access mode (string) > + my $mode = $b->_evaluate(@_) || 'view'; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my $str = $a->evaluate(@_); > + return 0 unless $str; > + my ($web, $topic) = $session->normalizeWebTopicName( > + $session->{webName}, $str); > + my $ok = 0; > + if ($session->{store}->topicExists($web, $topic)) { > + #try the non-precise name as an existant topic first. > + $ok = $session->security->checkAccessPermission( > + uc($mode), $session->{user}, undef, undef, $topic, $web); > + } elsif ($session->{store}->webExists($str)) { > + $ok = $session->security->checkAccessPermission( > + uc($mode), $session->{user}, undef, undef, undef, $str); > + } elsif ($session->{store}->webExists($web)) { > + #not an existing topic or web - assume any lone name is a topic without a web specified > + $ok = $session->security->checkAccessPermission( > + uc($mode), $session->{user}, undef, undef, $topic, $web); > + } else { > + $ok = 0; > + } > + return $ok ? 1 : 0; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_context.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_context.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_context.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,56 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_context > + > +=cut > + > +package TWiki::If::OP_context; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( > + name => 'context', > + prec => 600, > + casematters => 0); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; > + my $text = $a->_evaluate(@_) || ''; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + return $session->inContext($text) || 0; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_defined.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_defined.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_defined.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,59 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_defined > + > +=cut > + > +package TWiki::If::OP_defined; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'defined', prec => 600 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my $eval = $a->_evaluate(@_); > + return 0 unless $eval; > + return 1 if( defined( $session->{cgiQuery}->param( $eval ))); > + return 1 if( defined( > + $session->{prefs}->getPreferencesValue( $eval ))); > + return 1 if( defined( $session->{SESSION_TAGS}{$eval} )); > + return 1 if( defined( $TWiki::functionTags{$eval} )); > + return 0; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_dollar.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_dollar.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_dollar.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,64 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_dollar > + > +=cut > + > +package TWiki::If::OP_dollar; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( > + name => '$', > + prec => 600); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my $text = $a->_evaluate(@_) || ''; > + if( $text && defined( $session->{cgiQuery}->param( $text ))) { > + return $session->{cgiQuery}->param( $text ); > + } > + > + $text = "%$text%"; > + TWiki::expandAllTags($session, \$text, > + $session->{topicName}, > + $session->{webName}); > + > + return $text || ''; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_ingroup.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_ingroup.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_ingroup.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,60 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_ingroup > + > +=cut > + > +package TWiki::If::OP_ingroup; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( > + name => 'ingroup', > + prec => 600, > + casematters => 1); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; # user cUID/ loginname / WikiName / WebDotWikiName :( (string) > + my $b = $node->{params}->[1]; # group name (string > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my $user = $session->{users}->getCanonicalUserID($a->evaluate(@_)); > + return 0 unless $user; > + my $group = $b->_evaluate(@_); > + return 0 unless $group; > + return 1 if( $session->{users}->isInGroup($user, $group) ); > + return 0; > +} > + > +1; > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_istopic.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_istopic.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_istopic.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,55 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::If::OP_istopic > + > +=cut > + > +package TWiki::If::OP_istopic; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'istopic', prec => 600 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my( $web, $topic) = ( $session->{webName}, $a->_evaluate(@_)); > + return 0 unless defined $topic; # null topic cannot possibly exist > + ($web, $topic) = $session->normalizeWebTopicName($web, $topic); > + > + return $session->{store}->topicExists($web, $topic) ? 1 : 0; > +} > + > +1; > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_isweb.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_isweb.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/OP_isweb.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,54 @@ > +# See bottom of file for copyright and license details > + > +=pod > + > +---+ package TWiki::If::OP_isweb > + > +=cut > + > +package TWiki::If::OP_isweb; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( > + name => 'isweb', > + prec => 600); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}->[0]; > + my %domain = @_; > + my $session = $domain{tom}->session; > + throw Error::Simple('No context in which to evaluate "'. > + $a->stringify().'"') unless $session; > + my $web = $a->_evaluate(@_) || ''; > + return $session->{store}->webExists($web) ? 1 : 0; > +} > + > +1; > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Modified: twiki/branches/TWikiRelease04x02/lib/TWiki/If/Parser.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/If/Parser.pm 2008-07-30 12:45:24 UTC (rev 17217) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/If/Parser.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -20,45 +20,15 @@ > > my $this = $class->SUPER::new({ > nodeClass => 'TWiki::If::Node', > - words => qr/([A-Za-z][\w:]+|({\w+})+)/}); > + words => qr/([A-Z][A-Z0-9_:]+|({[A-Z0-9_]+})+)/i}); > + die "{Operators}{If} is undefined; re-run configure" > + unless defined( $TWiki::cfg{Operators}{If} ); > + foreach my $op (@{$TWiki::cfg{Operators}{If}}) { > + eval "require $op"; > + ASSERT(!$@) if DEBUG; > + $this->addOperator($op->new()); > + } > > - # See TWiki::Query::Parser.pm for an explanation of 'exec' > - $this->addOperator( > - name => 'context', > - prec => 600, arity => 1, casematters => 0, > - exec => 'OP_context', > - ); > - $this->addOperator( > - name => 'allows', > - prec => 600, arity => 2, casematters => 0, > - exec => 'OP_allows', > - ); > - $this->addOperator( > - name => '$', > - prec => 600, arity => 1, > - exec => 'OP_dollar', > - ); > - $this->addOperator( > - name => 'defined', > - prec => 600, arity => 1, casematters => 0, > - exec => 'OP_defined', > - ); > - $this->addOperator( > - name => 'istopic', > - prec => 600, arity => 1, casematters => 0, > - exec => 'OP_istopic', > - ); > - $this->addOperator( > - name => 'isweb', > - prec => 600, arity => 1, casematters => 0, > - exec => 'OP_isweb', > - ); > - $this->addOperator( > - name => 'ingroup', > - prec => 600, arity => 2, casematters => 1, > - exec => 'OP_ingroup', > - ); > - > return $this; > } > > > Modified: twiki/branches/TWikiRelease04x02/lib/TWiki/Infix/Parser.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Infix/Parser.pm 2008-07-30 12:45:24 UTC (rev 17217) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Infix/Parser.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -83,10 +83,10 @@ > > =pod > > ----++ ObjectMethod addOperator(%oper) > +---++ ObjectMethod addOperator(\%oper) > Add an operator to the parser. > > -=%oper= is a hash, containing the following fields: > +=\%oper= is a hash (or an object), containing the following fields: > * =name= - operator string > * =prec= - operator precedence, positive non-zero integer. > Larger number => higher precedence. > @@ -110,8 +110,8 @@ > =cut > > sub addOperator { > - my $this = shift; > - push( @{$this->{operators}}, { @_ } ); > + my( $this, $op ) = @_; > + push( @{$this->{operators}}, $op ); > $this->{initialised} = 0; > } > > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/BinaryOP.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/BinaryOP.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/BinaryOP.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,52 @@ > +package TWiki::Query::BinaryOP; > + > +sub new { > + my $class = shift; > + my $this = {@_, arity => 2}; > + return bless($this, $class); > +} > + > +# Determine if a string represents a valid number > +sub _isNumber { > + return shift =~ m/^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/; > +} > + > +# Static function to apply a comparison function to two data, tolerant > +# of whether they are numeric or not > +sub compare { > + my ($a, $b, $sub) = @_; > + if (_isNumber($a) && _isNumber($b)) { > + return &$sub($a <=> $b); > + } else { > + return &$sub($a cmp $b); > + } > +} > + > +# Evaluate a node using the comparison function passed in. Extra parameters > +# are passed on to the comparison function. > +sub evalTest { > + my $this = shift; > + my $node = shift; > + my $clientData = shift; > + my $sub = shift; > + my $a = $node->{params}[0]; > + my $b = $node->{params}[1]; > + my $ea = $a->evaluate( @{$clientData} ) || ''; > + my $eb = $b->evaluate( @{$clientData} ) || ''; > + if (ref($ea) eq 'ARRAY') { > + my @res; > + foreach my $lhs (@$ea) { > + push(@res, $lhs) if &$sub($lhs, $eb, @_); > + } > + if (scalar(@res) == 0) { > + return undef; > + } elsif (scalar(@res) == 1) { > + return $res[0]; > + } > + return \@res; > + } else { > + return &$sub($ea, $eb, @_); > + } > +} > + > +1; > > Modified: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/Node.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/Node.pm 2008-07-30 12:45:24 UTC (rev 17217) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/Node.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -196,8 +196,7 @@ > } else { > print STDERR " {\n" if MONITOR_EVAL; > $ind++ if MONITOR_EVAL; > - my $fn = $this->{op}->{exec}; > - $result = $this->$fn( @_ ); > + $result = $this->{op}->evaluate( $this, @_ ); > $ind-- if MONITOR_EVAL; > print STDERR ('-' x $ind).'}' if MONITOR_EVAL; > } > @@ -206,244 +205,6 @@ > return $result; > } > > -# Determine if a string represents a valid number > -sub _isNumber { > - return shift =~ m/^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$/; > -} > - > -# Apply a comparison function to two data, tolerant of whether they are > -# numeric or not > -sub _cmp { > - my ($a, $b, $sub) = @_; > - if (_isNumber($a) && _isNumber($b)) { > - return &$sub($a <=> $b); > - } else { > - return &$sub($a cmp $b); > - } > -} > - > -# Evaluate a node using the comparison function passed in. Extra parameters > -# are passed on to the comparison function. > -sub _evalTest { > - my $this = shift; > - my $clientData = shift; > - my $sub = shift; > - my $a = $this->{params}[0]; > - my $b = $this->{params}[1]; > - my $ea = $a->evaluate( @{$clientData} ) || ''; > - my $eb = $b->evaluate( @{$clientData} ) || ''; > - if (ref($ea) eq 'ARRAY') { > - my @res; > - foreach my $lhs (@$ea) { > - push(@res, $lhs) if &$sub($lhs, $eb, @_); > - } > - if (scalar(@res) == 0) { > - return undef; > - } elsif (scalar(@res) == 1) { > - return $res[0]; > - } > - return \@res; > - } else { > - return &$sub($ea, $eb, @_); > - } > -} > - > -sub _evalUnary { > - my $this = shift; > - my $sub = shift; > - my $a = $this->{params}[0]; > - my $val = $a->evaluate( @_ ) || ''; > - if (ref($val) eq 'ARRAY') { > - my @res = map { &$sub($_) } @$val; > - return \@res; > - } else { > - return &$sub( $val ); > - } > -} > - > -sub OP_lc { > - my $this = shift; > - return $this->_evalUnary( sub { lc( shift ) }, @_ ); > -} > - > -sub OP_uc { > - my $this = shift; > - return $this->_evalUnary( sub { uc( shift ) }, @_ ); > -} > - > -sub OP_d2n { > - my $this = shift; > - return $this->_evalUnary( > - sub { > - my $date = shift; > - eval { > - require TWiki::Time; > - $date = TWiki::Time::parseTime( $date, 1); > - }; > - # ignore $@ > - return $date; > - }, > - @_ ); > -} > - > -sub OP_length { > - my $this = shift; > - my $a = $this->{params}[0]; > - my $val = $a->evaluate( @_ ) || ''; > - if (ref($val) eq 'ARRAY') { > - return scalar( @$val ); > - } > - return 1; > -} > - > -sub OP_eq { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] == 0 ? 1 : 0 }); > -} > - > -sub OP_like { > - my $this = shift; > - return $this->_evalTest( > - \@_, > - sub { > - my $expr = quotemeta($_[1]); > - # quotemeta will have escapes * and ? wildcards > - $expr =~ s/\\\?/./g; > - $expr =~ s/\\\*/.*/g; > - defined($_[0]) && defined($_[1]) && > - $_[0] =~ m/^$expr$/s ? 1 : 0; > - } ); > -} > - > -sub OP_ne { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] != 0 ? 1 : 0 }); > -} > - > -sub OP_lte { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] <= 0 ? 1 : 0 }); > -} > - > - > -sub OP_gte { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] >= 0 ? 1 : 0 }); > -} > - > -sub OP_gt { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] > 0 ? 1 : 0 }); > -} > - > -sub OP_lt { > - my $this = shift; > - return $this->_evalTest( \@_, \&_cmp, sub { $_[0] < 0 ? 1 : 0 }); > -} > - > -sub OP_and { > - my $this = shift; > - my $a = $this->{params}[0]; > - return 0 unless $a->evaluate( @_ ); > - my $b = $this->{params}[1]; > - return $b->evaluate( @_ ); > -} > - > -sub OP_or { > - my $this = shift; > - my $a = $this->{params}[0]; > - return 1 if $a->evaluate( @_ ); > - my $b = $this->{params}[1]; > - return $b->evaluate( @_ ); > -} > - > -sub OP_not { > - my $this = shift; > - my $a = $this->{params}[0]; > - return $a->evaluate( @_ ) ? 0 : 1; > -} > - > -sub OP_ob { > - my $this = shift; > - my $a = $this->{params}[0]; > - return $a->evaluate( @_ ); > -} > - > -sub OP_dot { > - my $this = shift; > - my %domain = @_; > - my $a = $this->{params}[0]; > - my $lval = $a->evaluate( @_ ); > - return undef unless( defined $lval ); > - my $b = $this->{params}[1]; > - my $res = $b->evaluate( data=>$lval, tom=>$domain{tom} ); > - if (ref($res) eq 'ARRAY' && scalar(@$res) == 1) { > - return $res->[0]; > - } > - return $res; > -} > - > -sub OP_ref { > - my $this = shift; > - my %domain = @_; > - > - my $session = $domain{tom}->session; > - my $topic = $domain{tom}->topic; > - > - my $a = $this->{params}[0]; > - my $node = $a->evaluate( @_ ); > - return undef unless defined $node; > - if( ref($node) eq 'HASH') { > - return undef; > - } > - if( !( ref($node) eq 'ARRAY' )) { > - $node = [ $node ]; > - } > - my @result; > - foreach my $v (@$node) { > - next if $v !~ /^($TWiki::regex{webNameRegex}\.)*$TWiki::regex{wikiWordRegex}$/; > - > - # Has to be relative to the web of the topic we are querying > - my( $w, $t ) = $session->normalizeWebTopicName( > - $session->{webName}, $v ); > - my $result = undef; > - try { > - my $submeta = $domain{tom}->getMetaFor( $w, $t ); > - my $b = $this->{params}[1]; > - my $res = $b->evaluate( tom=>$submeta, data=>$submeta ); > - if( ref($res) eq 'ARRAY') { > - push(@result, @$res); > - } else { > - push(@result, $res); > - } > - } catch Error::Simple with { > - }; > - } > - return undef unless scalar( @result ); > - return $result[0] if scalar(@result) == 1; > - return \@result; > -} > - > -sub OP_where { > - my $this = shift; > - my %domain = @_; > - my $a = $this->{params}[0]; > - my $lval = $a->evaluate( @_ ); > - my $b = $this->{params}[1]; > - if (ref($lval) eq 'ARRAY') { > - my @res; > - foreach my $el (@$lval) { > - if ($b->evaluate( data=>$el, tom=>$domain{tom} )) { > - push(@res, $el); > - } > - } > - return undef unless scalar( @res ); > - return \@res; > - } else { > - return $b->evaluate( data=>$lval, tom=>$domain{tom} ); > - } > -} > - > 1; > __DATA__ > > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_and.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_and.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_and.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,50 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_and > + > +=cut > + > +package TWiki::Query::OP_and; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'and', prec => 200 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}[0]; > + return 0 unless $a->evaluate( @_ ); > + my $b = $node->{params}[1]; > + return $b->evaluate( @_ ); > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_d2n.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_d2n.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_d2n.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,57 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_d2n > + > +=cut > + > +package TWiki::Query::OP_d2n; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'd2n', prec => 600 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalUnary( $node, > + sub { > + my $date = shift; > + eval { > + require TWiki::Time; > + $date = TWiki::Time::parseTime( $date, 1); > + }; > + # ignore $@ > + return $date; > + }, > + @_ ); > +}; > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_dot.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_dot.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_dot.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,56 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_dot > + > +=cut > + > +package TWiki::Query::OP_dot; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => '.', prec => 800 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my %domain = @_; > + my $a = $node->{params}[0]; > + my $lval = $a->evaluate( @_ ); > + return undef unless( defined $lval ); > + my $b = $node->{params}[1]; > + my $res = $b->evaluate( data=>$lval, tom=>$domain{tom} ); > + if (ref($res) eq 'ARRAY' && scalar(@$res) == 1) { > + return $res->[0]; > + } > + return $res; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_eq.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_eq.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_eq.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,51 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_eq > + > +=cut > + > +package TWiki::Query::OP_eq; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => '=', prec => 500 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] == 0 ? 1 : 0 }); > +} > + > +1; > + > + > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gt.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gt.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gt.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,50 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_gt > + > +=cut > + > +package TWiki::Query::OP_gt; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => '>', prec => 400 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] > 0 ? 1 : 0 }); > +} > + > +1; > + > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gte.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gte.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_gte.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,50 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_gte > + > +=cut > + > +package TWiki::Query::OP_gte; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => '>=', prec => 400 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] >= 0 ? 1 : 0 }); > +} > + > +1; > + > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lc.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lc.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lc.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,51 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_lc > + > +=cut > + > +package TWiki::Query::OP_lc; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + > + return $class->SUPER::new( > + name => 'lc', > + prec => 600, > + casematters => 1); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalUnary( $node, sub { lc( shift ) }, @_ ); > +}; > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_length.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_length.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_length.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,52 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_length > + > +=cut > + > +package TWiki::Query::OP_length; > +use base 'TWiki::Query::UnaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => 'length', prec => 600 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + my $a = $node->{params}[0]; > + my $val = $a->evaluate( @_ ) || ''; > + if (ref($val) eq 'ARRAY') { > + return scalar( @$val ); > + } > + return 1; > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_like.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_like.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_like.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,57 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_like > + > +=cut > + > +package TWiki::Query::OP_like; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new(name => '~', prec => 500); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, > + sub { > + my $expr = quotemeta($_[1]); > + # quotemeta will have escapes * and ? wildcards > + $expr =~ s/\\\?/./g; > + $expr =~ s/\\\*/.*/g; > + defined($_[0]) && defined($_[1]) && > + $_[0] =~ m/^$expr$/s ? 1 : 0; > + } ); > +} > + > +1; > + > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lt.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lt.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lt.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,49 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_lt > + > +=cut > + > +package TWiki::Query::OP_lt; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new(name => '<', prec => 400); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] < 0 ? 1 : 0 }); > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lte.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lte.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_lte.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,50 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_lte > + > +=cut > + > +package TWiki::Query::OP_lte; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new( name => '<=', prec => 400 ); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] <= 0 ? 1 : 0 }); > +} > + > +1; > + > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software Foundation; either version 2 > +of the License, or (at your option) any later version. For > +more details read LICENSE in the root of this distribution. > + > +This program is distributed in the hope that it will be useful, > +but WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. > + > +As per the GPL, removal of this notice is prohibited. > + > +Author: Crawford Currie http://c-dot.co.uk > > Added: twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ne.pm > =================================================================== > --- twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ne.pm (rev 0) > +++ twiki/branches/TWikiRelease04x02/lib/TWiki/Query/OP_ne.pm 2008-07-30 16:37:29 UTC (rev 17218) > @@ -0,0 +1,49 @@ > +# See bottom of file for copyright and license details > + > +=begin twiki > + > +---+ package TWiki::Query::OP_ne > + > +=cut > + > +package TWiki::Query::OP_ne; > +use base 'TWiki::Query::BinaryOP'; > + > +use strict; > + > +sub new { > + my $class = shift; > + return $class->SUPER::new(name => '!=', prec => 500); > +} > + > +sub evaluate { > + my $this = shift; > + my $node = shift; > + return $this->evalTest( $node, > + \@_, \&TWiki::Query::BinaryOP::compare, > + sub { $_[0] != 0 ? 1 : 0 }); > +} > + > +1; > + > +__DATA__ > + > +Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ > + > +Copyright (C) 2005-2007 TWiki Contributors. All Rights Reserved. > +TWiki Contributors are listed in the AUTHORS file in the root of > +this distribution. NOTE: Please extend that file, not this notice. > + > +This program is free software; you can redistribute it and/or > +modify it under the terms of the GNU General Public License > +as published by the Free Software ... [truncated message content] |