File Coverage

blib/lib/WebService/Solr.pm

Criterion	Covered	Total	%
statement	42	114	36.8
branch	0	20	0.0
condition	0	14	0.0
subroutine	14	29	48.2
pod	13	13	100.0
total	69	190	36.3

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.41_01';

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__