Apache-Solr

 view release on metacpan or  search on metacpan

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

	$result->request($req);

	my $resp;
	my $retries = $self->{AS_retry_max};
	my $wait    = $self->{AS_retry_wait};
	my $start   = time;

	while($retries--)
	{	$resp = $self->agent->request($req);
		$result->response($resp);
		my $dec = $result->decoded($self->decodeResponse($resp));

		last if $resp->is_success;

		if($resp->code==500)
		{	$! = ENETDOWN;  # HTTP(500) -> unix error
			alert __x"Solr request failed with {code}, {retries} retries left",
			code => $resp->code, retries => $retries, result => $result;
			sleep $wait if $wait && $retries;    # let remote settle a bit
			next;
		}

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

  # based on Log::Report, hence (for communication errors and such)
  use Log::Report;
  dispatcher SYSLOG => 'default';  # now all warnings/error to syslog
  try { $solr->select(...) }; print $@->wasFatal;

  # [1.11] Information about communication errors 
  my $result = try { $solr->select(...) };
  if(my $ex = $@->wasFatal)
  {  $result = $ex->message->valueOf('result');
     if(defined $result)   #!! defined !!
     {    warn Dumper $result->decoded;

=head1 DESCRIPTION

Solr is a stand-alone full-text search-engine (based on Lucent), with
loads of features.  This module tries to provide a high level interface
to the Solr server.

See F<F<http://wiki.apache.org/solr/> and F<http://lucene.apache.org/solr/>

=head1 METHODS

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

=item core => NAME

=back

example: 

  my $result = $solr->coreStatus;
  $result or die $result->errors;

  use Data::Dumper;
  print Dumper $result->decoded->{status};

=item $obj-E<gt>B<coreUnload>(%options)

Removes a core from Solr. Active requests will continue to be processed, but no new requests will be sent to the named core. If a core is registered under more than one name, only the given name is removed.

 -Option--Default
  core    <this core>

=over 2

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


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);

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

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 decodeResponse($)
{	my ($self, $resp) = @_;

	# At least until Solr 4.0 response ct=text/plain while producing JSON
	my $ct = $resp->content_type;
	$ct =~ m/json/i
		or error __x"Answer from solr server is not json but {type}", type => $ct;

	$self->json->decode($resp->decoded_content || $resp->content);
}


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} ];

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

	$self->{ASR_request} = shift;
}

sub response(;$) 
{	my $self = shift;
	@_ && $_[0] or return $self->{ASR_response};
	$self->{ASR_resp_in}  = time;
	$self->{ASR_response} = shift;
}

sub decoded(;$) 
{	my $self = shift;
	@_ or return $self->{ASR_decoded};
	$self->{ASR_dec_done} = time;
	$self->{ASR_decoded}  = shift;
}

sub elapse()
{	my $self = shift;
	my $done = $self->{ASR_dec_done} or return;
	$done = $self->{ASR_start};
}


sub success() { my $s = shift; $s->{ASR_success} ||= $s->solrStatus==0 }


sub solrStatus()
{	my $dec  = shift->decoded or return 500;
	$dec->{responseHeader}{status};
}

sub solrQTime()
{	my $dec   = shift->decoded or return;
	my $qtime = $dec->{responseHeader}{QTime};
	defined $qtime ? $qtime/1000 : undef;
}

sub solrError()
{	my $dec  = shift->decoded or return;
	my $err  = $dec->{error} || {};
	my $msg  = $err->{msg}   || '';
	$msg =~ s/\s*$//s;
	length $msg ? $msg : ();
}

sub httpError()
{	my $resp = shift->response or return;
	$resp->status_line;
}

sub serverError()
{	my $resp = shift->response or return;
	$resp->code != 200 or return;
	my $ct   = $resp->content_type;
	$ct eq 'text/html' or return;
	my $body = $resp->decoded_content || $resp->content;
	$body =~ s!.*<body>!!;
	$body =~ s!</body>.*!!;
	$body =~ s!</h[0-6]>|</p>!\n!g;  # cheap reformatter
	$body =~ s!</b>\s*!: !g;
	$body =~ s!<[^>]*>!!gs;
	$body;
}


sub errors()

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

	{	$a =~ s/^/   /gm;
		push @errors, "Server error:", $a;
	}
	if(my $s = $self->solrError)   { push @errors, "Solr error:",   "   $s" }
	join "\n", @errors, '';
}

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

sub _responseData()
{	my $dec  = shift->decoded;
	$dec->{result} // $dec->{response};
}

sub nrSelected()
{	my $results = shift->_responseData
		or panic "there are no results (yet)";

	$results->{numFound};
}

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

sub nextSelected(%)
{	my $self = shift;
	$self->selected($self->{ASR_next}, @_);
}


sub highlighted($)
{	my ($self, $doc) = @_;
	my $rank   = $doc->rank;
	my $pagenr = $self->selectedPageNr($rank);
	my $hl     = $self->selectedPage($pagenr)->decoded->{highlighting}
		or error __x"There is no highlighting information in the result";
	Apache::Solr::Document->fromResult($hl->{$doc->uniqueId}, $rank);
}

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

sub terms($;$)
{	my ($self, $field) = (shift, shift);
	return $self->{ASR_terms}{$field} = shift if @_;

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


	if(my $resp = $self->response)
	{	my $respsize = length($resp->as_string);
		my $respcons = _to_msec($self->{ASR_resp_in} - $self->{ASR_req_out});
		$fh->print("response: received $respsize bytes after $respcons ms\n");
		my $ct       = $resp->content_type;
		my $status   = $resp->status_line;
		$fh->print("          $ct, $status\n");
	}

	if(my $dec = $self->decoded)
	{	my $decoder = _to_msec($self->{ASR_dec_done} - $self->{ASR_resp_in});
		$fh->print("decoding: completed in $decoder ms\n");
		if(defined(my $qt = $self->solrQTime))
		{	$fh->print("          solr processing took "._to_msec($qt)." ms\n");
		}
		if(my $error = $self->solrError)
		{	$fh->print("          solr reported error: '$error'\n");
		}
		my $total   = _to_msec($self->{ASR_dec_done} - $self->{ASR_start});
		$fh->print("elapse:   $total ms total\n");

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

=back

=head2 Accessors

=over 4

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

[0.95] May return the L<Apache::Solr|Apache::Solr> object which created this result.

=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>()

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

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

}

sub _cleanup_parsed($);
sub decodeResponse($)
{	my ($self, $resp) = @_;

	$resp->content_type =~ m/xml/i
		or return undef;

	my $dec = $self->xmlsimple->XMLin(
		$resp->decoded_content || $resp->content,
		parseropts => { huge => 1 },
	);

	_cleanup_parsed $dec;
}

sub _cleanup_parsed($)
{	my $data = shift;

	if(!ref $data) { return $data }

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

ok(defined $r1, 'lookup search results for "id"');
isa_ok($r1, 'ARRAY');
cmp_ok(scalar @$r1, '==', 2, 'both documents have an id');
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');

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

ok(defined $r1, 'lookup search results for "id"');
isa_ok($r1, 'ARRAY');
cmp_ok(scalar @$r1, '==', 2, 'both documents have an id');
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');

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

  , subject => "subject $_"
  , content => "<html>Document $_"
  , content_type => 'text/html'
  ]), @create_ids;

ok $solr->addDocument(\@docs1, commit => 1, overwrite => 1), 'Created docs';

### Find all documents

my $t2 = $solr->select({ sequential => 1 }, rows => $rows_per_page, q => 'text:Document');
#warn Dumper $t2->decoded;
ok $t2, 'Searched for all docs';
isa_ok $t2, 'Apache::Solr::Result', '...';

cmp_ok $t2->nrSelected, '==', scalar @create_ids, '... found all documents';

cmp_ok $t2->fullPageSize, '==', $rows_per_page, "... page has $rows_per_page rows";

my $pageset = $t2->{ASR_pages};   # internal table
cmp_ok scalar @$pageset, '==', 1, '... only first page loaded for size';

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

is $d5->rank, $rank4+1, "... rank ".($rank4+1);
is $d5->_subject, 'subject '.$create_ids[$rank4+1], '... subject field';

while(my $next = $t2->nextSelected)
{   is $next->_subject, 'subject '.$create_ids[$next->rank], '... rank '.$next->rank;
}

### Start a search without pagesize.

my $t5 = $solr->select(q => 'text:Document');
#warn Dumper $t5->decoded;
cmp_ok $t5->fullPageSize, '<', scalar @create_ids,
   'Auto-pagesize is '.$t5->fullPageSize;

### Cleanup

ok $solr->delete(id => \@create_ids)->success, 'Cleanup';

done_testing;



( run in 0.372 second using v1.01-cache-2.11-cpan-26ccb49234f )