| Text-Query documentation | Contained in the Text-Query distribution. |
Text::Query::BuildAdvancedString - Builder for Text::Query::ParseAdvanced to build regexps
use Text::Query;
my $q=new Text::Query('hello and world',
-parse => 'Text::Query::ParseAdvanced',
-solve => 'Text::Query::SolveAdvancedString',
-build => 'Text::Query::BuildAdvancedString');
Build a regexp to match the advanced query parsed by Text::Query::ParseAdvanced.
The words of the query can be regular expressions and will provide the expected
result if the -regexp option is set.
Text::Query(3) Text::Query::Build(3)
Eric Bohlman (ebohlman@netcom.com)
Loic Dachary (loic@senga.org)
| Text-Query documentation | Contained in the Text-Query distribution. |
# # Copyright (C) 1999 Eric Bohlman, Loic Dachary # # 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, or (at your option) any # later version. You may also use, redistribute and/or modify it # under the terms of the Artistic License supplied with your Perl # 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. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # # # $Header: /usr/local/cvsroot/Text-Query/lib/Text/Query/BuildAdvancedString.pm,v 1.3 1999/06/16 10:32:13 loic Exp $ # package Text::Query::BuildAdvancedString; use strict; use vars qw(@ISA $VERSION); use Text::Query::Build; @ISA = qw(Text::Query::Build); sub build_init { my($self) = @_; } sub build_final_expression { my($self, $t1) = @_; my($t); $t = ($self->{parseopts}{-case}) ? '' : '(?i)'; $self->{matchstring} = "$t$t1"; return eval("sub { \$_[0] =~ /$t$t1/s; }") } sub build_expression { my($self, $l, $r) = @_; #factor any common "^" out of the disjunction #This really speeds up matching if(substr($l,0,1) eq '^' and substr($r,0,1) eq '^') { return '^(?:'.substr($l,1).'|'.substr($r,1).')'; } else { return "$l|$r"; } } sub build_expression_finish { my($self, $l) = @_; return "(?:$l)"; } sub build_conj { my($self, $l, $r, $first) = @_; $l = "^(?=.*$l)" if($first); return "$l(?=.*$r)"; } sub build_near { my($self, $l, $r)=@_; my($t1) = $self->{parseopts}{-near} || ''; return "(?:$l\\s*(?:\\S+\\s+){0,$t1}$r)|(?:$r\\s*(?:\\S+\\s+){0,$t1}$l)"; } sub build_concat { my($self, $l, $r) = @_; return "(?:$l\\s*$r)"; } sub build_negation { my($self, $t) = @_; return "(?:^(?:(?!$t).)*\$)"; } sub build_literal { my($self, $t) = @_; if(!$self->{parseopts}{-regexp}) { $t = quotemeta($t); $t =~ s/\\\*/\\w*/g; } $t =~ s/\\? +/\\s+/g if(!$self->{parseopts}{-litspace}); $t = "\\b$t\\b" if($self->{parseopts}{-whole}); $t = "(?:$t)" if($self->{parseopts}{-regexp}); warn("build_literal 1 = $t") if($self->{-verbose} > 1); return $t; } sub build_scope_start { my ($self)=@_; } sub build_scope_end { my ($self, $scope, $t)=@_; return $t; } 1; __END__
# Local Variables: *** # mode: perl *** # End: ***