Text::Query - Query processing framework

    use Text::Query;

    # Constructor
    $query = Text::Query->new([QSTRING] [OPTIONS]);

    # Methods
    $query->prepare(QSTRING [OPTIONS]);
    $query->match([TARGET]);
    $query->matchscalar([TARGET]);

  use Text::Query;
  my $q=new Text::Query('hello and world',
                        -parse => 'Text::Query::ParseAdvanced',
                        -solve => 'Text::Query::SolveAdvancedString',
                        -build => 'Text::Query::BuildAdvancedString');
  die "bad query expression" if not defined $q;
  print if $q->match;
  ...
  $q->prepare('goodbye or adios or ta ta',
              -litspace => 1,
              -case => 1);
  #requires single space between the two ta's
  if($q->match($line)) {
  #doesn't match "Goodbye"
  ...
  $q->prepare('"and" or "or"');
  #quoting operators for literal match
  ...
  $q->prepare('\\bintegrate\\b', -regexp => 1);
  #won't match "disintegrated"

#
#   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.pm,v 1.3 1999/06/16 10:35:44 loic Exp $
#
package Text::Query;

use strict;

use vars qw($VERSION);

$VERSION = "0.07";

use Carp;

sub new {
  my($class) = shift;
  my($self) = {};
  bless $self,$class;
  if(@_ % 2) {
      my($qstring) = shift;
      $self->configure(@_);
      return defined($qstring) ? $self->prepare($qstring, @_) : $self;
  } else {
      $self->configure(@_);
      return $self;
  }
}

sub configure {
    my($self, %args) = @_;

    $self->{-verbose} = $args{-verbose} || 0 if(!defined($self->{-verbose}));

    my(%defconfigs) = (
      simple_text =>
        { -parse => 'Text::Query::ParseSimple',
          -build => 'Text::Query::BuildSimpleString',
          -optimize => 'Text::Query::Optimize',
          -solve => 'Text::Query::SolveSimpleString'
        },
       advanced_text =>
        { -parse => 'Text::Query::ParseAdvanced',
          -build => 'Text::Query::BuildAdvancedString',
          -optimize => 'Text::Query::Optimize',
          -solve => 'Text::Query::SolveAdvancedString'
        },
    );

    my $default=(defined $args{-mode})?$args{-mode}:'simple_text';
    my($key);
    foreach $key (keys(%{$defconfigs{$default}})) {
        my($package) = $args{$key} ? $args{$key} : $defconfigs{$default}{$key};
	my($load) = !exists($self->{'packages'}{$key}) || $self->{'packages'}{$key} ne $package;

	if($load) {
	    $self->{$key} = $self->loader($package);
	    $self->{$key}->{-verbose} = $self->{-verbose};
	    warn("loaded $package => $self->{$key}") if($self->{-verbose});
	    $self->{'packages'}{$key} = $package;
	}
    }
    $self->{-parse}->{-build} = $self->{-build};
}

sub loader {
    my($self, $package) = @_;

    eval "package Text::Query::_firesafe; require $package";

    if ($@) {
	my($advice) = "";
	if($@ =~ /Can't find loadable object/) {
	    $advice = "Perhaps $package was statically linked into a new perl binary."
		 ."\nIn which case you need to use that new perl binary."
		 ."\nOr perhaps only the .pm file was installed but not the shared object file."
	} elsif ($@ =~ /Can't locate.*?.pm/) {
	    $advice = "Perhaps the $package perl module hasn't been installed\n";
	}
	croak("$package failed: $@$advice\n");
    }
    my($object);
    $object = eval { $package->new() };
    croak("$@") if(!defined($object));

    return $object;
}

sub matchexp {
    my($self) = @_;

    return $self->{matchexp};
}

sub matchstring {
    my($self) = @_;

    return $self->{-build}->matchstring();
}

#
# Parse interface
#

sub prepare {
  my($self) = shift;

  $self->{matchexp} = $self->{-optimize}->optimize($self->{-parse}->prepare(@_));

  return $self;
}

#
# Solve interface
#

sub match {
    my($self) = shift;

    croak("solve undefined") if(!$self->{-solve});

    return $self->{-solve}->match($self->{matchexp}, @_);
}

sub matchscalar {
    my($self) = shift;

    croak("solve undefined") if(!$self->{-solve});

    return $self->{-solve}->matchscalar($self->{matchexp}, @_);
}

#
# Accessors
#

sub build {
    my($self) = shift;
    return $self->{-build};
}

sub parse {
    my($self) = shift;
    return $self->{-parse};
}

sub solve {
    my($self) = shift;
    return $self->{-solve};
}

sub optimize {
    my($self) = shift;
    return $self->{-optimize};
}

1;

__END__

# Local Variables: ***
# mode: perl ***
# End: ***