r45836 - in /branches/upstream/libwebservice-solr-perl/current: Changes MANIFEST META.yml Makefile.PL README lib/WebService/Solr.pm lib/WebService/Solr/Query.pm lib/WebService/Solr/Response.pm t/query.t t/response.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Oct 15 15:46:03 UTC 2009
Author: jawnsy-guest
Date: Thu Oct 15 15:45:56 2009
New Revision: 45836
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45836
Log:
[svn-upgrade] Integrating new upstream version, libwebservice-solr-perl (0.08)
Added:
branches/upstream/libwebservice-solr-perl/current/t/response.t
Modified:
branches/upstream/libwebservice-solr-perl/current/Changes
branches/upstream/libwebservice-solr-perl/current/MANIFEST
branches/upstream/libwebservice-solr-perl/current/META.yml
branches/upstream/libwebservice-solr-perl/current/Makefile.PL
branches/upstream/libwebservice-solr-perl/current/README
branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr.pm
branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Query.pm
branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Response.pm
branches/upstream/libwebservice-solr-perl/current/t/query.t
Modified: branches/upstream/libwebservice-solr-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/Changes?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/Changes (original)
+++ branches/upstream/libwebservice-solr-perl/current/Changes Thu Oct 15 15:45:56 2009
@@ -1,4 +1,12 @@
Revision history for Perl extension WebService::Solr.
+
+0.08 Wed Oct 14 2009
+ - 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 Fri Jun 26 2009
- Trap JSON::XS exceptions (Jos Boumans)
Modified: branches/upstream/libwebservice-solr-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/MANIFEST?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/MANIFEST (original)
+++ branches/upstream/libwebservice-solr-perl/current/MANIFEST Thu Oct 15 15:45:56 2009
@@ -28,4 +28,5 @@
t/request/optimize.t
t/request/ping.t
t/request/search.t
+t/response.t
t/use.t
Modified: branches/upstream/libwebservice-solr-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/META.yml?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/META.yml (original)
+++ branches/upstream/libwebservice-solr-perl/current/META.yml Thu Oct 15 15:45:56 2009
@@ -22,6 +22,8 @@
- t
requires:
Data::Page: 0
+ Data::Pageset: 0
+ Encode: 0
JSON::XS: 0
LWP::UserAgent: 0
Moose: 0
@@ -31,4 +33,4 @@
resources:
license: http://dev.perl.org/licenses/
repository: http://github.com/bricas/webservice-solr
-version: 0.07
+version: 0.08
Modified: branches/upstream/libwebservice-solr-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/Makefile.PL?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/Makefile.PL (original)
+++ branches/upstream/libwebservice-solr-perl/current/Makefile.PL Thu Oct 15 15:45:56 2009
@@ -12,9 +12,11 @@
requires 'LWP::UserAgent';
requires 'URI' => '1.28';
requires 'Data::Page';
+requires 'Data::Pageset';
requires 'XML::Generator' => '0.94';
requires 'JSON::XS';
requires 'Moose';
+requires 'Encode';
test_requires 'Test::More';
test_requires 'XML::Simple';
Modified: branches/upstream/libwebservice-solr-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/README?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/README (original)
+++ branches/upstream/libwebservice-solr-perl/current/README Thu Oct 15 15:45:56 2009
@@ -4,8 +4,8 @@
SYNOPSIS
my $solr = WebService::Solr->new;
$solr->add( @docs );
-
- my $response = $solr->search( $query );
+
+ my $response = $solr->search( $query );
for my $doc ( $response->docs ) {
print $doc->value_for( $id );
}
Modified: branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr.pm?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr.pm (original)
+++ branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr.pm Thu Oct 15 15:45:56 2009
@@ -28,7 +28,7 @@
default => sub { { wt => 'json' } }
);
-our $VERSION = '0.07';
+our $VERSION = '0.08';
sub BUILDARGS {
my ( $self, $url, $options ) = @_;
@@ -150,7 +150,7 @@
my $req = HTTP::Request->new(
POST => $url,
HTTP::Headers->new( Content_Type => 'text/xml; charset=utf-8' ),
- '<?xml version="1.0" encoding="UTF-8"?>' . encode('utf8', $xml)
+ '<?xml version="1.0" encoding="UTF-8"?>' . encode('utf8', "$xml")
);
my $http_response = $self->agent->request($req);
Modified: branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Query.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Query.pm?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Query.pm (original)
+++ branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Query.pm Thu Oct 15 15:45:56 2009
@@ -134,9 +134,16 @@
}
sub _value_SCALAR {
- my ( $self, $k, $v ) = @_;
- $v = $self->escape( $v );
- my $r = qq($k:"$v");
+ 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");
@@ -308,14 +315,14 @@
complex queries. The C<-and> and C<-or> prefixes have been provided for this
need.
- my $q = WebService::Solr::Query->new( foo => [
+ 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 => [
+ my $q = WebService::Solr::Query->new( { foo => [
-or => { -require => 'bar' }, { -prohibit => 'baz' }
- ] );
+ ] } );
# RESULT: (((+foo:"bar") OR (-foo:"baz")))
=head2 Default Field
@@ -327,10 +334,10 @@
=head2 Require/Prohibit
- my $q = WebService::Solr::Query->new( foo => { -require => 'bar' } );
+ my $q = WebService::Solr::Query->new( { foo => { -require => 'bar' } } );
# RESULT: (+foo:"bar")
- my $q = WebService::Solr::Query->new( foo => { -prohibit => 'bar' } );
+ my $q = WebService::Solr::Query->new( { foo => { -prohibit => 'bar' } } );
# RESULT: (-foo:"bar")
=head2 Range
@@ -339,31 +346,41 @@
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'] } );
+ 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'] } );
+ 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' ] } );
+ 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 ] } );
+ 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' ] } );
+ my $q = WebService::Solr::Query->new( { foo => { -fuzzy => [ 'bar', '0.8' ] } } );
# RESULT: (foo:bar~0.8)
=head2 Boost
- my $q = WebService::Solr::Query->new( foo => { -boost => [ 'bar', '2.0' ] } );
+ my $q = WebService::Solr::Query->new( { foo => { -boost => [ 'bar', '2.0' ] } } );
# RESULT: (foo:"bar"^2.0)
+
+=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<NB:> 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
Modified: branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Response.pm?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Response.pm (original)
+++ branches/upstream/libwebservice-solr-perl/current/lib/WebService/Solr/Response.pm Thu Oct 15 15:45:56 2009
@@ -4,12 +4,18 @@
use WebService::Solr::Document;
use Data::Page;
+use Data::Pageset;
use JSON::XS ();
has 'raw_response' => (
is => 'ro',
isa => 'Object',
- handles => [ qw( status_code status_message is_success is_error ) ]
+ handles => {
+ status_code => 'code',
+ status_message => 'message',
+ is_success => 'is_success',
+ is_error => 'is_error'
+ },
);
has 'content' => ( is => 'rw', isa => 'HashRef', lazy_build => 1 );
@@ -18,6 +24,9 @@
( is => 'rw', isa => 'ArrayRef', auto_deref => 1, lazy_build => 1 );
has 'pager' => ( is => 'rw', isa => 'Data::Page', lazy_build => 1 );
+
+has '_pageset_slide' => ( is => 'rw', isa => 'Data::Pageset', lazy_build => 1 );
+has '_pageset_fixed' => ( is => 'rw', isa => 'Data::Pageset', lazy_build => 1 );
sub BUILDARGS {
my ( $self, $res ) = @_;
@@ -63,6 +72,42 @@
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 possilbe
+ 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 };
+ my $pager = Data::Pageset->new({
+ total_entries => $struct->{ response }->{ numFound },
+ entries_per_page => $rows || 10,
+ current_page => do { $struct->{ response }->{ start } / $rows + 1 },
+ pages_per_set => 10,
+ mode => 'fixed', # default, or 'slide'
+ @_,
+ });
+
+ return $pager;
+}
+
sub facet_counts {
return shift->content->{ facet_counts };
}
@@ -114,6 +159,8 @@
=item * pager - a L<Data::Page> object for the search results.
+=item * pageset - a L<Data::Pageset> object for the search results. Takes the same arguments as C<< Data::Pageset->new >> does. All arguments optional.
+
=back
=head1 METHODS
Modified: branches/upstream/libwebservice-solr-perl/current/t/query.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/t/query.t?rev=45836&op=diff
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/t/query.t (original)
+++ branches/upstream/libwebservice-solr-perl/current/t/query.t Thu Oct 15 15:45:56 2009
@@ -22,6 +22,9 @@
expect => '(("star trek" OR "star wars"))'
);
+ # scalarref pass-through
+ _check( query => { '*' => \'*' }, expect => '(*:*)' );
+
# field
_check(
query => { title => 'Spaceballs' },
Added: branches/upstream/libwebservice-solr-perl/current/t/response.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwebservice-solr-perl/current/t/response.t?rev=45836&op=file
==============================================================================
--- branches/upstream/libwebservice-solr-perl/current/t/response.t (added)
+++ branches/upstream/libwebservice-solr-perl/current/t/response.t Thu Oct 15 15:45:56 2009
@@ -1,0 +1,61 @@
+use strict;
+use warnings;
+
+### XXX Whitebox tests!
+use Test::More 'no_plan';
+
+use Data::Dumper;
+use HTTP::Headers;
+use HTTP::Response;
+
+my $Class = 'WebService::Solr::Response';
+use_ok( $Class );
+
+# $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;
+### create tests
+{ ok( $SolrResponse, "Created dummy Solr response" );
+
+ $Obj = $Class->new( $SolrResponse );
+ ok( $Obj, " Created $Class object from $SolrResponse" );
+ isa_ok( $Obj, $Class, " Object" );
+}
+
+### check accessors
+{ 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 );
+ }
+}
+
+### check docs
+{ for my $doc ( $Obj->docs ) {
+ ok( $doc, "Testing $doc" );
+ isa_ok( $doc, 'WebService::Solr::Document',
+ " Object" );
+
+ like( $doc->value_for('name'), qr/foo/,
+ " Name = " . $doc->value_for('name') );
+ }
+}
+
+### check pagers
+{ 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" );
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list