1# 2# Copyright (C) 1999 Eric Bohlman, Loic Dachary 3# Copyright (C) 2013 Jon Jensen 4# 5# This program is free software; you can redistribute it and/or modify it 6# under the terms of the GNU General Public License as published by the 7# Free Software Foundation; either version 2, or (at your option) any 8# later version. You may also use, redistribute and/or modify it 9# under the terms of the Artistic License supplied with your Perl 10# distribution 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this program; if not, write to the Free Software 19# Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 20 21package Text::Query; 22 23use strict; 24 25use vars qw($VERSION); 26 27$VERSION = '0.09'; 28 29use Carp; 30 31sub new { 32 my($class) = shift; 33 my($self) = {}; 34 bless $self,$class; 35 if(@_ % 2) { 36 my($qstring) = shift; 37 $self->configure(@_); 38 return defined($qstring) ? $self->prepare($qstring, @_) : $self; 39 } else { 40 $self->configure(@_); 41 return $self; 42 } 43} 44 45sub configure { 46 my($self, %args) = @_; 47 48 $self->{-verbose} = $args{-verbose} || 0 if(!defined($self->{-verbose})); 49 50 my(%defconfigs) = ( 51 simple_text => 52 { -parse => 'Text::Query::ParseSimple', 53 -build => 'Text::Query::BuildSimpleString', 54 -optimize => 'Text::Query::Optimize', 55 -solve => 'Text::Query::SolveSimpleString' 56 }, 57 advanced_text => 58 { -parse => 'Text::Query::ParseAdvanced', 59 -build => 'Text::Query::BuildAdvancedString', 60 -optimize => 'Text::Query::Optimize', 61 -solve => 'Text::Query::SolveAdvancedString' 62 }, 63 ); 64 65 my $default=(defined $args{-mode})?$args{-mode}:'simple_text'; 66 my($key); 67 foreach $key (keys(%{$defconfigs{$default}})) { 68 my($package) = $args{$key} ? $args{$key} : $defconfigs{$default}{$key}; 69 my($load) = !exists($self->{'packages'}{$key}) || $self->{'packages'}{$key} ne $package; 70 71 if($load) { 72 $self->{$key} = $self->loader($package); 73 $self->{$key}->{-verbose} = $self->{-verbose}; 74 warn("loaded $package => $self->{$key}") if($self->{-verbose}); 75 $self->{'packages'}{$key} = $package; 76 } 77 } 78 $self->{-parse}->{-build} = $self->{-build}; 79} 80 81sub loader { 82 my($self, $package) = @_; 83 84 eval "package Text::Query::_firesafe; require $package"; 85 86 if ($@) { 87 my($advice) = ""; 88 if($@ =~ /Can't find loadable object/) { 89 $advice = "Perhaps $package was statically linked into a new perl binary." 90 ."\nIn which case you need to use that new perl binary." 91 ."\nOr perhaps only the .pm file was installed but not the shared object file." 92 } elsif ($@ =~ /Can't locate.*?.pm/) { 93 $advice = "Perhaps the $package perl module hasn't been installed\n"; 94 } 95 croak("$package failed: $@$advice\n"); 96 } 97 my($object); 98 $object = eval { $package->new() }; 99 croak("$@") if(!defined($object)); 100 101 return $object; 102} 103 104sub matchexp { 105 my($self) = @_; 106 107 return $self->{matchexp}; 108} 109 110sub matchstring { 111 my($self) = @_; 112 113 return $self->{-build}->matchstring(); 114} 115 116# 117# Parse interface 118# 119 120sub prepare { 121 my($self) = shift; 122 123 $self->{matchexp} = $self->{-optimize}->optimize($self->{-parse}->prepare(@_)); 124 125 return $self; 126} 127 128# 129# Solve interface 130# 131 132sub match { 133 my($self) = shift; 134 135 croak("solve undefined") if(!$self->{-solve}); 136 137 return $self->{-solve}->match($self->{matchexp}, @_); 138} 139 140sub matchscalar { 141 my($self) = shift; 142 143 croak("solve undefined") if(!$self->{-solve}); 144 145 return $self->{-solve}->matchscalar($self->{matchexp}, @_); 146} 147 148# 149# Accessors 150# 151 152sub build { 153 my($self) = shift; 154 return $self->{-build}; 155} 156 157sub parse { 158 my($self) = shift; 159 return $self->{-parse}; 160} 161 162sub solve { 163 my($self) = shift; 164 return $self->{-solve}; 165} 166 167sub optimize { 168 my($self) = shift; 169 return $self->{-optimize}; 170} 171 1721; 173 174__END__ 175 176=head1 NAME 177 178Text::Query - Query processing framework 179 180=head1 SYNOPSIS 181 182 use Text::Query; 183 184 # Constructor 185 $query = Text::Query->new([QSTRING] [OPTIONS]); 186 187 # Methods 188 $query->prepare(QSTRING [OPTIONS]); 189 $query->match([TARGET]); 190 $query->matchscalar([TARGET]); 191 192=head1 DESCRIPTION 193 194This module provides an object that matches a data source 195against a query expression. 196 197Query expressions are compiled into an internal form when a new object is created 198or the C<prepare> method is 199called; they are not recompiled on each match. 200 201The class provided by this module uses four packages to process the query. 202The query parser parses the question and calls a query expression 203builder (internal form of the question). The optimizer is then called 204to reduce the complexity of the expression. The solver applies the expression 205on a data source. 206 207The following parsers are provided: 208 209=over 4 210 211=item Text::Query::ParseAdvanced 212 213=item Text::Query::ParseSimple 214 215=back 216 217The following builders are provided: 218 219=over 4 220 221=item Text::Query::BuildAdvancedString 222 223=item Text::Query::BuildSimpleString 224 225=back 226 227The following solver is provided: 228 229=over 4 230 231=item Text::Query::SolveSimpleString 232 233=item Text::Query::SolveAdvancedString 234 235=back 236 237=head1 EXAMPLES 238 239 use Text::Query; 240 my $q=new Text::Query('hello and world', 241 -parse => 'Text::Query::ParseAdvanced', 242 -solve => 'Text::Query::SolveAdvancedString', 243 -build => 'Text::Query::BuildAdvancedString'); 244 die "bad query expression" if not defined $q; 245 print if $q->match; 246 ... 247 $q->prepare('goodbye or adios or ta ta', 248 -litspace => 1, 249 -case => 1); 250 #requires single space between the two ta's 251 if($q->match($line)) { 252 #doesn't match "Goodbye" 253 ... 254 $q->prepare('"and" or "or"'); 255 #quoting operators for literal match 256 ... 257 $q->prepare('\\bintegrate\\b', -regexp => 1); 258 #won't match "disintegrated" 259 260=head1 CONSTRUCTOR 261 262=over 4 263 264=item new ([QSTRING] [OPTIONS]) 265 266This is the constructor for a new Text::Query object. If a C<QSTRING> is 267given it will be compiled to internal form. 268 269C<OPTIONS> are passed in a hash like fashion, using key and value pairs. 270Possible options are: 271 272B<-parse> - Package name of the parser. Default is Text::Query::ParseSimple. 273 274B<-build> - Package name of the builder. Default is Text::Query::Build. 275 276B<-optimize> - Package name of the optimizer. Default is Text::Query::Optimize. 277 278B<-solve> - Package name of the solver. Default is Text::Query::Solve. 279 280B<-mode> - Name of predefined group of packages to use. Options are 281 currently C<simple_text> and C<advanced_text>. 282 283These options are handled by the C<configure> method. 284 285All other options are passed to the parser C<prepare> function. 286See the corresponding manual pages for a description. 287 288If C<QSTRING> is undefined, the prepare function is not called. 289 290The constructor will croak if a C<QSTRING> was supplied and had 291illegal syntax. 292 293=back 294 295=head1 METHODS 296 297=over 4 298 299=item configure ([OPTIONS]) 300 301Set the C<parse>, C<build>, C<optimize> or C<solve> packages. See the 302C<CONSTRUCTOR> description for explanations. 303 304=item prepare (QSTRING [OPTIONS]) 305 306Compiles the query expression in C<QSTRING> to internal form and sets any 307options (same as in the constructor). C<prepare> may be used to change 308the query expression and options for an existing query object. If 309C<OPTIONS> are omitted, any options set by a previous call to 310C<prepare> are persistent. 311 312The optimizer (-optimize) is called with the result of the parser (-parse). 313The parser uses the builder (-build) to construct the internal form. 314 315This method returns a reference to the query object if the syntax of the 316expression was legal, or croak if not. 317 318=item match ([TARGET]) 319 320Calls the match method of the solver (-solve). 321 322=item matchscalar ([TARGET]) 323 324Calls the matchscalar method of the solver (-solve). 325 326=back 327 328=head1 SEE ALSO 329 330Text::Query::ParseAdvanced(3), 331Text::Query::ParseSimple(3), 332Text::Query::BuildSimpleString(3), 333Text::Query::BuildAdvanedString(3), 334Text::Query::SolveSimpleString(3), 335Text::Query::SolveAdvancedString(3), 336 337Text::Query::Build(3), 338Text::Query::Parse(3), 339Text::Query::Solve(3), 340Text::Query::Optimize(3) 341 342=head1 MAINTENANCE 343 344=over 345 346=item https://github.com/jonjensen/Text-Query 347 348=item https://rt.cpan.org//Dist/Display.html?Queue=Text-Query 349 350=back 351 352=head1 AUTHORS 353 354Eric Bohlman (ebohlman@netcom.com) 355 356Loic Dachary (loic@senga.org) 357 358Jon Jensen, jon@endpoint.com 359 360=cut 361 362# Local Variables: *** 363# mode: perl *** 364# End: *** 365