view release on metacpan or search on metacpan
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");
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()
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;
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()
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;