Apache-Solr

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

lib/Apache/Solr/Document.pm
lib/Apache/Solr/Document.pod
lib/Apache/Solr/JSON.pm
lib/Apache/Solr/JSON.pod
lib/Apache/Solr/Result.pm
lib/Apache/Solr/Result.pod
lib/Apache/Solr/Tables.pm
lib/Apache/Solr/XML.pm
lib/Apache/Solr/XML.pod
t/01use.t
t/10endpoint.t
t/11expand.t
t/12facet.t
t/20xml.t
t/21json.t
t/30result.t
t/31sequential.t
t/32version.t
t/a.pdf
META.yml                                 Module YAML meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

lib/Apache/Solr.pm  view on Meta::CPAN

}

sub _extract($) { panic "not implemented" }

#-------------------------

sub _core_admin($@)
{	my ($self, $action, $params) = @_;
	$params->{core} ||= $self->core;
	
	my $endpoint = $self->endpoint('cores', core => 'admin', params => $params);
	my @params   = %$params;
	my $result   = Apache::Solr::Result->new(params => [ %$params ], endpoint => $endpoint, core => $self);

	$self->request($endpoint, $result);
	$result;
}


sub coreStatus(%)
{	my ($self, %args) = @_;
	$self->_core_admin('STATUS', \%args);
}


lib/Apache/Solr.pm  view on Meta::CPAN


sub removed($)
{	my ($self, $msg) = @_;
	return if $self->{AS_rem_msg}{$msg}++;  # report only once
	warning __x"Removed solr {message}", message => $msg;
}


#------------------------

sub endpoint($@)
{	my ($self, $action, %args) = @_;
	my $core = $args{core} || $self->core;
	my $take = $self->server->clone;    # URI
	$take->path($take->path . (defined $core ? "/$core" : '') . "/$action");

	# make parameters ordered
	my $params = $args{params} || [];
	$params	= [ %$params ] if ref $params eq 'HASH';
	@$params or return $take;

lib/Apache/Solr.pod  view on Meta::CPAN


Produce a warning $message about parameters which will not be passed on,
because they were removed from the indicated server version.

=back

=head3 Other helpers

=over 4

=item $obj-E<gt>B<endpoint>($action, %options)

Compute the address to be called (for HTTP)

 -Option--Default
  core    new(core)
  params  []

=over 2

=item core => NAME

lib/Apache/Solr/JSON.pm  view on Meta::CPAN


sub json() {shift->{ASJ_json}}

#--------------------------

sub _select($$)
{	my ($self, $args, $params) = @_;

	# select may be called more than once, but do not add wt each time
	# again.
	my $endpoint = $self->endpoint('select', params => $params);
	my $result   = Apache::Solr::Result->new(%$args, params => $params, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result);

	if(my $dec = $result->decoded)
	{	# JSON uses different names!
		my $r = $dec->{result} = delete $dec->{response};
		$r->{doc} = delete $r->{docs};
	}
	$result;
}

sub _extract($$$)
{	my ($self, $params, $data, $ct) = @_;
	my $endpoint = $self->endpoint('update/extract', params => $params);
	my $result   = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result, $data, $ct);
	$result;
}

sub _add($$$)
{	my ($self, $docs, $attrs, $params) = @_;
	$attrs   ||= {};
	$params  ||= [];

	my $sv = $self->serverVersion;
	$sv ge '3.1' or error __x"Solr version too old for updates in JSON syntax";

	# We cannot create HASHes with twice the same key in Perl, so cannot
	# produce the syntax for adding multiple documents.  Try to save it.
	delete $attrs->{boost}
		if $attrs->{boost} && $attrs->{boost}==1.0;

	$params = +{ @$params } if ref $params eq 'ARRAY';
	exists $attrs->{$_} && ($params->{$_} = delete $attrs->{$_})
		for qw/commit commitWithin overwrite boost/;

	my $endpoint = $self->endpoint(($sv lt '4.0' ? 'update/json' : 'update'), params => $params);
	my $result   = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);

	my $add;
	if(@$docs==1)
	{	$add = +{ add => +{ %$attrs, doc => $self->_doc2json($docs->[0]) } }
	}
	elsif(keys %$attrs)
	{	# in combination with attributes only
		error __x"Unable to add more than one doc with JSON interface";
	}
	else
	{	$add = [ map $self->_doc2json($_), @$docs ];
	}

	$self->request($endpoint, $result, $add);
	$result;
}

sub _doc2json($)
{	my ($self, $this) = @_;
	my %doc;
	foreach my $fieldname ($this->fieldNames)
	{	my @f;
		foreach my $field ($this->fields($fieldname))
		{	my $update = $field->{update} || 'value';

lib/Apache/Solr/JSON.pm  view on Meta::CPAN

	\%doc;
}

sub _commit($)   { my ($s, $attr) = @_; $s->simpleUpdate(commit   => $attr) }
sub _optimize($) { my ($s, $attr) = @_; $s->simpleUpdate(optimize => $attr) }
sub _delete($$)  { my $self = shift; $self->simpleUpdate(delete   => @_) }
sub _rollback()  { shift->simpleUpdate('rollback') }

sub _terms($)
{	my ($self, $terms) = @_;
	my $endpoint = $self->endpoint('terms', params => $terms);
	my $result   = Apache::Solr::Result->new(params => $terms, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result);

	my $table = $result->decoded->{terms} || {};
	$table    = {@$table} if ref $table eq 'ARRAY';  # bug in Solr 1.4

	while(my ($field, $terms) = each %$table)
	{	# repack array-of-pairs into array-of-arrays-of-pair
		my @pairs = @$terms;
		my @terms; 
		push @terms, [shift @pairs, shift @pairs] while @pairs;
		$result->terms($field => \@terms);

lib/Apache/Solr/JSON.pm  view on Meta::CPAN

}


sub simpleUpdate($$;$)
{	my ($self, $command, $attrs, $content) = @_;
	my $sv       = $self->serverVersion;
	$sv ge '3.1' or error __x"Solr version too old for updates in JSON syntax";

	$attrs     ||= {};
	my $params   = [ commit => delete $attrs->{commit} ];
	my $endpoint = $self->endpoint(($sv lt '4.0' ? 'update/json' : 'update'), params => $params);
	my $result = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);
	my %params = (%$attrs, (!$content ? () : ref $content eq 'HASH' ? %$content : @$content));
	my $doc    = $self->simpleDocument($command, \%params);
	$self->request($endpoint, $result, $doc);
	$result;
}


sub simpleDocument($;$$)
{	my ($self, $command, $attrs, $content) = @_;
	$attrs   ||= {};
	$content ||= {};
	+{ $command => { %$attrs, %$content } }
}

sub endpoint($@)
{	my ($self, $action, %args) = @_;
	my $params = $args{params} ||= [];

	if(ref $params eq 'HASH') { $params->{wt} ||= 'json' }
	else { $args{params} = [ wt => 'json', @$params ] }

	$self->SUPER::endpoint($action, %args);
}

1;

lib/Apache/Solr/Result.pm  view on Meta::CPAN

use Scalar::Util   qw(weaken);

use Apache::Solr::Document ();

use Data::Dumper;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Quotekeys = 0;


use overload
    '""' => 'endpoint'
  , bool => 'success';

#----------------------

sub new(@) { my $c = shift; (bless {}, $c)->init({@_}) }
sub init($)
{	my ($self, $args) = @_;

	my $p = $args->{params} || [];
	($p, my $params)      = ref $p eq 'HASH' ? ( +[%$p], $p ) : ($p, +{@$p});
	$self->{ASR_params}   = $p;

	$self->{ASR_endpoint} = $args->{endpoint} or panic;
	$self->{ASR_start}    = time;
	$self->request($args->{request});
	$self->response($args->{response});

	$self->{ASR_pages}    = [ $self ];   # first has non-weak page-table
	weaken $self->{ASR_pages}[0];        # no reference loop!

	if($self->{ASR_core}  = $args->{core}) { weaken $self->{ASR_core} }
	$self->{ASR_next}     = $params->{start} || 0;
	$self->{ASR_seq}      = $args->{sequential} || 0;

lib/Apache/Solr/Result.pm  view on Meta::CPAN


# replace the pageset with a shared set.
sub _pageset($)
{	$_[0]->{ASR_pages} = $_[1];
	weaken $_[0]->{ASR_pages};           # otherwise memory leak
}

#---------------

sub start()    {shift->{ASR_start}}
sub endpoint() {shift->{ASR_endpoint}}
sub params()   {@{shift->{ASR_params}}}
sub core()     {shift->{ASR_core}}
sub sequential() {shift->{ASR_seq}}

sub request(;$) 
{	my $self = shift;
	@_ && $_[0] or return $self->{ASR_request};
	$self->{ASR_req_out} = time;
	$self->{ASR_request} = shift;
}

lib/Apache/Solr/Result.pm  view on Meta::CPAN


sub _to_msec($) { sprintf "%.1f", $_[0] * 1000 }

sub showTimings(;$)
{	my ($self, $fh) = @_;
	$fh ||= select;
	my $req     = $self->request;
	my $to      = $req ? $req->uri : '(not set yet)';
	my $start   = localtime $self->{ASR_start};

	$fh->print("endpoint: $to\nstart:    $start\n");

	if($req)
	{	my $reqsize = length($req->as_string);
		my $reqcons = _to_msec($self->{ASR_req_out} - $self->{ASR_start});
		$fh->print("request:  constructed $reqsize bytes in $reqcons ms\n");
	}

	if(my $resp = $self->response)
	{	my $respsize = length($resp->as_string);
		my $respcons = _to_msec($self->{ASR_resp_in} - $self->{ASR_req_out});

lib/Apache/Solr/Result.pod  view on Meta::CPAN

=head1 METHODS

=head2 Constructors

=over 4

=item Apache::Solr::Result-E<gt>B<new>(%options)

 -Option    --Default
  core        undef
  endpoint    <required>
  params      []
  request     undef
  response    undef
  sequential  false

=over 2

=item core => L<Apache::Solr|Apache::Solr> object

=item endpoint => URI

=item params => ARRAY|HASH

The parameters used for the query.  [1.11] not required anymore.

=item request => HTTP::Request object

=item response => HTTP::Response object

=item sequential => BOOLEAN

lib/Apache/Solr/Result.pod  view on Meta::CPAN


=item $obj-E<gt>B<decoded>( [HASH] )

Set/get the decoded content of the Solr server response.  In some cases,
even error responses contain a valid Solr server data.

=item $obj-E<gt>B<elapse>()

Number of seconds used to receive a decoded answer.

=item $obj-E<gt>B<endpoint>()

The URI where the request is sent to.

=item $obj-E<gt>B<errors>()

All errors collected by this object into one string.

=item $obj-E<gt>B<httpError>()

=item $obj-E<gt>B<params>()

lib/Apache/Solr/XML.pm  view on Meta::CPAN

	$self;
}

#---------------
sub xmlsimple() {shift->{ASX_simple}}

#--------------------------

sub _select($$)
{	my ($self, $args, $params) = @_;
	my $endpoint = $self->endpoint('select', params => $params);
	my $result   = Apache::Solr::Result->new(%$args, params => $params, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result);
	$result;
}

sub _extract($$$)
{	my ($self, $params, $data, $ct) = @_;
	my $endpoint = $self->endpoint('update/extract', params => $params);
	my $result   = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result, $data, $ct);
	$result;
}

sub _add($$$)
{	my ($self, $docs, $attrs, $params) = @_;
	$attrs  ||= {};
	$params ||= [];

	my $doc   = XML::LibXML::Document->new('1.0', 'UTF-8');
	my $add   = $doc->createElement('add');
	$add->setAttribute($_ => $attrs->{$_}) for sort keys %$attrs;

	$add->addChild($self->_doc2xml($doc, $_))
		for @$docs;

	$doc->setDocumentElement($add);

	my $endpoint = $self->endpoint('update', params => $params);
	my $result   = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);
	$self->request($endpoint, $result, $doc);
	$result;
}

sub _doc2xml($$$)
{	my ($self, $doc, $this) = @_;

	my $node  = $doc->createElement('doc');
	my $boost = $this->boost || 1.0;
	$node->setAttribute(boost => $boost) if $boost != 1.0;

lib/Apache/Solr/XML.pm  view on Meta::CPAN

	$node;
}

sub _commit($)   { my ($s, $attr) = @_; $s->simpleUpdate(commit   => $attr) }
sub _optimize($) { my ($s, $attr) = @_; $s->simpleUpdate(optimize => $attr) }
sub _delete($$)  { my $self = shift; $self->simpleUpdate(delete   => @_) }
sub _rollback()  { shift->simpleUpdate('rollback') }

sub _terms($)
{	my ($self, $terms) = @_;
	my $endpoint = $self->endpoint('terms', params => $terms);
	my $result   = Apache::Solr::Result->new(params => $terms, endpoint => $endpoint, core => $self);

	$self->request($endpoint, $result);

	my $table = $result->decoded->{terms} || {};
	while(my ($field, $terms) = each %$table)
	{	my @terms = map [ $_ => $terms->{$_} ],
			sort {$terms->{$b} <=> $terms->{$a}} keys %$terms;
		$result->terms($field => \@terms);
	}

	$result;
}

lib/Apache/Solr/XML.pm  view on Meta::CPAN

	{	return $data;
	}
	else {panic ref $data || $data}
}


sub simpleUpdate($$;$)
{	my ($self, $command, $attrs, $content) = @_;
	$attrs     ||= {};
	my $params   = [ commit => delete $attrs->{commit} ];
	my $endpoint = $self->endpoint('update', params => $params);
	my $result   = Apache::Solr::Result->new(params => $params, endpoint => $endpoint, core => $self);
	my $doc      = $self->simpleDocument($command, $attrs, $content);
	$self->request($endpoint, $result, $doc);
	$result;
}


sub simpleDocument($;$$)
{	my ($self, $command, $attrs, $content) = @_;
	my $doc  = XML::LibXML::Document->new('1.0', 'UTF-8');
	my $top  = $doc->createElement($command);
	$doc->setDocumentElement($top);

lib/Apache/Solr/XML.pm  view on Meta::CPAN

				$top->addChild($node);
			}
		}
	}
	else
	{	$top->appendText($content);
	}
	$doc;
}

sub endpoint($@)
{	my ($self, $action, %args) = @_;
	my $params = $args{params} ||= [];

	if(ref $params eq 'HASH') { $params->{wt} ||= 'xml' }
	else { $args{params} = [ wt => 'xml', @$params ] }

    $self->SUPER::endpoint($action => %args);
}

1;

t/10endpoint.t  view on Meta::CPAN

#!/usr/bin/perl
# Test endpoint construction

use warnings;
use strict;

use lib 'lib';
use Apache::Solr;

use Test::More tests => 4;

# the server will not be called in this script.
my $server = 'http://localhost:8080/solr';
my $core   = 'my-core';

my $solr = Apache::Solr->new(server => $server, core => $core);
ok(defined $solr, 'instantiated client');
isa_ok($solr, 'Apache::Solr');

my $uri1 = $solr->endpoint('update', params => [tic => 1, tac => '&']);
isa_ok($uri1, 'URI');
is($uri1->as_string, "$server/$core/update?wt=xml&tic=1&tac=%26");

t/20xml.t  view on Meta::CPAN


ok(defined $solr, "instantiated client in $format");

isa_ok($solr, 'Apache::Solr::'.$FORMAT);

my $result = eval { $solr->commit };
ok(!$@, 'try commit:'.$@);
cmp_ok($result->solrStatus, '==', 0, 'Commit status success');

isa_ok($result, 'Apache::Solr::Result');
is($result->endpoint, "$result");

#$result->showTimings(\*STDERR);
ok($result->success, 'successful');

# reset the database
my $r0 = $solr->delete(id => [ qw/A B C/ ]);
ok($r0->success, 'delete succeeded');
#warn Dumper $r0;

### test $solr->addDocument()

t/20xml.t  view on Meta::CPAN

isa_ok($r1->[0], 'ARRAY', 'is array of arrays');
cmp_ok(scalar @{$r1->[0]}, '==', 2, 'each size 2');
cmp_ok(scalar @{$r1->[1]}, '==', 2, 'each size 2');

### test $solr->select with one result

my $t2 = $solr->select(q => 'text:tic', hl => {fl => 'content'});
#warn Dumper $t2->decoded;
isa_ok($t2, 'Apache::Solr::Result');
ok($t2, 'select was successful');
is($t2->endpoint, "$server/select?wt=$format&q=text%3Atic&hl=true&hl.fl=content");

cmp_ok($t2->nrSelected, '==', 1);

my $d2 = $t2->selected(0);
#warn Dumper $d2;
isa_ok($d2, 'Apache::Solr::Document', 'got 1 answer');
isa_ok($d2->field('subject'), 'HASH', 'subject');
is($d2->field('subject')->{content}, '1 2 3');
is($d2->content('subject'), '1 2 3');
is($d2->_subject, '1 2 3');

#ok($d2->{hl}, 'got 1 hightlights');

### test $solr->select with two results

my $t3 = $solr->select(q => 'text:tac', rows => 1, hl => {fl => 'content'});
ok($t3, 'select was successful');
isa_ok($t3, 'Apache::Solr::Result');
is($t3->endpoint, "$server/select?wt=$format&q=text%3Atac&rows=1&hl=true&hl.fl=content");

cmp_ok($t3->nrSelected, '==', 2, '2 items selected');

cmp_ok($t3->fullPageSize, '==', 1, 'page size 1');
cmp_ok($t3->selectedPageNr(0), '==', 0, 'item 0 on page 0');
cmp_ok($t3->selectedPageNr(1), '==', 1, 'item 1 on page 1');

my $d3a = $t3->selected(0);
is($d3a->rank, 0, 'rank 0');
#warn Dumper $d3a;

t/21json.t  view on Meta::CPAN


ok(defined $solr, "instantiated client in $format");

isa_ok($solr, 'Apache::Solr::'.$FORMAT);

my $result = eval { $solr->commit };
ok(!$@, 'try commit:'.$@);
cmp_ok($result->solrStatus, '==', 0, 'Commit status success');

isa_ok($result, 'Apache::Solr::Result');
is($result->endpoint, "$result");

#$result->showTimings(\*STDERR);
ok($result->success, 'successful');

# reset the database
my $r0 = $solr->delete(id => [ qw/A B C/ ]);
ok($r0->success, 'delete succeeded');
#warn Dumper $r0;

### test $solr->addDocument()

t/21json.t  view on Meta::CPAN

isa_ok($r1->[0], 'ARRAY', 'is array of arrays');
cmp_ok(scalar @{$r1->[0]}, '==', 2, 'each size 2');
cmp_ok(scalar @{$r1->[1]}, '==', 2, 'each size 2');

### test $solr->select with one result

my $t2 = $solr->select(q => 'text:tic', hl => {fl => 'content'});
#warn Dumper $t2->decoded;
isa_ok($t2, 'Apache::Solr::Result');
ok($t2, 'select was successful');
is($t2->endpoint, "$server/select?wt=$format&q=text%3Atic&hl=true&hl.fl=content");

cmp_ok($t2->nrSelected, '==', 1);

my $d2 = $t2->selected(0);
#warn Dumper $d2;
isa_ok($d2, 'Apache::Solr::Document', 'got 1 answer');
isa_ok($d2->field('subject'), 'HASH', 'subject');
is($d2->field('subject')->{content}, '1 2 3');
is($d2->content('subject'), '1 2 3');
is($d2->_subject, '1 2 3');

#ok($d2->{hl}, 'got 1 hightlights');

### test $solr->select with two results

my $t3 = $solr->select(q => 'text:tac', rows => 1, hl => {fl => 'content'});
ok($t3, 'select was successful');
isa_ok($t3, 'Apache::Solr::Result');
is($t3->endpoint, "$server/select?wt=$format&q=text%3Atac&rows=1&hl=true&hl.fl=content");

cmp_ok($t3->nrSelected, '==', 2, '2 items selected');

cmp_ok($t3->fullPageSize, '==', 1, 'page size 1');
cmp_ok($t3->selectedPageNr(0), '==', 0, 'item 0 on page 0');
cmp_ok($t3->selectedPageNr(1), '==', 1, 'item 1 on page 1');

my $d3a = $t3->selected(0);
is($d3a->rank, 0, 'rank 0');
#warn Dumper $d3a;

t/31sequential.t  view on Meta::CPAN

my $rank4 = $rows_per_page + 1;
my $d4 = $t2->selected($rank4);
ok defined $d4, 'Doc on second page';
is $d4->rank, $rank4, "... rank $rank4";
is $d4->_subject, 'subject '.$create_ids[$rank4], '... subject field';
cmp_ok scalar @$pageset, '==', 2, '... second page loaded page';
ok ! defined $pageset->[0], '... first page released';
ok   defined $pageset->[1], '... second page kept';

my $p4 = $t2->selectedPage(1);
is $pageset->[1]->endpoint, $p4->endpoint, '... selectedPage()';
cmp_ok $p4->fullPageSize, '==', $rows_per_page, '... pageset knows page size';

### nextSelected

my $d5 = $t2->nextSelected;
ok defined $d5, 'nextSelected document';
is $d5->rank, $rank4+1, "... rank ".($rank4+1);
is $d5->_subject, 'subject '.$create_ids[$rank4+1], '... subject field';

while(my $next = $t2->nextSelected)

t/32version.t  view on Meta::CPAN

}

my $solr = Apache::Solr::JSON->new
  ( server     => $server
  , retry_max  => 3
  , retry_wait => 2
  );

my $self = $solr;
{
    my $endpoint = $self->endpoint('info/system', core => 'admin');
    my $result   = Apache::Solr::Result->new(endpoint => $endpoint, core => $self);

    $self->request($endpoint, $result);
	ok $result->success, 'got system info';
#   warn Dumper $result;
}

done_testing;



( run in 0.856 second using v1.01-cache-2.11-cpan-b61123c0432 )