Plucene::QueryParser - Turn query strings into Plucene::Search::Query objects

	my $p = Plucene::QueryParser->new({
		analyzer => Plucene::Analysis::Analyzer $a,
		default  => "text"
	});

	my Plucene::Search::Query $q = $p->parse("foo bar:baz");

	my $p = Plucene::QueryParser->new({
		analyzer => Plucene::Analysis::Analyzer $a,
		default  => "text"
	});

	my Plucene::Search::Query $q = $p->parse("foo bar:baz");

package Plucene::QueryParser;

use strict;
use warnings;

use base 'Class::Accessor::Fast';

use Carp 'croak';
use IO::Scalar;
use Text::Balanced qw(extract_delimited extract_bracketed);
our $DefaultOperator = "OR";

__PACKAGE__->mk_accessors(qw(analyzer default));

sub new {
	my $self = shift->SUPER::new(@_);
	croak "You need to pass an analyzer"
		unless UNIVERSAL::isa($self->{analyzer}, "Plucene::Analysis::Analyzer");
	croak "No default field name supplied!" unless $self->{default};
	return $self;
}

sub parse {
	my $self = shift;
	local $_ = shift;
	my $ast = shift;
	my @rv;
	while ($_) {
		s/^\s+// and next;
		my $item;
		$item->{conj} = "NONE";
		s/^(AND|OR|\|\|)\s+//i;
		if ($1) {
			$item->{conj} = uc $1;
			$item->{conj} = "OR"
				if $item->{conj} eq "||";
		}
		if (s/^\+//) { $item->{mods} = "REQ"; }
		elsif (s/^(-|!|NOT(?=[^\w:]))\s*//i) { $item->{mods} = "NOT"; }
		else { $item->{mods} = "NONE"; }

		if (s/^([^\s(":]+)://) { $item->{field} = $1 }

		# Subquery
		if (/^\(/) {
			my ($extracted, $remainer) = extract_bracketed($_, "(");
			if (!$extracted) { croak "Unbalanced subquery" }
			$_ = $remainer;
			$extracted =~ s/^\(//;
			$extracted =~ s/\)$//;
			$item->{query} = "SUBQUERY";
			$item->{subquery} = $self->parse($extracted, 1);
		} elsif (/^"/) {
			my ($extracted, $remainer) = extract_delimited($_, '"');
			if (!$extracted) { croak "Unbalanced phrase" }
			$_ = $remainer;
			$extracted =~ s/^"//;
			$extracted =~ s/"$//;
			$item->{query} = "PHRASE";
			$item->{term}  = $self->_tokenize($extracted);
		} elsif (s/^(\S+)\*//) {
			$item->{query} = "PREFIX";
			$item->{term}  = $self->_tokenize($1);
		} else {
			s/([^\s\^]+)// or croak "Malformed query";
			$item->{query} = "TERM";
			$item->{term}  = $self->_tokenize($1);
			if ($item->{term} =~ / /) { $item->{query} = "PHRASE"; }
		}
		s/^~(\d+)// and $item->{slop} = $1;
		if (s/^\^(\d+(?:.\d+)?)//) { $item->{boost} = $1 }

		push @rv, bless $item,
			"Plucene::QueryParser::" . ucfirst lc $item->{query};
	}
	my $obj = bless \@rv, "Plucene::QueryParser::TopLevel";

	# If we only want the AST, don't convert to a Search::Query.
	if ($ast) { return $obj }
	return $obj->to_plucene($self->{default});
}

sub _tokenize {
	my ($self, $image) = @_;
	my $stream = $self->{analyzer}->tokenstream(
		{
			field  => $self->{default},
			reader => IO::Scalar->new(\$image)
		}
	);
	my @words;
	while (my $x = $stream->next) { push @words, $x->text }
	join(" ", @words);
}

package Plucene::QueryParser::TopLevel;

sub to_plucene {
	my ($self, $field) = @_;
	return $self->[0]->to_plucene($field)
		if @$self == 1
		and $self->[0]->{mods} eq "NONE";

	my @clauses;
	$self->add_clause(\@clauses, $_, $field) for @$self;
	require Plucene::Search::BooleanQuery;
	my $query = new Plucene::Search::BooleanQuery;
	$query->add_clause($_) for @clauses;

	$query;
}

sub add_clause {
	my ($self, $clauses, $term, $field) = @_;
	my $q = $term->to_plucene($field);
	if ($term->{conj} eq "AND" and @$clauses) {

		# The previous term needs to become required
		$clauses->[-1]->required(1) unless $clauses->[-1]->prohibited;
	}

	if (  $Plucene::QueryParser::DefaultOperator eq "AND"
		and $term->{conj} eq "OR") {
		$clauses->[-1]->required(0) unless $clauses->[-1]->prohibited;
	}

	return unless $q;    # Shouldn't happen yet
	my $prohibited;
	my $required;
	if ($Plucene::QueryParser::DefaultOperator eq "OR") {

		# We set REQUIRED if we're introduced by AND or +; PROHIBITED if
		# introduced by NOT or -; make sure not to set both.
		$prohibited = ($term->{mods} eq "NOT");
		$required   = ($term->{mods} eq "REQ");

		$required = 1 if $term->{conj} eq "AND" and !$prohibited;
	} else {

		# We set PROHIBITED if we're introduced by NOT or -; We set
		# REQUIRED if not PROHIBITED and not introduced by OR
		$prohibited = ($term->{mods} eq "NOT");
		$required = (!$prohibited and $term->{conj} ne "OR");
	}
	require Plucene::Search::BooleanClause;
	push @$clauses,
		Plucene::Search::BooleanClause->new(
		{
			prohibited => $prohibited,
			required   => $required,
			query      => $q
		}
		);
}

package Plucene::QueryParser::Term;

sub to_plucene {
	require Plucene::Search::TermQuery;
	require Plucene::Index::Term;
	my ($self, $field) = @_;
	$self->set_term($field);
	my $q = Plucene::Search::TermQuery->new({ term => $self->{pl_term} });
	$self->set_boost($q);
	return $q;
}

sub set_term {
	my ($self, $field) = @_;
	$self->{pl_term} = Plucene::Index::Term->new(
		{
			field => (exists $self->{field} ? $self->{field} : $field),
			text => $self->{term}
		}
	);
}

sub set_boost {
	my ($self, $q) = @_;
	$q->boost($self->{boost}) if exists $self->{boost};
}

package Plucene::QueryParser::Phrase;
our @ISA = qw(Plucene::QueryParser::Term);

# This corresponds to the rules for "PHRASE" in the Plucene grammar

sub to_plucene {
	require Plucene::Search::PhraseQuery;
	require Plucene::Index::Term;
	my ($self, $field) = @_;
	my @words = split /\s+/, $self->{term};
	return $self->SUPER::to_plucene($field) if @words == 1;

	my $phrase = Plucene::Search::PhraseQuery->new;
	for my $word (@words) {
		my $term = Plucene::Index::Term->new(
			{
				field => (exists $self->{field} ? $self->{field} : $field),
				text => $word
			}
		);
		$phrase->add($term);
	}
	if (exists $self->{slop}) {
		$phrase->slop($self->{slop});
	}
	$self->set_boost($phrase);
	return $phrase;
}

package Plucene::QueryParser::Subquery;

sub to_plucene {
	my ($self, $field) = @_;
	$self->{subquery}
		->to_plucene(exists $self->{field} ? $self->{field} : $field);
}

package Plucene::QueryParser::Prefix;
our @ISA = qw(Plucene::QueryParser::Term);

sub to_plucene {
	require Plucene::Search::PrefixQuery;
	my ($self, $field) = @_;
	$self->set_term($field);
	my $q = Plucene::Search::PrefixQuery->new({ prefix => $self->{pl_term} });
	$self->set_boost($q);
	return $q;
}

1;