WebService-Solr-0.44/ 0000755 0001017 0000764 00000000000 13606152340 013573 5 ustar alester ispc WebService-Solr-0.44/lib/ 0000755 0001017 0000764 00000000000 13606152337 014347 5 ustar alester ispc WebService-Solr-0.44/lib/WebService/ 0000755 0001017 0000764 00000000000 13606152337 016405 5 ustar alester ispc WebService-Solr-0.44/lib/WebService/Solr.pm 0000644 0001017 0000764 00000025334 13606151724 017670 0 ustar alester ispc package WebService::Solr;
use Moo;
use Types::Standard qw(InstanceOf Object Bool HashRef Maybe);
use Scalar::Util qw(blessed);
use Encode qw(encode);
use URI;
use LWP::UserAgent;
use WebService::Solr::Response;
use HTTP::Request;
use HTTP::Headers;
use XML::Easy::Element;
use XML::Easy::Content;
use XML::Easy::Text ();
use Carp qw(confess);
has 'url' => (
is => 'ro',
isa => InstanceOf['URI'],
default => sub { URI->new( 'http://localhost:8983/solr' ) }
);
has 'agent' =>
( is => 'ro', isa => Object, default => sub { LWP::UserAgent->new } );
has 'autocommit' => ( is => 'ro', isa => Bool, default => 1 );
has 'default_params' => (
is => 'ro',
isa => HashRef,
default => sub { { wt => 'json' } }
);
around default_params => sub {
my ($orig, $self, @args) = @_;
my $ret = $self->$orig(@args);
return wantarray ? %$ret : $ret;
};
has 'last_response' => (
is => 'rw',
isa => Maybe[InstanceOf['WebService::Solr::Response']],
);
our $VERSION = '0.44';
sub BUILDARGS {
my ( $self, $url, $options ) = @_;
$options ||= {};
if ( $url ) {
$options->{ url } = ref $url ? $url : URI->new( $url );
}
if ( exists $options->{ default_params } ) {
$options->{ default_params }
= { %{ $options->{ default_params } }, wt => 'json', };
}
return $options;
}
sub add {
my ( $self, $doc, $params ) = @_;
my @docs = ref $doc eq 'ARRAY' ? @$doc : ( $doc );
my @elements = map {
( '',
blessed $_
? $_->to_element
: WebService::Solr::Document->new(
ref $_ eq 'HASH' ? %$_ : @$_
)->to_element
)
} @docs;
$params ||= {};
my $e
= XML::Easy::Element->new( 'add', $params,
XML::Easy::Content->new( [ @elements, '' ] ),
);
my $xml = XML::Easy::Text::xml10_write_element( $e );
my $response = $self->_send_update( $xml );
return $response->ok;
}
sub update {
return shift->add( @_ );
}
sub commit {
my ( $self, $params ) = @_;
$params ||= {};
my $e = XML::Easy::Element->new( 'commit', $params, [ '' ] );
my $xml = XML::Easy::Text::xml10_write_element( $e );
my $response = $self->_send_update( $xml, {}, 0 );
return $response->ok;
}
sub rollback {
my ( $self ) = @_;
my $response = $self->_send_update( '', {}, 0 );
return $response->ok;
}
sub optimize {
my ( $self, $params ) = @_;
$params ||= {};
my $e = XML::Easy::Element->new( 'optimize', $params, [ '' ] );
my $xml = XML::Easy::Text::xml10_write_element( $e );
my $response = $self->_send_update( $xml, {}, 0 );
return $response->ok;
}
sub delete {
my ( $self, $options ) = @_;
my $xml = '';
for my $k ( keys %$options ) {
my $v = $options->{ $k };
$xml .= join(
'',
map {
XML::Easy::Text::xml10_write_element(
XML::Easy::Element->new( $k, {}, [ $_ ] ) )
} ref $v ? @$v : $v
);
}
my $response = $self->_send_update( "${xml}" );
return $response->ok;
}
sub delete_by_id {
my ( $self, $id ) = @_;
return $self->delete( { id => $id } );
}
sub delete_by_query {
my ( $self, $query ) = @_;
return $self->delete( { query => $query } );
}
sub ping {
my ( $self ) = @_;
$self->last_response( WebService::Solr::Response->new(
$self->agent->get( $self->_gen_url( 'admin/ping' ) ) ) );
return $self->last_response->is_success;
}
sub search {
my ( $self, $query, $params ) = @_;
$params ||= {};
$params->{ 'q' } = $query;
return $self->generic_solr_request( 'select', $params );
}
sub auto_suggest {
shift->generic_solr_request( 'autoSuggest', @_ );
}
sub generic_solr_request {
my ( $self, $path, $params ) = @_;
$params ||= {};
return $self->last_response(
WebService::Solr::Response->new(
$self->agent->post(
$self->_gen_url( $path ),
Content_Type => 'application/x-www-form-urlencoded; charset=utf-8',
Content => { $self->default_params, %$params } ) ) );
}
sub _gen_url {
my ( $self, $handler ) = @_;
my $url = $self->url->clone;
$url->path( $url->path . "/$handler" );
return $url;
}
sub _send_update {
my ( $self, $xml, $params, $autocommit ) = @_;
$autocommit = $self->autocommit unless defined $autocommit;
$params ||= {};
my $url = $self->_gen_url( 'update' );
$url->query_form( { $self->default_params, %$params } );
my $req = HTTP::Request->new(
POST => $url,
HTTP::Headers->new( Content_Type => 'text/xml; charset=utf-8' ),
'' . encode( 'utf8', "$xml" )
);
my $http_response = $self->agent->request( $req );
if ( $http_response->is_error ) {
confess($http_response->status_line . ': ' . $http_response->content);
}
$self->last_response( WebService::Solr::Response->new( $http_response ) );
$self->commit if $autocommit;
return $self->last_response;
}
no Moo;
1;
__END__
=head1 NAME
WebService::Solr - Module to interface with the Solr (Lucene) webservice
=head1 SYNOPSIS
my $solr = WebService::Solr->new;
$solr->add( @docs );
my $response = $solr->search( $query );
for my $doc ( $response->docs ) {
print $doc->value_for( $id );
}
=head1 DESCRIPTION
WebService::Solr is a client library for Apache Lucene's Solr; an
enterprise-grade indexing and searching platform.
=head1 ACCESSORS
=over 4
=item * url - the webservice base url
=item * agent - a user agent object
=item * autocommit - a boolean value for automatic commit() after add/update/delete (default: enabled)
=item * default_params - a hashref of parameters to send on every request
=item * last_response - stores a WebService::Solr::Response for the last request
=back
=head1 HTTP KEEP-ALIVE
Enabling HTTP Keep-Alive is as simple as passing your custom user-agent to the
constructor.
my $solr = WebService::Solr->new( $url,
{ agent => LWP::UserAgent->new( keep_alive => 1 ) }
);
Visit L's documentation for more information and available
options.
=head1 METHODS
=head2 new( $url, \%options )
Creates a new WebService::Solr instance. If C<$url> is omitted, then
C is used as a default. Available options are
listed in the L section.
=head2 BUILDARGS( @args )
A Moo override to allow our custom constructor.
=head2 add( $doc|\@docs, \%options )
Adds a number of documents to the index. Returns true on success, false
otherwise. A document can be a L object or a
structure that can be passed to Cnew>. Available
options as of Solr 1.4 are:
=over 4
=item * overwrite (default: true) - Replace previously added documents with the same uniqueKey
=item * commitWithin (in milliseconds) - The document will be added within the specified time
=back
=head2 update( $doc|\@docs, \%options )
Alias for C.
=head2 delete( \%options )
Deletes documents matching the options provided. The delete operation currently
accepts C and C parameters. Multiple values can be specified as
array references.
# delete documents matching "title:bar" or uniqueId 13 or 42
$solr->delete( {
query => 'title:bar',
id => [ 13, 42 ],
} );
=head2 delete_by_id( $id )
Deletes all documents matching the id specified. Returns true on success,
false otherwise.
=head2 delete_by_query( $query )
Deletes documents matching C<$query>. Returns true on success, false
otherwise.
=head2 search( $query, \%options )
Searches the index given a C<$query>. Returns a L
object. All key-value pairs supplied in C<\%options> are serialized in the
request URL.
If filter queries are needed, create WebService::Solr::Query objects
and pass them into the C<%options>. For example, if you were searching
a database of books for a subject of "Perl", but wanted only paperbacks
and a copyright year of 2011 or 2012:
my $query = WebService::Solr::Query->new( { subject => 'Perl' } );
my %options = (
fq => [
WebService::Solr::Query->new( { binding => 'Paperback' } ),
WebService::Solr::Query->new( { year => [ 2011, 2012 ] } ),
],
);
my $response = $solr->search( $query, \%options );
The filter queries are typically added when drilling down into search
results and selecting a facet to drill into.
In order to enable facets, the option C "on"> must be passed.
Facet options are detailed in the wiki (https://wiki.apache.org/solr/SimpleFacetParameters).
=head2 auto_suggest( \%options )
Get suggestions from a list of terms for a given field. The Solr wiki has
more details about the available options (http://wiki.apache.org/solr/TermsComponent)
=head2 commit( \%options )
Sends a commit command. Returns true on success, false otherwise. You must do
a commit after an add, update or delete. By default, autocommit is enabled.
You may disable autocommit to allow you to issue commit commands manually:
my $solr = WebService::Solr->new( undef, { autocommit => 0 } );
$solr->add( $doc ); # will not automatically call commit()
$solr->commit;
Options as of Solr 1.4 include:
=over 4
=item * maxSegments (default: 1) - Optimizes down to at most this number of segments
=item * waitFlush (default: true) - Block until index changes are flushed to disk
=item * waitSearcher (default: true) - Block until a new searcher is opened
=item * expungeDeletes (default: false) - Merge segments with deletes away
=back
=head2 rollback( )
This method will rollback any additions/deletions since the last commit.
=head2 optimize( \%options )
Sends an optimize command. Returns true on success, false otherwise.
Options as of Solr 1.4 are the same as C.
=head2 ping( )
Sends a basic ping request. Returns true on success, false otherwise.
=head2 generic_solr_request( $path, \%query )
Performs a simple C request appending C<$path> to the base URL
and using key-value pairs from C<\%query> to generate the query string. This
should allow you to access parts of the Solr API that don't yet have their
own correspondingly named function (e.g. C ).
=head1 SEE ALSO
=over 4
=item * http://lucene.apache.org/solr/
=item * L - an alternate library
=back
=head1 AUTHORS
Andy Lester C
Brian Cassidy Ebricas@cpan.orgE
Kirk Beers
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
WebService-Solr-0.44/lib/WebService/Solr/ 0000755 0001017 0000764 00000000000 13606152337 017324 5 ustar alester ispc WebService-Solr-0.44/lib/WebService/Solr/Document.pm 0000644 0001017 0000764 00000007113 13606151724 021441 0 ustar alester ispc package WebService::Solr::Document;
use WebService::Solr::Field;
use XML::Easy::Element;
use XML::Easy::Content;
use XML::Easy::Text ();
use Scalar::Util 'blessed';
sub new {
my ( $class, @fields ) = @_;
my $self = {
fields => [ _parse_fields( @fields ) ]
};
return bless $self, $class;
}
sub boost {
my $self = shift;
$self->{ boost } = $_[ 0 ] if @_;
return $self->{ boost };
}
sub fields {
my $self = shift;
$self->{ fields } = $_[ 0 ] if @_;
return wantarray ? @{ $self->{ fields } } : $self->{ fields };
}
sub add_fields {
my ( $self, @fields ) = @_;
$self->fields( [ $self->fields, _parse_fields( @fields ) ] );
}
sub _parse_fields {
my @fields = @_;
my @new_fields;
# handle field objects, array refs and normal k => v pairs
while ( my $f = shift @fields ) {
if ( blessed $f ) {
push @new_fields, $f;
next;
}
elsif ( ref $f ) {
push @new_fields, WebService::Solr::Field->new( @$f );
next;
}
my $v = shift @fields;
my @values = ( ref $v and !blessed $v ) ? @$v : $v;
push @new_fields,
map { WebService::Solr::Field->new( $f => "$_" ) } @values;
}
return @new_fields;
}
sub field_names {
my ( $self ) = @_;
my %names = map { $_->name => 1 } $self->fields;
return keys %names;
}
sub value_for {
my ( $self, $key ) = @_;
for my $field ( $self->fields ) {
if ( $field->name eq $key ) {
return $field->value;
}
}
return;
}
sub values_for {
my ( $self, $key ) = @_;
return map { $_->value } grep { $_->name eq $key } $self->fields;
}
sub to_element {
my $self = shift;
my %attr = ( $self->boost ? ( boost => $self->boost ) : () );
my @elements = map { ( '' => $_->to_element ) } $self->fields;
return XML::Easy::Element->new( 'doc', \%attr,
XML::Easy::Content->new( [ @elements, '' ] ),
);
}
sub to_xml {
my $self = shift;
return XML::Easy::Text::xml10_write_element( $self->to_element );
}
1;
__END__
=head1 NAME
WebService::Solr::Document - A document object
=head1 SYNOPSIS
my $doc = WebService::Solr::Document->new;
$doc->add_fields( @fields );
$doc->boost( 2.0 );
my $id = $doc->value_for( 'id' );
my @subjects = $doc->values_for( 'subject' );
=head1 DESCRIPTION
This class represents a basic document object, which is basically
a collection of fields.
=head1 ACCESSORS
=over 4
=item * fields - an array of fields
=item * boost - a floating-point "boost" value
=back
=head1 METHODS
=head2 new( @fields|\@fields )
Constructs a new document object given C<@fields>. A field can be a
L object, or a structure accepted by
Cnew>.
=head2 BUILDARGS( @args )
A Moose override to allow our custom constructor.
=head2 add_fields( @fields|\@fields )
Adds C<@fields> to the document.
=head2 field_names
Returns a list of field names that are in this document.
=head2 value_for( $name )
Returns the first value for C<$name>.
=head2 values_for( $name )
Returns all values for C<$name>.
=head2 to_element( )
Serializes the object to an XML::Easy::Element object.
=head2 to_xml( )
Serializes the object to xml.
=head1 AUTHORS
Andy Lester C
Brian Cassidy Ebricas@cpan.orgE
Kirk Beers
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
WebService-Solr-0.44/lib/WebService/Solr/Field.pm 0000644 0001017 0000764 00000004173 13606151724 020711 0 ustar alester ispc package WebService::Solr::Field;
use XML::Easy::Element;
use XML::Easy::Content;
use XML::Easy::Text ();
sub new {
my ( $class, $name, $value, $opts ) = @_;
$opts ||= {};
die "name required" unless defined $name;
die "value required" unless defined $value;
my $self = {
name => $name,
value => $value,
%{ $opts },
};
return bless $self, $class;
}
sub name {
my $self = shift;
$self->{ name } = $_[ 0 ] if @_;
return $self->{ name };
}
sub value {
my $self = shift;
$self->{ value } = $_[ 0 ] if @_;
return $self->{ value };
}
sub boost {
my $self = shift;
$self->{ boost } = $_[ 0 ] if @_;
return $self->{ boost };
}
sub to_element {
my $self = shift;
my %attr = ( $self->boost ? ( boost => $self->boost ) : () );
return XML::Easy::Element->new(
'field',
{ name => $self->name, %attr },
XML::Easy::Content->new( [ $self->value ] ),
);
}
sub to_xml {
my $self = shift;
return XML::Easy::Text::xml10_write_element( $self->to_element );
}
1;
__END__
=head1 NAME
WebService::Solr::Field - A field object
=head1 SYNOPSIS
my $field = WebService::Solr::Field->new( foo => 'bar' );
=head1 DESCRIPTION
This class represents a field from a document, which is basically a
name-value pair.
=head1 ACCESSORS
=over 4
=item * name - the field's name
=item * value - the field's value
=item * boost - a floating-point boost value
=back
=head1 METHODS
=head2 new( $name => $value, \%options )
Creates a new field object. Currently, the only option available is a
"boost" value.
=head2 BUILDARGS( @args )
A Moo override to allow our custom constructor.
=head2 to_element( )
Serializes the object to an XML::Easy::Element object.
=head2 to_xml( )
Serializes the object to xml.
=head1 AUTHORS
Andy Lester C
Brian Cassidy Ebricas@cpan.orgE
Kirk Beers
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
WebService-Solr-0.44/lib/WebService/Solr/Query.pm 0000644 0001017 0000764 00000024307 13606151724 020774 0 ustar alester ispc package WebService::Solr::Query;
use Moo;
use Types::Standard qw(ArrayRef);
use overload q("") => 'stringify';
my $escape_chars = quotemeta( '+-&|!(){}[]^"~*?:\\' );
has 'query' => ( is => 'ro', isa => ArrayRef, default => sub { [] } );
use constant D => 0;
sub BUILDARGS {
my $class = shift;
if ( @_ == 1 && ref $_[ 0 ] && ref $_[ 0 ] eq 'ARRAY' ) {
return { query => $_[ 0 ] };
}
return { query => \@_ };
}
sub stringify {
my $self = shift;
return $self->_dispatch_struct( $self->query );
}
sub _dispatch_struct {
my ( $self, $struct ) = @_;
my $method = '_struct_' . ref $struct;
D && $self->___log( "Dispatching to ->$method " . __dumper( $struct ) );
my $rv = $self->$method( $struct );
D && $self->___log( "Returned: $rv" );
return $rv;
}
sub _struct_HASH {
my ( $self, $struct ) = @_;
my @clauses;
for my $k ( sort keys %$struct ) {
my $v = $struct->{ $k };
D && $self->___log( "Key => $k, value => " . __dumper( $v ) );
if ( $k =~ m{^-(.+)} ) {
my $method = "_op_$1";
D && $self->___log( "Dispatch ->$method " . __dumper( $v ) );
push @clauses, $self->$method( $v );
}
else {
D
&& $self->___log(
"Dispatch ->_dispatch_value $k, " . __dumper( $v ) );
push @clauses, $self->_dispatch_value( $k, $v );
}
}
my $rv = join( ' AND ', @clauses );
D && $self->___log( "Returning: $rv" );
return $rv;
}
sub _struct_ARRAY {
my ( $self, $struct ) = @_;
my $rv
= '('
. join( " OR ", map { $self->_dispatch_struct( $_ ) } @$struct )
. ')';
D && $self->___log( "Returning: $rv" );
return $rv;
}
sub _dispatch_value {
my ( $self, $k, $v ) = @_;
my $rv;
### it's an array ref, the first element MAY be an operator!
### it would look something like this:
# [ '-and',
# { '-require' => 'star' },
# { '-require' => 'wars' }
# ];
if ( ref $v
and UNIVERSAL::isa( $v, 'ARRAY' )
and defined $v->[ 0 ]
and $v->[ 0 ] =~ /^ - ( AND|OR ) $/ix )
{
### XXX we're assuming that all the next statements MUST
### be hashrefs. is this correct?
$v = [ @$v ]; # Copy the array because we're going to be modifying it.
shift @$v;
my $op = uc $1;
D
&& $self->___log(
"Special operator detected: $op " . __dumper( $v ) );
my @clauses;
for my $href ( @$v ) {
D
&& $self->___log( "Dispatch ->_dispatch_struct({ $k, "
. __dumper( $href )
. '})' );
### the individual directive ($href) pertains to the key,
### so we should send that along.
my $part = $self->_dispatch_struct( { $k => $href } );
D && $self->___log( "Returned $part" );
push @clauses, '(' . $part . ')';
}
$rv = '(' . join( " $op ", @clauses ) . ')';
### nothing special about this combo, so do a usual dispatch
}
else {
my $method = '_value_' . ( ref $v || 'SCALAR' );
D && $self->___log( "Dispatch ->$method $k, " . __dumper( $v ) );
$rv = $self->$method( $k, $v );
}
D && $self->___log( "Returning: $rv" );
return $rv;
}
sub _value_SCALAR {
my ( $self, $k, $v ) = @_;
if ( ref $v ) {
$v = $$v;
}
else {
$v = '"' . $self->escape( $v ) . '"';
}
my $r = qq($k:$v);
$r =~ s{^:}{};
D && $self->___log( "Returning: $r" );
return $r;
}
sub _value_HASH {
my ( $self, $k, $v ) = @_;
my @clauses;
for my $op ( sort keys %$v ) {
my $struct = $v->{ $op };
$op =~ s{^-(.+)}{_op_$1};
D && $self->___log( "Dispatch ->$op $k, " . __dumper( $v ) );
push @clauses, $self->$op( $k, $struct );
}
my $rv = join( ' AND ', @clauses );
D && $self->___log( "Returning: $rv" );
return $rv;
}
sub _value_ARRAY {
my ( $self, $k, $v ) = @_;
my $rv = '('
. join( ' OR ', map { $self->_value_SCALAR( $k, $_ ) } @$v ) . ')';
D && $self->___log( "Returning: $rv" );
return $rv;
}
sub _op_default {
my ( $self, $v ) = @_;
return $self->_dispatch_value( '', $v );
}
sub _op_range {
my ( $self, $k ) = ( shift, shift );
my @v = @{ shift() };
return "$k:[$v[ 0 ] TO $v[ 1 ]]";
}
*_op_range_inc = \&_op_range;
sub _op_range_exc {
my ( $self, $k ) = ( shift, shift );
my @v = @{ shift() };
return "$k:{$v[ 0 ] TO $v[ 1 ]}";
}
sub _op_boost {
my ( $self, $k ) = ( shift, shift );
my ( $v, $boost ) = @{ shift() };
$v = $self->escape( $v );
return qq($k:"$v"^$boost);
}
sub _op_fuzzy {
my ( $self, $k ) = ( shift, shift );
my ( $v, $distance ) = @{ shift() };
$v = $self->escape( $v );
return qq($k:$v~$distance);
}
sub _op_proximity {
my ( $self, $k ) = ( shift, shift );
my ( $v, $distance ) = @{ shift() };
$v = $self->escape( $v );
return qq($k:"$v"~$distance);
}
sub _op_require {
my ( $self, $k, $v ) = @_;
$v = $self->escape( $v );
return qq(+$k:"$v");
}
sub _op_prohibit {
my ( $self, $k, $v ) = @_;
$v = $self->escape( $v );
return qq(-$k:"$v");
}
sub escape {
my ( $self, $text ) = @_;
$text =~ s{([$escape_chars])}{\\$1}g;
return $text;
}
sub unescape {
my ( $self, $text ) = @_;
$text =~ s{\\([$escape_chars])}{$1}g;
return $text;
}
sub ___log {
my $self = shift;
my $msg = shift;
### subroutine the log call came from, and line number the log
### call came from. that's 2 different caller frames :(
my $who = join ':', [ caller( 1 ) ]->[ 3 ], [ caller( 0 ) ]->[ 2 ];
### make sure we prefix every line with a #
$msg =~ s/\n/\n#/g;
print "# $who: $msg\n";
}
sub __dumper {
require Data::Dumper;
return Data::Dumper::Dumper( @_ );
}
no Moo;
1;
__END__
=head1 NAME
WebService::Solr::Query - Abstract query syntax for Solr queries
=head1 SYNOPSIS
my $query = WebService::Solr::Query->new( { foo => 'bar' } );
my $result = $solr->search( $query );
=head1 DESCRIPTION
WebService::Solr::Query provides a programmatic way to generate
queries to be sent to Solr. Syntax wise, it attempts to be as close to
L WHERE clauses as possible, with obvious exceptions for
idioms that do not exist in SQL. Just as values in SQL::Abstract are
SQL-escaped, this module does the appropriate Solr-escaping on all values
passed to the object (see C).
=head1 QUERY SYNTAX
=head2 Key-Value Pairs
The simplest way to search is with key value pairs.
my $q = WebService::Solr::Query->new( { foo => 'bar' } );
# RESULT: (foo:"bar")
=head2 Implicit AND and OR
By default, data received as a HASHREF is AND'ed together.
my $q = WebService::Solr::Query->new( { foo => 'bar', baz => 'quux' } );
# RESULT: (foo:"bar" AND baz:"quux")
Furthermore, data received as an ARRAYREF is OR'ed together.
my $q = WebService::Solr::Query->new( { foo => [ 'bar', 'baz' ] } );
# RESULT: (foo:"bar" OR foo:"baz")
=head2 Nested AND and OR
The ability to nest AND and OR boolean operators is essential to express
complex queries. The C<-and> and C<-or> prefixes have been provided for this
need.
my $q = WebService::Solr::Query->new( { foo => [
-and => { -prohibit => 'bar' }, { -require => 'baz' }
] } );
# RESULT: (((-foo:"bar") AND (+foo:"baz")))
my $q = WebService::Solr::Query->new( { foo => [
-or => { -require => 'bar' }, { -prohibit => 'baz' }
] } );
# RESULT: (((+foo:"bar") OR (-foo:"baz")))
=head2 Default Field
To search the default field, use the C<-default> prefix.
my $q = WebService::Solr::Query->new( { -default => 'bar' } );
# RESULT: ("bar")
=head2 Require/Prohibit
my $q = WebService::Solr::Query->new( { foo => { -require => 'bar' } } );
# RESULT: (+foo:"bar")
my $q = WebService::Solr::Query->new( { foo => { -prohibit => 'bar' } } );
# RESULT: (-foo:"bar")
=head2 Range
There are two types of range queries, inclusive (C<-range_inc>) and
exclusive (C<-range_exc>). The C<-range> prefix can be used in place of
C<-range_inc>.
my $q = WebService::Solr::Query->new( { foo => { -range => ['a', 'z'] } } );
# RESULT: (+foo:[a TO z])
my $q = WebService::Solr::Query->new( { foo => { -range_exc => ['a', 'z'] } } );
# RESULT: (+foo:{a TO z})
=head2 Boost
my $q = WebService::Solr::Query->new( { foo => { -boost => [ 'bar', '2.0' ] } } );
# RESULT: (foo:"bar"^2.0)
=head2 Proximity
my $q = WebService::Solr::Query->new( { foo => { -proximity => [ 'bar baz', 10 ] } } );
# RESULT: (foo:"bar baz"~10)
=head2 Fuzzy
my $q = WebService::Solr::Query->new( { foo => { -fuzzy => [ 'bar', '0.8' ] } } );
# RESULT: (foo:bar~0.8)
=head2 Literal Queries
Specifying a scalar ref as a value in a key-value pair will allow arbitrary
queries to be sent across the line. B This will bypass any data
massaging done on regular strings, thus the onus of properly escaping the
data is left to the user.
my $q = WebService::Solr::Query->new( { '*' => \'*' } )
# RESULT (*:*)
=head1 ACCESSORS
=over 4
=item * query - stores the original query structure
=back
=head1 METHODS
=head2 new( \%query )
Creates a new query object with the given hashref.
=head2 stringify( )
Converts the supplied structure into a Solr/Lucene query.
=head2 escape( $value )
The following values must be escaped in a search value:
+ - & | ! ( ) { } [ ] ^ " ~ * ? : \
B Values sent to C are automatically escaped for you.
=head2 unescape( $value )
Unescapes values escaped in C.
=head2 D
Debugging constant, default: off.
=head2 BUILDARGS
Moo method to handle input to C.
=head1 SEE ALSO
=over 4
=item * L
=item * http://wiki.apache.org/solr/SolrQuerySyntax
=back
=head1 AUTHORS
Andy Lester C
Brian Cassidy Ebricas@cpan.orgE
Jos Boumans Ekane@cpan.orgE
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
WebService-Solr-0.44/lib/WebService/Solr/Response.pm 0000644 0001017 0000764 00000012461 13606151724 021463 0 ustar alester ispc package WebService::Solr::Response;
use Moo;
use Types::Standard qw(Object HashRef Maybe InstanceOf ArrayRef);
use WebService::Solr::Document;
use Data::Page;
use Data::Pageset;
use JSON::XS ();
has 'raw_response' => (
is => 'ro',
isa => Object,
handles => {
status_code => 'code',
status_message => 'message',
is_success => 'is_success',
is_error => 'is_error'
},
);
has 'content' => ( is => 'lazy', isa => HashRef );
has 'docs' =>
( is => 'lazy', isa => ArrayRef );
around docs => sub {
my ($orig, $self, @args) = @_;
my $ret = $self->$orig(@args);
return wantarray ? @$ret : $ret;
};
has 'pager' => ( is => 'lazy', isa => Maybe[InstanceOf['Data::Page']] );
has '_pageset_slide' =>
( is => 'rw', isa => Maybe[InstanceOf['Data::Pageset']], predicate => 1 );
has '_pageset_fixed' =>
( is => 'rw', isa => Maybe[InstanceOf['Data::Pageset']], predicate => 1 );
sub BUILDARGS {
my ( $self, $res ) = @_;
return { raw_response => $res };
}
sub _build_content {
my $self = shift;
my $content = $self->raw_response->content;
return {} unless $content;
my $rv = eval { JSON::XS::decode_json( $content ) };
### JSON::XS throw an exception, but kills most of the content
### in the diagnostic, making it hard to track down the problem
die "Could not parse JSON response: $@ $content" if $@;
return $rv;
}
sub _build_docs {
my $self = shift;
my $struct = $self->content;
return unless exists $struct->{ response }->{ docs };
return [ map { WebService::Solr::Document->new( %$_ ) }
@{ $struct->{ response }->{ docs } } ];
}
sub _build_pager {
my $self = shift;
my $struct = $self->content;
return unless exists $struct->{ response }->{ numFound };
my $rows = $struct->{ responseHeader }->{ params }->{ rows };
$rows = 10 unless defined $rows;
# do not generate a pager for queries explicitly requesting no rows
return if $rows == 0;
my $pager = Data::Page->new;
$pager->total_entries( $struct->{ response }->{ numFound } );
$pager->entries_per_page( $rows );
$pager->current_page( $struct->{ response }->{ start } / $rows + 1 );
return $pager;
}
sub pageset {
my $self = shift;
my %args = @_;
my $mode = $args{ 'mode' } || 'fixed';
my $meth = "_pageset_" . $mode;
my $pred = "_has" . $meth;
### use a cached version if possible
return $self->$meth if $self->$pred;
my $pager = $self->_build_pageset( @_ );
### store the result
return $self->$meth( $pager );
}
sub _build_pageset {
my $self = shift;
my $struct = $self->content;
return unless exists $struct->{ response }->{ numFound };
my $rows = $struct->{ responseHeader }->{ params }->{ rows };
$rows = 10 unless defined $rows;
# do not generate a pager for queries explicitly requesting no rows
return if $rows == 0;
my $pager = Data::Pageset->new(
{ total_entries => $struct->{ response }->{ numFound },
entries_per_page => $rows,
current_page => $struct->{ response }->{ start } / $rows + 1,
pages_per_set => 10,
mode => 'fixed', # default, or 'slide'
@_,
}
);
return $pager;
}
sub facet_counts {
return shift->content->{ facet_counts };
}
sub spellcheck {
return shift->content->{ spellcheck };
}
sub solr_status {
return shift->content->{ responseHeader }->{ status };
}
sub ok {
my $status = shift->solr_status;
return defined $status && $status == 0;
}
no Moo;
1;
__END__
=head1 NAME
WebService::Solr::Response - Parse responses from Solr
=head1 SYNOPSIS
my $res = WebService::Solr::Response->new( $http_res );
for my $doc( $res->docs ) {
print $doc->value_for( 'id'), "\n";
}
my $pager = $res->pager;
=head1 DESCRIPTION
This class encapsulates responses from the Solr Web Service. Typically it is
used when documents are returned from a search query, though it will accept
all responses from the service.
=head1 ACCESSORS
=over 4
=item * raw_response - the raw L object.
=item * content - a hashref of deserialized JSON data from the response.
=item * docs - an array of L objects.
=item * pager - a L object for the search results.
=item * pageset - a L object for the search results. Takes the same arguments as C<< Data::Pageset->new >> does. All arguments optional.
=back
=head1 METHODS
=head2 new( $response )
Given an L object, it will parse the returned data as
required.
=head2 BUILDARGS( @args )
A Moo override to allow our custom constructor.
=head2 facet_counts( )
A shortcut to the C key in the response data.
=head2 spellcheck( )
A shortcut to the C key in the response data.
=head2 solr_status( )
Looks for the status value in the response data.
=head2 ok( )
Calls C and check that it is equal to 0.
=head1 AUTHORS
Andy Lester C
Brian Cassidy Ebricas@cpan.orgE
Kirk Beers
=head1 COPYRIGHT AND LICENSE
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
WebService-Solr-0.44/t/ 0000755 0001017 0000764 00000000000 13606152337 014044 5 ustar alester ispc WebService-Solr-0.44/t/live.t 0000644 0001017 0000764 00000000467 13535455546 015210 0 ustar alester ispc use Test::More;
use strict;
use warnings;
use WebService::Solr;
plan skip_all => '$ENV{SOLR_SERVER} not set' unless $ENV{ SOLR_SERVER };
plan tests => 2;
my $solr = WebService::Solr->new( $ENV{ SOLR_SERVER } );
isa_ok( $solr, 'WebService::Solr' );
my $r = $solr->ping;
ok( $r, 'ping()' );
done_testing();
WebService-Solr-0.44/t/request-rollback.t 0000644 0001017 0000764 00000001310 13606151724 017502 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 4;
use Test::Mock::LWP;
use XML::Simple;
use HTTP::Headers;
use WebService::Solr;
$Mock_ua->mock(
request => sub {
_test_req( @{ $_[ 1 ]->new_args } );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new;
isa_ok( $solr, 'WebService::Solr' );
$solr->rollback;
sub _test_req {
is( $_[ 2 ]->path, '/solr/update', 'rollback() path' );
is( $_[ 3 ]->header( 'Content_Type' ),
'text/xml; charset=utf-8',
'rollback() headers'
);
my $struct = XMLin( $_[ 4 ], KeepRoot => 1 );
is_deeply( $struct, { rollback => {} }, 'rollback() xml' );
}
WebService-Solr-0.44/t/query.t 0000644 0001017 0000764 00000015740 13535455546 015416 0 ustar alester ispc use Test::More tests => 7;
use strict;
use warnings;
use WebService::Solr::Query;
use Data::Dumper;
local $Data::Dumper::Sortkeys=1; # To make sure output is deterministic.
subtest 'Unescapes' => sub {
is( WebService::Solr::Query->escape( '(1+1):2' ),
'\(1\+1\)\:2', 'escape' );
is( WebService::Solr::Query->unescape( '\(1\+1\)\:2' ),
'(1+1):2', 'unescape' );
};
subtest 'Basic queries' => sub {
# default field
_check( query => { -default => 'space' }, expect => '("space")' );
_check(
query => { -default => [ 'star trek', 'star wars' ] },
expect => '(("star trek" OR "star wars"))'
);
# scalarref pass-through
_check( query => { '*' => \'*' }, expect => '(*:*)' );
# field
_check(
query => { title => 'Spaceballs' },
expect => '(title:"Spaceballs")'
);
_check(
query => { first => 'Roger', last => 'Moore' },
expect => '(first:"Roger" AND last:"Moore")'
);
_check(
query => { first => [ 'Roger', 'Dodger' ] },
expect => '((first:"Roger" OR first:"Dodger"))'
);
_check(
query => { first => [ 'Roger', 'Dodger' ], last => 'Moore' },
expect => '((first:"Roger" OR first:"Dodger") AND last:"Moore")'
);
_check(
query => [ { first => [ 'Roger', 'Dodger' ] }, { last => 'Moore' } ],
expect => '((first:"Roger" OR first:"Dodger") OR last:"Moore")'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
-default => [ 'star trek', 'star wars' ]
},
expect =>
'(("star trek" OR "star wars") AND (first:"Roger" OR first:"Dodger"))'
);
};
subtest 'Basic query with escape' => sub {
_check( query => { -default => 'sp(a)ce' }, expect => '("sp\(a\)ce")' );
_check(
query => { title => 'Spaceb(a)lls' },
expect => '(title:"Spaceb\(a\)lls")'
);
};
subtest 'Simple ops' => sub {
# range (inc)
_check(
query => { title => { -range => [ 'a', 'z' ] } },
expect => '(title:[a TO z])'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -range => [ 'a', 'z' ] }
},
expect => '((first:"Roger" OR first:"Dodger") AND title:[a TO z])'
);
# range (exc)
_check(
query => { title => { -range_exc => [ 'a', 'z' ] } },
expect => '(title:{a TO z})'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -range_exc => [ 'a', 'z' ] }
},
expect => '((first:"Roger" OR first:"Dodger") AND title:{a TO z})'
);
# boost
_check(
query => { title => { -boost => [ 'Space', '2.0' ] } },
expect => '(title:"Space"^2.0)'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -boost => [ 'Space', '2.0' ] }
},
expect => '((first:"Roger" OR first:"Dodger") AND title:"Space"^2.0)'
);
# proximity
_check(
query => { title => { -proximity => [ 'space balls', '10' ] } },
expect => '(title:"space balls"~10)'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -proximity => [ 'space balls', '10' ] }
},
expect =>
'((first:"Roger" OR first:"Dodger") AND title:"space balls"~10)'
);
# fuzzy
_check(
query => { title => { -fuzzy => [ 'space', '0.8' ] } },
expect => '(title:space~0.8)'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -fuzzy => [ 'space', '0.8' ] }
},
expect => '((first:"Roger" OR first:"Dodger") AND title:space~0.8)'
);
};
subtest 'Ops with escape' => sub {
_check(
query => { title => { -boost => [ 'Sp(a)ce', '2.0' ] } },
expect => '(title:"Sp\(a\)ce"^2.0)'
);
_check(
query => { title => { -proximity => [ 'sp(a)ce balls', '10' ] } },
expect => '(title:"sp\(a\)ce balls"~10)'
);
_check(
query => { title => { -fuzzy => [ 'sp(a)ce', '0.8' ] } },
expect => '(title:sp\(a\)ce~0.8)'
);
};
subtest 'Require and prohibit' => sub {
_check(
query => { title => { -require => 'star' } },
expect => '(+title:"star")'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -require => 'star' }
},
expect => '((first:"Roger" OR first:"Dodger") AND +title:"star")'
);
_check(
query => { title => { -prohibit => 'star' } },
expect => '(-title:"star")'
);
_check(
query => { default => { -prohibit => 'foo' } },
expect => '(-default:"foo")'
);
_check(
query => {
first => [ 'Roger', 'Dodger' ],
title => { -prohibit => 'star' }
},
expect => '((first:"Roger" OR first:"Dodger") AND -title:"star")'
);
_check(
query => {
title => [ -and => { -prohibit => 'star' }, { -prohibit => 'wars' } ],
},
expect => '(((-title:"star") AND (-title:"wars")))'
);
_check(
query => {
first => [ 'Bob' ],
title => [ -and => { -prohibit => 'star' }, { -prohibit => 'wars' } ],
},
expect => '((first:"Bob") AND ((-title:"star") AND (-title:"wars")))'
);
};
subtest 'Nested and/or operators' => sub {
_check(
query => {
title =>
[ -and => { -require => 'star' }, { -require => 'wars' } ],
},
expect => q[(((+title:"star") AND (+title:"wars")))],
);
_check(
query => {
title => [
-or => { -range_exc => [ 'a', 'c' ] },
{ -range_exc => [ 'e', 'k' ] }
],
},
expect => q[(((title:{a TO c}) OR (title:{e TO k})))],
);
};
done_testing();
sub _check {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my %t = @_;
my $expect = $t{expect};
return subtest $expect => sub {
plan tests => 5;
note(explain($t{query}));
my $q = WebService::Solr::Query->new( $t{ query } );
isa_ok( $q, 'WebService::Solr::Query' );
# GitHub issue #22 is a bug where calling $q->stringify modified
# the query in place, and so subsequent calls to $q->stringify
# would blow up. Here, we try it twice to make sure they match.
# Then, we compare the objects before and after.
my $before_dump = Dumper( $q );
my @tries;
for my $try ( 1..2 ) {
eval {
my $str = $q->stringify;
is( $str, $expect, "Stringify matches on try #$try" );
push( @tries, $str );
} or fail( "Try #$try fails with $@" );
}
is( $tries[0], $tries[1], 'Both stringifies are the same' );
my $after_dump = Dumper( $q );
is( $after_dump, $before_dump, 'Before/after dumps of the object are the same' );
};
}
WebService-Solr-0.44/t/use.t 0000644 0001017 0000764 00000000365 13535455546 015042 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 1;
use WebService::Solr;
use WebService::Solr::Field;
use WebService::Solr::Document;
use WebService::Solr::Query;
use WebService::Solr::Response;
pass( 'All modules loaded' );
done_testing();
WebService-Solr-0.44/t/request-search.t 0000644 0001017 0000764 00000001632 13606151724 017165 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 5;
use Test::Mock::LWP;
use WebService::Solr;
$Mock_ua->mock(
post => sub {
my $mock = shift;
my $uri = shift;
my $params = { @_ };
_test_req( $uri, $params );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new();
isa_ok( $solr, 'WebService::Solr' );
my ( $expect_path, $expect_params );
{
$expect_path = '/solr/select';
$expect_params = { q => 'foo', wt => 'json' };
is $solr->last_response, undef, "The last_response attribute hasn't been set yet";
$solr->search( 'foo' );
isa_ok $solr->last_response, 'WebService::Solr::Response';
}
sub _test_req {
my( $uri, $params ) = @_;
is( $uri->path, $expect_path, 'search() path' );
is_deeply( $params->{ Content }, $expect_params, 'search() params in post content' );
}
WebService-Solr-0.44/t/request-commit.t 0000644 0001017 0000764 00000002046 13606151724 017210 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 21;
use Test::Mock::LWP;
use XML::Simple;
use HTTP::Headers;
use WebService::Solr;
$Mock_ua->mock(
request => sub {
_test_req( @{ $_[ 1 ]->new_args } );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new;
isa_ok( $solr, 'WebService::Solr' );
my $opt;
for (
{},
{ waitFlush => 'true', waitSearcher => 'true' },
{ waitFlush => 'true', waitSearcher => 'false' },
{ waitFlush => 'false', waitSearcher => 'true' },
{ waitFlush => 'false', waitSearcher => 'false' },
)
{
$opt = $_;
$solr->commit( $_ );
}
sub _test_req {
is( $_[ 2 ]->path, '/solr/update', 'commit() path' );
is_deeply( { $_[ 2 ]->query_form }, { wt => 'json' }, 'commit() params' );
is( $_[ 3 ]->header( 'Content_Type' ),
'text/xml; charset=utf-8',
'commit() headers'
);
my $struct = XMLin( $_[ 4 ], KeepRoot => 1 );
is_deeply( $struct, { commit => $opt }, 'commit() xml' );
}
WebService-Solr-0.44/t/request-optimize.t 0000644 0001017 0000764 00000002116 13606151724 017556 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 21;
use Test::Mock::LWP;
use XML::Simple;
use HTTP::Headers;
use WebService::Solr;
$Mock_ua->mock(
request => sub {
_test_req( @{ $_[ 1 ]->new_args } );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new;
isa_ok( $solr, 'WebService::Solr' );
my $opt;
for (
{},
{ waitFlush => 'true', waitSearcher => 'true' },
{ waitFlush => 'true', waitSearcher => 'false' },
{ waitFlush => 'false', waitSearcher => 'true' },
{ waitFlush => 'false', waitSearcher => 'false' },
)
{
$opt = $_;
$solr->optimize( $_ );
}
sub _test_req {
is( $_[ 2 ]->path, '/solr/update', 'optimize() path' );
is_deeply(
{ $_[ 2 ]->query_form },
{ wt => 'json' },
'optimize() params'
);
is( $_[ 3 ]->header( 'Content_Type' ),
'text/xml; charset=utf-8',
'optimize() headers'
);
my $struct = XMLin( $_[ 4 ], KeepRoot => 1 );
is_deeply( $struct, { optimize => $opt }, 'optimize() xml' );
}
WebService-Solr-0.44/t/document.t 0000644 0001017 0000764 00000007612 13535455546 016066 0 ustar alester ispc use Test::More tests => 23;
use strict;
use warnings;
use WebService::Solr::Document;
use WebService::Solr::Field;
use JSON::XS;
my @fields = (
[ id => 1, { boost => 1.6 } ],
[ sku => 'A6B9A', { boost => '1.0' } ],
[ manu => 'The Bird Book', { boost => '7.1' } ],
[ weight => '4.0', { boost => 3.2 } ],
[ name => 'Sally Jesse Raphael' ],
);
my @field_objs = map { WebService::Solr::Field->new( @$_ ) } @fields;
{
my $expect = join( '',
'',
'1',
'A6B9A',
'The Bird Book',
'4.0',
'Sally Jesse Raphael',
'' );
{
my $doc = WebService::Solr::Document->new( @fields[ 0 .. 4 ] );
isa_ok( $doc, 'WebService::Solr::Document' );
$doc->boost( '3.0' );
is( $doc->to_xml, $expect, 'to_xml(), array refs' );
}
{
my $doc = WebService::Solr::Document->new( @field_objs[ 0 .. 4 ] );
isa_ok( $doc, 'WebService::Solr::Document' );
$doc->boost( '3.0' );
is( $doc->to_xml, $expect, 'to_xml(), objs' );
}
{
my $doc = WebService::Solr::Document->new();
isa_ok( $doc, 'WebService::Solr::Document' );
$doc->boost( '3.0' );
$doc->add_fields( @field_objs[ 0 .. 4 ] );
is( $doc->to_xml, $expect, 'to_xml(), add_fields()' );
}
{
my $doc = WebService::Solr::Document->new(
$field_objs[ 0 ],
@fields[ 1 .. 3 ],
$field_objs[ 4 ]
);
isa_ok( $doc, 'WebService::Solr::Document' );
$doc->boost( '3.0' );
is( $doc->to_xml, $expect, 'to_xml(), mixed' );
}
}
{
my $doc = WebService::Solr::Document->new( key => 'value' );
isa_ok( $doc, 'WebService::Solr::Document' );
is( $doc->to_xml,
'value',
'to_xml(), key=>val'
);
}
{
my $doc
= WebService::Solr::Document->new( key => 'value', $field_objs[ 0 ] );
isa_ok( $doc, 'WebService::Solr::Document' );
is( $doc->to_xml,
'value1',
'to_xml(), key=>val + obj'
);
}
{
my $doc
= WebService::Solr::Document->new( $field_objs[ 0 ], key => 'value' );
isa_ok( $doc, 'WebService::Solr::Document' );
is( $doc->to_xml,
'1value',
'to_xml(), obj + key=>val'
);
}
{
my $doc = WebService::Solr::Document->new( @field_objs[ 0 .. 4 ],
$field_objs[ 1 ] );
isa_ok( $doc, 'WebService::Solr::Document' );
{
my @values = $doc->values_for( 'id' );
is_deeply( \@values, [ 1 ], 'values_for() -- single value' );
}
{
my @values = $doc->values_for( 'sku' );
is_deeply(
\@values,
[ 'A6B9A', 'A6B9A' ],
'values_for() -- multi-value'
);
}
{
my @values = $doc->values_for( 'dne' );
is_deeply( \@values, [], 'values_for() -- no values' );
}
}
{
my $doc = WebService::Solr::Document->new( x => [ 1, 2, 3 ] );
isa_ok( $doc, 'WebService::Solr::Document' );
is( scalar @{ $doc->fields }, 3, 'arrayref of values to fields' );
}
{
my $doc = WebService::Solr::Document->new( @fields[ 0 .. 4 ] );
is_deeply(
[ sort( $doc->field_names ) ],
[ qw(id manu name sku weight) ],
'field_names'
);
}
{
my $doc = WebService::Solr::Document->new(
bools => decode_json( q/{"arr": [true,false,true]}/ )->{ arr } );
isa_ok( $doc, 'WebService::Solr::Document' );
is_deeply(
[ 1, 0, 1 ],
[ $doc->values_for( 'bools' ) ],
'boolean arrays'
);
}
WebService-Solr-0.44/t/field.t 0000644 0001017 0000764 00000002565 13535455546 015335 0 ustar alester ispc use Test::More tests => 9;
use strict;
use warnings;
use WebService::Solr::Field;
{
my $f = WebService::Solr::Field->new( id => '0001' );
my $expected = '0001';
is( $f->to_xml, $expected, 'to_xml(), default attrs' );
}
{
my $f = WebService::Solr::Field->new( id => '0001', { boost => 3 } );
my $expected = '0001';
is( $f->to_xml, $expected, 'to_xml(), all attrs' );
}
{
my $f = WebService::Solr::Field->new( id => '0001', { boost => 3.1 } );
my $expected = '0001';
is( $f->to_xml, $expected, 'to_xml(), all attrs, float for boost' );
}
{
my $f = eval { WebService::Solr::Field->new( undef() => '0001' ) };
ok( !defined $f, 'name required' );
ok( $@, 'name required' );
}
{
my $f = eval { WebService::Solr::Field->new( id => undef ) };
ok( !defined $f, 'value required' );
ok( $@, 'value required' );
}
# XML escaping
{
my $f = WebService::Solr::Field->new( foo => 'This & That' );
my $expected = 'This & That';
is( $f->to_xml, $expected, 'to_xml(), escaped (1)' );
}
{
my $f = WebService::Solr::Field->new( foo => 'This & That' );
my $expected = 'This & That';
is( $f->to_xml, $expected, 'to_xml(), escaped (2)' );
}
WebService-Solr-0.44/t/response.t 0000644 0001017 0000764 00000004623 13535455546 016105 0 ustar alester ispc use strict;
use warnings;
### XXX Whitebox tests!
use Test::More tests => 5;
use HTTP::Headers;
use HTTP::Response;
use WebService::Solr::Response;
my $Class = 'WebService::Solr::Response';
# $r = HTTP::Response->new( $code, $msg, $header, $content )
my $SolrResponse = HTTP::Response->new(
200 => 'OK',
HTTP::Headers->new,
q[{"responseHeader":{"status":0,"QTime":24,"params":{"rows":"2","sort":"created_dt desc","wt":"json","start":"4","q":"foo"}},"response":{"numFound":10,"start":4,"docs":[{"name":["foo1"]},{"name":["foo2"]}]}}],
);
my $Obj;
subtest 'Create tests' => sub {
ok( $SolrResponse, 'Created dummy Solr response' );
$Obj = $Class->new( $SolrResponse );
ok( $Obj, " Created $Class object from $SolrResponse" );
isa_ok( $Obj, $Class );
};
subtest 'Check accessors' => sub {
ok( $Obj, 'Testing accessors' );
for my $acc (
qw[status_code status_message is_success is_error content docs pager pageset]
)
{
ok( $Obj->can( $acc ), " Obj->can( $acc )" );
ok( defined $Obj->$acc, " Value = " . $Obj->$acc );
}
};
subtest 'Check docs' => sub {
for my $doc ( $Obj->docs ) {
ok( $doc, "Testing $doc" );
isa_ok( $doc, 'WebService::Solr::Document' );
like( $doc->value_for( 'name' ),
qr/foo/, " Name = " . $doc->value_for( 'name' ) );
}
};
subtest 'Check pagers' => sub {
for my $pager ( $Obj->pager, $Obj->pageset,
$Obj->pageset( mode => 'fixed' ) )
{
ok( $pager, "Pager retrieved: $pager" );
is( $pager->total_entries, 10, " Total entries = 10" );
is( $pager->entries_per_page, 2, " Entries per page = 2" );
is( $pager->first_page, 1, " First page = 1" );
is( $pager->last_page, 5, " Last page = 5" );
is( $pager->current_page, 3, " Current page = 2" );
}
};
subtest 'Special case: 0 rows' => sub {
my $http_response = HTTP::Response->new(
200 => 'OK',
HTTP::Headers->new,
q[{"responseHeader":{"status":0,"QTime":1,"params":{"facet.mincount":"1","q":"*:*","facet.field":"tags","wt":"json","rows":"0"}},"response":{"numFound":220,"start":0,"docs":[]}}],
);
my $solr_response = $Class->new( $http_response );
ok( !defined $solr_response->pager, '0 rows, undef pager' );
ok( !defined $solr_response->pageset, '0 rows, undef pageset' );
};
done_testing();
WebService-Solr-0.44/t/request-ping.t 0000644 0001017 0000764 00000001176 13606151724 016660 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 4;
use Test::Mock::LWP;
use WebService::Solr;
$Mock_ua->mock(
get => sub {
_test_req( $_[ 1 ] );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new();
isa_ok( $solr, 'WebService::Solr' );
my $expect;
{
$expect = 'http://localhost:8983/solr/admin/ping';
is $solr->last_response, undef, "The last_response attribute hasn't been set yet";
$solr->ping();
isa_ok $solr->last_response, 'WebService::Solr::Response';
}
sub _test_req {
is( $_[ 0 ], $expect, 'ping() url' );
}
WebService-Solr-0.44/t/pod.t 0000644 0001017 0000764 00000000233 13535455546 015022 0 ustar alester ispc use strict;
use warnings;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();
WebService-Solr-0.44/t/request-add.t 0000644 0001017 0000764 00000002146 13606151724 016451 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 11;
use Test::Mock::LWP;
use XML::Simple;
use HTTP::Headers;
use WebService::Solr;
$Mock_ua->mock(
request => sub {
_test_req( @{ $_[ 1 ]->new_args } );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new( undef, { autocommit => 0 } );
isa_ok( $solr, 'WebService::Solr' );
my $expect;
{
is $solr->last_response, undef, "The last_response attribute hasn't been set yet";
$expect = { doc => { field => { name => 'foo', content => 'bar' } } };
$solr->add( { foo => 'bar' } );
isa_ok $solr->last_response, 'WebService::Solr::Response';
$solr->update( { foo => 'bar' } );
}
sub _test_req {
is( $_[ 2 ]->path, '/solr/update', 'add() path' );
is_deeply( { $_[ 2 ]->query_form }, { wt => 'json' }, 'add() params' );
is_deeply(
$_[ 3 ]->header( 'Content_Type' ),
'text/xml; charset=utf-8',
'add() headers'
);
my $struct = XMLin( $_[ 4 ], KeepRoot => 1 );
is_deeply( $struct, { add => $expect }, 'add/update xml' );
}
WebService-Solr-0.44/t/request-delete.t 0000644 0001017 0000764 00000002173 13606151724 017163 0 ustar alester ispc use strict;
use warnings;
use Test::More tests => 17;
use Test::Mock::LWP;
use XML::Simple;
use HTTP::Headers;
use WebService::Solr;
$Mock_ua->mock(
request => sub {
_test_req( @{ $_[ 1 ]->new_args } );
return HTTP::Response->new;
}
);
$Mock_response->mock( is_error => sub { return 0 } );
my $solr = WebService::Solr->new( undef, { autocommit => 0 } );
isa_ok( $solr, 'WebService::Solr' );
my $expect;
{
$expect = { id => 1234 };
$solr->delete_by_id( 1234 );
}
{
$expect = { query => 'name:DDR' };
$solr->delete_by_query( 'name:DDR' );
}
{
$expect = { query => 'foo', id => 13 };
$solr->delete( $expect );
}
{
$expect = { query => [ qw( foo bar ) ], id => [ 13, 42 ] };
$solr->delete( $expect );
}
sub _test_req {
is( $_[ 2 ]->path, '/solr/update', 'delete() path' );
is_deeply( { $_[ 2 ]->query_form }, { wt => 'json' }, 'delete() params' );
is( $_[ 3 ]->header( 'Content_Type' ),
'text/xml; charset=utf-8',
'delete() headers'
);
my $struct = XMLin( $_[ 4 ], KeepRoot => 1 );
is_deeply( $struct, { delete => $expect }, 'delete() xml' );
}
WebService-Solr-0.44/t/pod_coverage.t 0000644 0001017 0000764 00000000277 13535455546 016705 0 ustar alester ispc use strict;
use warnings;
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
if $@;
all_pod_coverage_ok();
WebService-Solr-0.44/Changes 0000644 0001017 0000764 00000010257 13606152174 015100 0 ustar alester ispc Revision history for Perl extension WebService::Solr.
0.44 Fri Jan 10 13:29:02 CST 2020
- No code changes.
- Fixed URL for the issue tracker.
- Updated directories to get response tests to run.
0.42 Tue Apr 25 16:59:02 CDT 2017
- No changes since 0.41_01
0.41_01 Wed Apr 19 17:21:29 CDT 2017
- No functionality changes.
- Added a missing Carp. Thanks, Luke Closs.
- Stopped using Module::Install and switched to ExtUtils::MakeMaker
0.40 Wed Dec 11 21:32:17 CST 2017
- No functionality changes.
- New maintainer: Andy Lester
- Big jump in version number to show a new numbering scheme.
0.24_01 Fri Dec 9 22:45:03 CST 2016 *DEVELOPER RELEASE*
- Switch from the deprecated Any::Moose to Moo + Types::Standard.
Thanks, ilmari.
# Before this point, Brian Cassidy was the maintainer. The version
numbering scheme was different from what it is now.
0.23 2014-02-07 16:58
- Fix a bug in Webservice::Solr::Query::stringify() where it would
sometimes modify the query argument structure passed in. This would
make subsequent calls to stringify be broken and wrong, or even blow up.
- The ::Query module no longer loads Data::Dumper automatically.
0.22 2013-04-02 17:03
- Speed up ->value_for() to lazily find the first field, rather than
processing all of ->values_for() and taking the first value.
0.21 2012-11-29
- Get rid of use_ok() in the tests.
- Minor documentation fixes.
0.20 2012-11-29
- Avoid random hash key ordering issues (perl 5.17.6) when testing
WebService::Solr::Query (RT #81527)
0.19 2012-05-25
- Merge default_params in with other params in the post body
0.18 2012-05-24
- Force previous switch to a post request to be utf-8 encoded
0.17 2012-03-29
- Changed the solr search to use a post request (Robert Ward)
0.16 2011-10-11
- Switch to Any::Moose so that Mouse may be used (Kevin Goess)
0.15 2011-07-14
- Add a last_response accessor to get the most recent
WebService::Solr::Response object (Dan Brook)
0.14 2011-06-13
- Fix broken logic for figuring out rows per page when not explicitly
specified. It was broken on the last page when the number of rows
returned was less than the default. We now just assume 10 rows which
is the default in Solr.
0.13 2011-05-05
- Replace XML::Generator with XML::Easy and de-mooseify the Document and
Field classes to help speed up (about 3x) document creation and
serialization.
0.12 2011-04-12
- Clean up docs in relation to autocommit
- Handle blessed field values (Dan Brook)
0.11 2010-10-27
- Add a note about enabling Keep-Alive connections (Stijn Prompers)
- Add field_names method to Document (Cory Watson, Craig Hall)
0.10 2010-03-17
- Add spellcheck() convenience method to Response object
- Fix exception when response contained no documents
0.09 2009-12-04
- Return undef in pager/pageset special case when we explicitly return 0
rows
- Add rollback() from Solr 1.4
- Add generic delete() from Solr 1.4
- Update docs to match Solr 1.4 options
- Fix ping() to check only the HTTP status
0.08 2009-10-14
- Allow scalar ref value in WebService::Solr::Query, which works like
SQL::Abstract (literal query)
- Fix status_message and status_code in Response
- Add Data::Pageset capabilities to Response (Jos Boumans)
- Ensure compatibility with older versions of Encode by making sure we
pass a string to encode() (Gert Brinkmann)
0.07 2009-06-26
- Trap JSON::XS exceptions (Jos Boumans)
- Provide an abstract query generator: WebService::Solr::Query (Jos
Boumans, Brian Cassidy)
0.06 2009-05-07
- Add auto_suggest to hit the new Solr 1.4 /autoSuggest API (RT #45798)
- Refactor a basic GET request into its own public method
(generic_solr_request)
0.05 2009-04-13
- Confess upon HTTP error (Leon Brocard)
- Send UTF-8 requests to keep new LWP happy (Leon Brocard)
0.04 2009-03-02
- add make_immutable to Solr.pm
- be paranoid about XML escaping (Gert Brinkmann)
0.03 2009-01-15
- fix typo (Thanks cog)
- pod fixes
- try to work around old LWP versions when setting HTTP headers
- require URI >= 1.28
- require XML::Generator >= 0.94
0.02 2008-10-09
- fix pager creation, missing prereq
- add a simple facet_counts() shortcut method
0.01 2008-10-07
- original version;
WebService-Solr-0.44/README.md 0000644 0001017 0000764 00000000604 13606151724 015057 0 ustar alester ispc # WebService::Solr
WebService::Solr is a Perl module to interface with the Solr web service.
To install:
perl Makefile.PL
make
make test
make install
# Copyright & License
Copyright 2008-2014 National Adult Literacy Database
Copyright 2015-2020 Andy Lester
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
WebService-Solr-0.44/MANIFEST 0000644 0001017 0000764 00000001076 13606152340 014730 0 ustar alester ispc Changes
MANIFEST
Makefile.PL
README.md
lib/WebService/Solr.pm
lib/WebService/Solr/Document.pm
lib/WebService/Solr/Field.pm
lib/WebService/Solr/Query.pm
lib/WebService/Solr/Response.pm
t/document.t
t/field.t
t/live.t
t/pod.t
t/pod_coverage.t
t/query.t
t/request-add.t
t/request-commit.t
t/request-delete.t
t/request-optimize.t
t/request-ping.t
t/request-rollback.t
t/request-search.t
t/response.t
t/use.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
WebService-Solr-0.44/Makefile.PL 0000644 0001017 0000764 00000002500 13606151724 015547 0 ustar alester ispc package main;
require 5.008;
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %parms = (
NAME => 'WebService::Solr',
AUTHOR => 'Andy Lester ',
ABSTRACT => 'Interface to the Solr search engine',
VERSION_FROM => 'lib/WebService/Solr.pm',
LICENSE => 'perl_5',
MIN_PERL_VERSION => 5.008,
META_MERGE => {
resources => {
homepage => 'https://github.com/petdance/webservice-solr',
bugtracker => 'https://github.com/petdance/webservice-solr/issues',
repository => 'git@github.com:petdance/webservice-solr.git',
},
},
PREREQ_PM => {
'Data::Page' => 0,
'Data::Pageset' => 0,
'Encode' => 0,
'JSON::XS' => 0,
'LWP::UserAgent' => 0,
'Moo' => 0,
'Types::Standard' => '0.008', # InstanceOf type constraint
'URI' => '1.28',
'XML::Easy' => 0,
# Testing requirements
'Test::Mock::LWP' => '0.05',
'Test::More' => '0.94', # want note(), explain(), subtest() and done_testing()
'XML::Simple' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
);
WriteMakefile( %parms );
WebService-Solr-0.44/META.yml 0000644 0001017 0000764 00000001631 13606152340 015045 0 ustar alester ispc ---
abstract: 'Interface to the Solr search engine'
author:
- 'Andy Lester '
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.16, CPAN::Meta::Converter version 2.150005'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: WebService-Solr
no_index:
directory:
- t
- inc
requires:
Data::Page: '0'
Data::Pageset: '0'
Encode: '0'
JSON::XS: '0'
LWP::UserAgent: '0'
Moo: '0'
Test::Mock::LWP: '0.05'
Test::More: '0.94'
Types::Standard: '0.008'
URI: '1.28'
XML::Easy: '0'
XML::Simple: '0'
perl: '5.008'
resources:
bugtracker: https://github.com/petdance/webservice-solr/issues
homepage: https://github.com/petdance/webservice-solr
version: '0.44'
x_serialization_backend: 'CPAN::Meta::YAML version 0.012'
WebService-Solr-0.44/META.json 0000644 0001017 0000764 00000002770 13606152340 015222 0 ustar alester ispc {
"abstract" : "Interface to the Solr search engine",
"author" : [
"Andy Lester "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.16, CPAN::Meta::Converter version 2.150005",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "WebService-Solr",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Data::Page" : "0",
"Data::Pageset" : "0",
"Encode" : "0",
"JSON::XS" : "0",
"LWP::UserAgent" : "0",
"Moo" : "0",
"Test::Mock::LWP" : "0.05",
"Test::More" : "0.94",
"Types::Standard" : "0.008",
"URI" : "1.28",
"XML::Easy" : "0",
"XML::Simple" : "0",
"perl" : "5.008"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/petdance/webservice-solr/issues"
},
"homepage" : "https://github.com/petdance/webservice-solr"
},
"version" : "0.44",
"x_serialization_backend" : "JSON::PP version 2.27400"
}