File Coverage

blib/lib/Search/Tools/Query.pm

Criterion	Covered	Total	%
statement	114	126	90.4
branch	15	24	62.5
condition			n/a
subroutine	24	25	96.0
pod	11	11	100.0
total	164	186	88.1

package Search::Tools::Query;
use Moo;
extends 'Search::Tools::Object';
use overload
    '""'     => sub { $_[0]->str; },
    'bool'   => sub {1},
    fallback => 1;
use Carp;
use Data::Dump qw( dump );
use Search::Tools::RegEx;
use Search::Tools::UTF8;
use Search::Tools::Tokenizer;
use Search::Tools::XML;

use namespace::autoclean;

our $VERSION = '1.004';

has 'terms'   => ( is => 'ro' );
has 'fields'  => ( is => 'ro' );
has 'dialect' => ( is => 'ro' );
has 'str'     => ( is => 'ro' );
has 'regex'   => ( is => 'ro' );
has 'qp'      => ( is => 'ro' );

=head1 NAME

Search::Tools::Query - objectified string for highlighting, snipping, etc.

=head1 SYNOPSIS

 use Search::Tools::QueryParser;
 my $qparser  = Search::Tools::QueryParser->new;
 my $query    = $qparser->parse(q(the quick color:brown "fox jumped"));
 my $fields   = $query->fields; # ['color']
 my $terms    = $query->terms;  # ['quick', 'brown', '"fox jumped"']
 my $regex    = $query->regex_for($terms->[0]); # S::T::RegEx
 my $tree     = $query->tree; # the Search::Query::Dialect tree()
 print "$query\n";  # the quick color:brown "fox jumped"
 print $query->str . "\n"; # same thing


=head1 DESCRIPTION


=head1 METHODS

=head2 fields

Array ref of fields from the original query string.
See Search::Tools::QueryParser for controls over ignore_fields().

=head2 terms

Array ref of key words from the original query string.
See Search::Tools::QueryParser for controls over ignore_fields()
and tokenizing regex.

B
Only positive words are extracted by QueryParser.
In other words, if you search for:

 foo not bar

then only C is returned. Likewise:

 +foo -bar

would return only C.

=head2 str

The original string.

=head2 regex

The hash ref of terms to Search::Tools::RegEx objects.

=head2 dialect

The internal Search::Query::Dialect object. See tree()
and str_clean() which delegate to the dialect object.

=head2 qp

The Search::Tools::QueryParser object used to generate the Query.

=head2 num_terms

Returns the number of terms().

=cut

sub num_terms {
    return scalar @{ shift->{terms} };
}

=head2 unique_terms

Returns array ref of unique terms from query.
If stemming was on in the QueryParser,
all terms have already been stemmed as part
of the parsing process.

=cut

sub unique_terms {
    my $self = shift;
    my @t    = @{ $self->{terms} };
    my %uniq;
    for my $t (@t) {
        my $re = $self->regex_for($t);
        if ( $re->is_phrase ) {
            for my $pt ( @{ $re->phrase_terms } ) {
                $uniq{ $pt->term }++;
            }
        }
        else {
            $uniq{ $re->term }++;
        }
    }
    return [ keys %uniq ];
}

=head2 num_unique_terms

Returns number of unique_terms().

=cut

sub num_unique_terms {
    return scalar( @{ $_[0]->unique_terms } );
}

=head2 phrases

Return array ref of RegEx objects for all terms where is_phrase
is true.

=cut

sub phrases {
    my $self = shift;
    my @p;
    for my $t ( keys %{ $self->{regex} } ) {
        if ( $self->{regex}->{$t}->is_phrase ) {
            push @p, $self->{regex}->{$t};
        }
    }
    return \@p;
}

=head2 non_phrases

Return array ref of RegEx objects for all terms where is_phrase
is false.

=cut

sub non_phrases {
    my $self = shift;
    my @p;
    for my $t ( keys %{ $self->{regex} } ) {
        if ( !$self->{regex}->{$t}->is_phrase ) {
            push @p, $self->{regex}->{$t};
        }
    }
    return \@p;
}

=head2 tree

Returns the internal Search::Query::Dialect tree().

=cut

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

=head2 str_clean

Returns the internal Search::Query::Dialect stringify().

=cut

sub str_clean {
    my $self = shift;
    return $self->dialect->stringify();
}

=head2 regex_for(I)

Returns a Search::Tools::RegEx object for I.

=cut

sub regex_for {
    my $self = shift;
    my $term = shift;
    unless ( defined $term ) {
        croak "term required";
    }
    my $regex = $self->{regex} or croak "regex not defined for query";
    if ( !exists $regex->{$term} ) {
        croak "no regex for $term";
    }
    return $regex->{$term};
}

=head2 regexp_for

Alias for regex_for(). The author has come to prefer "regex"
instead of "regexp" because it's one less keystroke.

=cut

*regexp_for = \®ex_for;

=head2 matches_text( I )

Returns the number of matches for the query against I.

=head2 matches_html( I )

Returns the number of matches for the query against I.

=cut

sub _matches_stemmed {
    my $self      = shift;
    my $text      = to_utf8( $_[0] );
    my $count     = 0;
    my $qp        = $self->qp;
    my $stemmer   = $qp->stemmer;
    my $wildcard  = $qp->wildcard;
    my $tokenizer = Search::Tools::Tokenizer->new(
        re    => $qp->term_re,
        debug => $self->debug,
    );

    # stem the whole text, creating a new buffer to
    # match against. This covers both the cases where
    # a term is a phrase and where it is not.
    my @buf;
    my $buf_maker = sub {
        push @buf, $stemmer->( $qp, $_[0]->str );
    };
    $tokenizer->tokenize( $text, $buf_maker );
    my $new_text = join( " ", @buf );

    for my $term ( @{ $self->{terms} } ) {
        my $re = $self->{regex}->{$term}->{plain};
        $count += $new_text =~ m/$re/;
    }
    return $count;
}

sub _matches {
    my $self  = shift;
    my $style = shift;
    my $text  = to_utf8( $_[0] );
    my $count = 0;
    for my $term ( @{ $self->{terms} } ) {
        my $regex = $self->{regex}->{$term}->{$style};
        $count += $text =~ m/$regex/;
    }
    return $count;
}

sub matches_text {
    my $self = shift;
    my $text = shift;
    if ( !defined $text ) {
        croak "text required";
    }
    return $self->_matches_stemmed($text) if $self->qp->stemmer;
    return $self->_matches( 'plain', $text );
}

sub matches_html {
    my $self = shift;
    my $html = shift;
    if ( !defined $html ) {
        croak "html required";
    }
    if ( $self->qp->stemmer ) {
        return $self->_matches_stemmed( Search::Tools::XML->no_html($html) );
    }
    return $self->_matches( 'html', $html );
}

=head2 terms_as_regex([I])

Returns all terms() as a single qr// regex, pipe-joined in a "OR"
logic.

=cut

sub terms_as_regex {
    my $self                     = shift;
    my $treat_phrases_as_singles = shift;
    $treat_phrases_as_singles = 1 unless defined $treat_phrases_as_singles;
    my $wildcard = $self->qp->wildcard;
    my $wild_esc = quotemeta($wildcard);
    my $wc       = $self->qp->word_characters;
    my @re;
    for my $term ( @{ $self->{terms} } ) {

        my $q = quotemeta($term);    # quotemeta speeds up the match, too
                                     # even though we have to unquote below

        $q =~ s/\\$wild_esc/[$wc]*/g;    # wildcard match is very approximate

        # treat phrases like OR'd words
        # since that will just create more matches.
        # if hiliting later, the phrase will be treated as such.
        if ($treat_phrases_as_singles) {
            $q =~ s/(\\ )+/\|/g;
        }

      # if keeping phrases together use a less-naive regex instead of a space.
        else {

            #$q = $self->regex_for($term)->plain();
            #$q =~ s/(\\ )+/[^$wc]+/g;
        }

        push( @re, $q );
    }

    my $j = sprintf( '(%s)', join( '|', @re ) );
    return qr/$j/i;
}

1;

__END__