Optionally parse with JSON::PP

lib/WebService/Solr.pm

@@ -15,6 +15,12 @@ use XML::Easy::Content;
 use XML::Easy::Text ();
 use Carp qw(confess);
 
+has 'PP' => (
+    is      => 'ro',
+    isa     => Bool,
+    default => 0
+);
+
 has 'url' => (
     is      => 'ro',
     isa     => InstanceOf['URI'],
@@ -198,7 +204,7 @@ sub _send_update {
         confess($http_response->status_line . ': ' . $http_response->content);
     }
 
-    $self->last_response( WebService::Solr::Response->new( $http_response ) );
+    $self->last_response( WebService::Solr::Response->new( $http_response, (PP=>$self->{PP}) ) );
 
     $self->commit if $autocommit;
 
@@ -244,6 +250,8 @@ enterprise-grade indexing and searching platform.
 
 =item * last_response - stores a WebService::Solr::Response for the last request
 
+=item * PP - a boolean value for using JSON::PP instead of the default JSON::XS for parsing Solr responses (default: disabled)
+
 =back
 
 =head1 HTTP KEEP-ALIVE

lib/WebService/Solr/Response.pm

@@ -2,11 +2,18 @@ package WebService::Solr::Response;
 
 use Moo;
 
-use Types::Standard qw(Object HashRef Maybe InstanceOf ArrayRef);
+use Types::Standard qw(Object HashRef Maybe InstanceOf ArrayRef Bool);
 use WebService::Solr::Document;
 use Data::Page;
 use Data::Pageset;
 use JSON::XS ();
+use JSON::PP ();
+
+has 'PP' => (
+    is      => 'ro',
+    isa     => Bool,
+    default => 0
+);
 
 has 'raw_response' => (
     is      => 'ro',
@@ -38,15 +45,19 @@ has '_pageset_fixed' =>
     ( is => 'rw', isa => Maybe[InstanceOf['Data::Pageset']], predicate => 1 );
 
 sub BUILDARGS {
-    my ( $self, $res ) = @_;
-    return { raw_response => $res };
+    my ( $self, $res, %options ) = @_;
+    return { raw_response => $res, %options };
 }
 
 sub _build_content {
     my $self    = shift;
     my $content = $self->raw_response->content;
     return {} unless $content;
-    my $rv = eval { JSON::XS::decode_json( $content ) };
+    my $rv;
+    if($self->{PP})
+    { $rv = eval { JSON::PP::decode_json( $content ) }; }
+    else
+    { $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

t/request/add_pp.t

@@ -0,0 +1,44 @@
+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, PP=>1 } );
+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' );
+}
+

t/request/commit_pp.t

@@ -0,0 +1,46 @@
+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(undef, { PP => 1 } );
+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' );
+}
+
+

t/request/delete_pp.t

@@ -0,0 +1,53 @@
+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, PP => 1 } );
+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' );
+}

t/request/optimize_pp.t

@@ -0,0 +1,49 @@
+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(undef, { PP => 1 } );
+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' );
+}
+

t/request/ping_pp.t

@@ -0,0 +1,31 @@
+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(undef, { PP => 1 } );
+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' );
+}

t/request/rollback_pp.t

@@ -0,0 +1,31 @@
+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(undef, { PP => 1 } );
+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' );
+}

t/request/search_pp.t

@@ -0,0 +1,37 @@
+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(undef, { PP => 1 } );
+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' );
+}