view release on metacpan or  search on metacpan

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

# This code is part of Perl distribution Apache-Solr version 1.12.
# The POD got stripped from this file by OODoc version 3.06.
# For contributors see file ChangeLog.

# This software is copyright (c) 2012-2026 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later


package Apache::Solr::JSON;{
our $VERSION = '1.12';
}

use base 'Apache::Solr';

use warnings;
use strict;

use Log::Report          qw/solr/;

use Apache::Solr::Result ();
use HTTP::Request        ();
use JSON                 ();
use Scalar::Util         qw/blessed/;

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

sub init($)
{	my ($self, $args) = @_;
	$args->{format}   ||= 'JSON';
	$self->SUPER::init($args);

	$self->{ASJ_json} = $args->{json} || JSON->new->utf8;
	$self;
}

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

sub json() { $_[0]->{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)