File Coverage

blib/lib/WebService/Solr/Response.pm

Criterion	Covered	Total	%
statement	66	68	97.0
branch	14	20	70.0
condition	3	5	60.0
subroutine	15	17	88.2
pod	6	6	100.0
total	104	116	89.6

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__