#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution.  You can use this file for
#oodist: testing, however the code of this development version may be broken!

package Apache::Solr;

use warnings;
use strict;

use Apache::Solr::Tables;
use Log::Report    qw/solr/;

use Scalar::Util   qw/blessed/;
use Encode         qw/encode/;
use Scalar::Util   qw/weaken/;

use URI            ();
use LWP::UserAgent ();
use MIME::Types    ();

use constant {
	LATEST_SOLR_VERSION => '9.8',  # newest support by this module
	ENETDOWN    => 100,   # error codes may not be available on all platforms
	ENETUNREACH => 101,   #    so cannot use Errno.
};

# overrule this when your host has a different unique field
our $uniqueKey  = 'id';
my  $mimetypes  = MIME::Types->new;
my  $http_agent;

sub _to_bool($)
{	my $b = shift;
	!defined $b ? undef : ($b && $b ne 'false' && $b ne 'off') ? 'true' : 'false';
}

#--------------------
=chapter NAME
Apache::Solr - Apache Solr (Lucene) extension

=chapter SYNOPSIS

  # use Log::Report mode => "DEBUG";
  my $solr    = Apache::Solr->new(server => $url, field_key_simplify => 0);
  my $lwp     = $solr->agent;   # internal LWP::UserAgent

  my $doc     = Apache::Solr::Document->new(...);
  my $results = $solr->addDocument($doc);
  $results or die $results->errors;

  my $results = $solr->select(q => 'author:mark');
  my $doc     = $results->selected(3);
  print $doc->_author;

  my $results = $solr->select(q => "really", hl => {fl=>'content'});
  while(my $doc = $results->nextSelected)
  {   my $hldoc = $results->highlighted($doc);
      print $hldoc->_content;
      ...
  }

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

=chapter 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 L<https://wiki.apache.org/solr/> and L<https://lucene.apache.org/solr/>

=chapter METHODS

=section Constructors

=c_method new %options
Create a client to connect to one "core" (collection) of the Solr
server.

=requires server $url
The locations of the Solr server depends on the way the java environment
is set-up.   The $url is either an M<URI> object or a string which can be
instantiated as such.

=option  server_version $version
=default server_version <latest>
By default the latest version of the server software, currently 4.5.
Try to get this setting right, because it will help you a lot in correct
parameter use and support for the right features.

We know now that this can be requested via C</admin/info/system>, but
do not spend more development time on this module until it gets more
users.

=option  core $name
=default core undef
Set the core $name to be addressed by this client. When there is no core
name specified, the core is selected by the server or already part of
the URL.

You probably want to set-up a core dedicated for testing and one for
the live environment.

=option  agent LWP::UserAgent-object
=default agent <created internally>
Agent which implements the communication between this client and the
Solr server.

When you have multiple C<Apache::Solr> objects in your program, you may
want to share this agent, to share the connection. Since [0.94], this
will happen automagically: the parameter defaults to the agent created
for the previous object.

Do not forget to install LWP::Protocol::https if you need to connect
via https.

=option  autocommit BOOLEAN
=default autocommit true
Commit all changes immediately unless specified differently.

=option  format  'XML'|'JSON'
=default format  'XML'
Communication format between client and server.  You may also instantiate
Apache::Solr::XML or Apache::Solr::JSON directly.

=option  retry_wait $seconds
=default retry_wait C<5>
[1.09] When the connection to the Solr server fails, or when the server
does not respond correctly, a retry is attempted after waiting a few
$seconds.  You may use '0' to skip waiting.

=option  retry_max COUNT
=default retry_max C<60>
[1.09] When the server(-connection) persists in producing errors, it
may not recover at all.  Let's not block the main code.  Of course, it
may take considerable time for each error to show, so the communication
failure can take much, much longer than P<retry_wait> times P<retry_max>
seconds.

You can disable retries with with '0'.

=option  field_key_simplify BOOLEAN
=default field_key_simplify true
[1.12] support the use of underscores ('_') as alternative for dot ('.')
in field paths.  For backwards compatibility reasons, this field has
B<the wrong default>, see example.

=example field_key_simplify
[1.12] On the Perl side, the query parameter structure is processed as
a HASH.  The Solr fields are nested with dots, which means they are not
barewords which can be used unquoted as has keys.  That's inconvenient.
So, you can use an underscore instead of a dot. B<However:> the underscore
is also a value character in a field name token.  So, it is very unwise to
enable this rewrite even though it makes your Perl pretty.

   f_cat_facet  => { missing => 1 },  # by default means:
  'f.cat.facet' => { missing => 1 },

   f.myinteger_i.facet.range.start    # is by default rules:
   f.myinteger.i.facet.range.start    # which is broken.

Wrong default kept to be backwards compatible.
=cut

sub new(@)
{	my ($class, %args) = @_;
	if($class eq __PACKAGE__)
	{	my $format = delete $args{format} || 'XML';
		$format eq 'XML' || $format eq 'JSON'
			or panic "unknown communication format '$format' for solr";
		$class .= '::' . $format;
		eval "require $class"; panic $@ if $@;
	}
	(bless {}, $class)->init(\%args)
}

sub init($)
{	my ($self, $args) = @_;
	$self->server($args->{server});
	$self->{AS_core}     = $args->{core};
	$self->{AS_commit}   = exists $args->{autocommit} ? $args->{autocommit} : 1;
	$self->{AS_sversion} = $args->{server_version} || LATEST_SOLR_VERSION;
	$self->{AS_retry_wait} = $args->{retry_wait} // 5;  # seconds
	$self->{AS_retry_max}  = $args->{retry_max}  // 60;
	$self->{AS_underscore} = exists $args->{field_key_simplify} ? $args->{field_key_simplify} : 1;

	$http_agent = $self->{AS_agent} =
		$args->{agent} || $http_agent || LWP::UserAgent->new(keep_alive=>1);

	weaken $http_agent;
	$self;
}

#--------------------
=section Attributes

=method core [$core]
Returns the $core, when not defined the default core as set by M<new(core)>.
May return undef.

=method autocommit [BOOLEAN]

=method agent
Returns the LWP::UserAgent object which maintains the connection to
the server.

=method serverVersion
Returns the specified version of the Solr server software (by default the
latest).  Treat this version as string, to avoid rounding errors.
=cut

sub core(;$) { my $s = shift; @_ ? $s->{AS_core}   = shift : $s->{AS_core} }
sub autocommit(;$) { my $s = shift; @_ ? $s->{AS_commit} = shift : $s->{AS_commit} }
sub agent() { $_[0]->{AS_agent} }
sub serverVersion() { $_[0]->{AS_sversion} }

=method server [$uri|STRING]
Returns the M<URI> object which refers to the server base address.  You need
to C<clone()> it before modifying.  You may set a new value as STRING or $uri
object.
=cut

sub server(;$)
{	my ($self, $uri) = @_;
	$uri or return $self->{AS_server};
	$uri = URI->new($uri)
		unless blessed $uri && $uri->isa('URI');
	$self->{AS_server} = $uri;
}

=method fieldKeySimplify
[1.12] Returns true when underscores in field paths are to be interpreted as dots.
This is true by default, but deprecated.  Please expliticly disable this rewrite
rule by setting M<new(field_key_simplify)> to false.
=cut

sub fieldKeySimplify() { $_[0]->{AS_underscore} }

#--------------------
=section Commands

=subsection Search

=method select [\%options], @parameters
Find information in the document collection.

This method has a HUGE number of parameters.  These values are passed in
the uri of the http query to the solr server.  See M<expandSelect()> for
all the simplifications offered here.  Sets of there parameters
may need configuration help in the server as well.

[1.06] You may pass some options to process the selected results (the
Apache::Solr::Result object initiation).  For instance, C<sequential>.
For backwards compatability reasons, they have to be passed in a HASH
as optional first parameter.

=cut

sub select(@)
{	my $self = shift;
	my $args = @_ && ref $_[0] eq 'HASH' ? shift : {};
	$self->_select($args, scalar $self->expandSelect(@_));
}
sub _select($$) {panic "not extended"}

=method queryTerms $terms
Search for often used terms. See L<https://wiki.apache.org/solr/TermsComponent>

$terms are passed to M<expandTerms()> before being used.

B<Be warned:> The result is not sorted when XML communication is used,
even when you explicitly request it.

=examples
  my $r = $self->queryTerms(fl => 'subject', limit => 100);
  if($r->success)
  {    foreach my $hit ($r->terms('subject'))
      {    my ($term, $count) = @$hit;
          print "term=$term, count=$count\n";
      }
  }

  if(my $r = $self->queryTerms(fl => 'subject', limit => 100))
     ...
=cut

sub queryTerms(@)
{	my $self  = shift;
	$self->_terms(scalar $self->expandTerms(@_));
}
sub _terms(@) {panic "not implemented"}

#--------------------
=subsection Updates

See L<https://wiki.apache.org/solr/UpdateXmlMessages>.  Missing are the
atomic updates.

=method addDocument $doc|\@docs, %options
Add one or more documents (Apache::Solr::Document objects) to the Solr
database on the server.

=option  commit BOOLEAN
=default commit <autocommit>

=option  commitWithin $seconds
=default commitWithin undef
[Since Solr 3.4] Automatically translated into 'commit' for older
servers.  Currently, the resolution is milli-seconds.

=option  overwrite BOOLEAN
=default overwrite true

=option  allowDups BOOLEAN
=default allowDups false
[removed since Solr 4.0]  Use option P<overwrite>.

=option  overwritePending BOOLEAN
=default overwritePending <not allowDups>
[removed since Solr 4.0]  Use option P<overwrite>.

=option  overwriteCommitted BOOLEAN
=default overwriteCommitted <not allowDups>
[removed since Solr 4.0]  Use option P<overwrite>.

=cut

sub addDocument($%)
{	my ($self, $docs, %args) = @_;
	$docs  = [ $docs ] if ref $docs ne 'ARRAY';

	my $sv = $self->serverVersion;

	my (%attrs, %params);
	$params{commit} = _to_bool(exists $args{commit} ? $args{commit} : $self->autocommit);

	if(my $cw = $args{commitWithin})
	{	if($sv lt '3.4') { $attrs{commit} = 'true' }
		else { $attrs{commitWithin} = int($cw * 1000) }
	}

	$attrs{overwrite} = _to_bool delete $args{overwrite}
		if exists $args{overwrite};

	foreach my $depr (qw/allowDups overwritePending overwriteCommitted/)
	{	if(exists $args{$depr})
		{	  if($sv ge '4.0') { $self->removed("add($depr)"); delete $args{$depr} }
			elsif($sv ge '1.0') { $self->deprecated("add($depr)") }
			else { $attrs{$depr} = _to_bool delete $args{$depr} }
		}
	}

	$self->_add($docs, \%attrs, \%params);
}

=method commit %options

=option  waitFlush BOOLEAN
=default waitFlush true
[before Solr 1.4, removed in 4.0]

=option  waitSearcher BOOLEAN
=default waitSearcher true

=option  softCommit BOOLEAN
=default softCommit false
[since Solr 4.0]

=option  expungeDeletes BOOLEAN
=default expungeDeletes false
[since Solr 1.4]
=cut

sub commit(%)
{	my ($self, %args) = @_;
	my $sv = $self->serverVersion;

	my %attrs;
	if(exists $args{waitFlush})
	{	  if($sv ge '4.0')
			{	$self->removed("commit(waitFlush)"); delete $args{waitFlush} }
		elsif($sv ge '1.4') { $self->deprecated("commit(waitFlush)") }
		else { $attrs{waitFlush} = _to_bool delete $args{waitFlush} }
	}

	$attrs{waitSearcher} = _to_bool delete $args{waitSearcher}
		if exists $args{waitSearcher};

	if(exists $args{softCommit})
	{	if($sv lt '4.0') { $self->ignored("commit(softCommit)") }
		else { $attrs{softCommit} = _to_bool delete $args{softCommit} }
	}

	if(exists $args{expungeDeletes})
	{	if($sv lt '1.4') { $self->ignored("commit(expungeDeletes)") }
		else { $attrs{expungeDeletes} = _to_bool delete $args{expungeDeletes} }
	}

	$self->_commit(\%attrs);
}
sub _commit($) {panic "not implemented"}

=method optimize %options

=option  waitFlush BOOLEAN
=default waitFlush <true>
[before Solr 1.4, removed from 4.0]

=option  waitSearcher BOOLEAN
=default waitSearcher true

=option  softCommit BOOLEAN
=default softCommit false
[since Solr 4.0]

=option  maxSegments INTEGER
=default maxSegments 1
[since Solr 1.3]
=cut

sub optimize(%)
{	my ($self, %args) = @_;
	my $sv = $self->serverVersion;

	my %attrs;
	if(exists $args{waitFlush})
	{	if($sv ge '4.0') { $self->removed("commit(waitFlush)"); delete $args{waitFlush} }
		elsif($sv ge '1.4') { $self->deprecated("optimize(waitFlush)") }
		else { $attrs{waitFlush} = _to_bool delete $args{waitFlush} }
	}

	$attrs{waitSearcher} = _to_bool delete $args{waitSearcher}
		if exists $args{waitSearcher};

	if(exists $args{softCommit})
	{	if($sv lt '4.0') { $self->ignored("optimize(softCommit)") }
		else { $attrs{softCommit} = _to_bool delete $args{softCommit} }
	}

	if(exists $args{maxSegments})
	{	if($sv lt '1.3') { $self->ignored("optimize(maxSegments)") }
		else { $attrs{maxSegments} = delete $args{maxSegments} }
	}

	$self->_optimize(\%attrs);
}
sub _optimize($) {panic "not implemented"}

=method delete %options
Remove one or more documents, based on id or query.

=option  commit BOOLEAN
=default commit <autocommit>
When specified, it indicates whether to commit (update the indexes) after
the last delete.  By default the value of M<new(autocommit)>.

=option  id $id|\@ids
=default id undef
The expected content of the uniqueKey fields (usually named P<id>) for
the documents to be removed.

=option  query $query|\@queries
=default query undef

=option  fromPending BOOLEAN
=default fromPending true
[deprecated since ?]

=option  fromCommitted BOOLEAN
=default fromCommitted true
[deprecated since ?]
=cut

sub delete(%)
{	my ($self, %args) = @_;

	my %attrs;
	$attrs{commit} = _to_bool(exists $args{commit} ? $args{commit} : $self->autocommit);

	if(exists $args{fromPending})
	{	$self->deprecated("delete(fromPending)");
		$attrs{fromPending}   = _to_bool delete $args{fromPending};
	}
	if(exists $args{fromCommitted})
	{	$self->deprecated("delete(fromCommitted)");
		$attrs{fromCommitted} = _to_bool delete $args{fromCommitted};
	}

	my @which;
	if(my $id = $args{id})
	{	push @which, map +(id => $_), ref $id eq 'ARRAY' ? @$id : $id;
	}
	if(my $q  = $args{query})
	{	push @which, map +(query => $_), ref $q  eq 'ARRAY' ? @$q  : $q;
	}
	@which or return;

	# JSON calls do not accept multiple ids at once (it seems in 4.0)
	my $result;
	if($self->serverVersion ge '1.4' && !$self->isa('Apache::Solr::JSON'))
	{	$result = $self->_delete(\%attrs, \@which);
	}
	else
	{	# old servers accept only one id or query per delete
		$result = $self->_delete(\%attrs, [splice @which, 0, 2]) while @which;
	}
	$result;
}
sub _delete(@) {panic "not implemented"}

=method rollback
[solr 1.4]

=error rollback not supported by your solr server version.
=cut

sub rollback()
{	my $self = shift;
	$self->serverVersion ge '1.4'
		or error __x"rollback not supported by your solr server version.";

	$self->_rollback;
}

=method extractDocument %options
Call the Solr Tika built-in to have the server translate various
kinds of structured documents into Solr searchable documents.  This
component is also called "Solr Cell".

The %options are mostly passed on as attributes to the server call,
but there are a few more.  You need to pass either a P<file> or
P<string> with data.

See L<https://wiki.apache.org/solr/ExtractingRequestHandler>

=option  commit BOOLEAN
=default commit M<new(autocommit)>
[0.94] commit the document to the database.

=option  file FILENAME|FILEHANDLE
=default file undef
Either P<file> or P<string> must be used.

=option  string STRING|SCALAR
=default string undef
The document provided as normal text or a reference to raw text.  You may
also specify the P<file> option with a filename.

=option  content_type MIME
=default content_type <from> filename

=example
  my $r = $solr->extractDocument(file => 'design.pdf',
      literal_id => 'host');

=error extractDocument() requires Solr v1.4 or higher.
=fault Cannot read document from $fn: $!
=fault Read error for document $fn: $!
=error extract requires document as file or string.
=cut

sub extractDocument(@)
{	my $self  = shift;

	$self->serverVersion ge '1.4'
		or error __x"extractDocument() requires Solr v1.4 or higher.";

	my %p   = $self->expandExtract(@_);
	my $data;

	# expand* changes '_' into '.'
	my $ct  = delete $p{'content.type'};
	my $fn  = delete $p{file};
	$p{'resource.name'} ||= $fn if $fn && !ref $fn;

	$p{commit} = _to_bool $self->autocommit
		unless exists $p{commit};

	if(defined $p{string})
	{	# try to avoid copying the data, which can be huge
		$data = $ct =~ m!^text/!i
		? \encode(utf8 => (ref $p{string} eq 'SCALAR' ? ${$p{string}} : $p{string}))
		: (ref $p{string} eq 'SCALAR' ? $p{string} : \$p{string} );

		delete $p{string};
	}
	elsif($fn)
	{	local $/;
		if(ref $fn eq 'GLOB') { $data = \<$fn> }
		else
		{	local *IN;
			open IN, '<:raw', $fn or fault __x"Cannot read document from {fn}", fn => $fn;
			$data = \<IN>;
			close IN or fault __x"Read error for document {fn}", fn => $fn;
			$ct ||= $mimetypes->mimeTypeOf($fn);
		}
	}
	else
	{	error __x"extract requires document as file or string.";
	}

	$self->_extract([%p], $data, $ct);
}

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

#--------------------
=subsection Core management
See L<https://solr.apache.org/guide/6_6/coreadmin-api.html>
The CREATE, SWAP, ALIAS, and RENAME actions are not yet supported, because
they are not very useful, it seems.
=cut

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

=method coreStatus %options
[0.94] Returns a HASH with information about this core.  There is no
description about the exact structure and interpretation of this data.

=option  core $name
=default core <this core>

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

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

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

=method coreReload %options
[0.94] Load a new core (on the server) from the configuration of this
core. While the new core is initializing, the existing one will continue
to handle requests. When the new Solr core is ready, it takes over and
the old core is unloaded.

=option  core $name
=default core <this core>

=example
  my $result = $solr->coreReload;
  $result or die $result->errors;
=cut

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

=method 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  core $name
=default core <this core>
=cut

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

#--------------------
=section Helpers

=subsection Parameter pre-processing

Many parameters are passed to the server.  The syntax of the communication
protocol is not optimal for the end-user: it is too verbose and depends on
the Solr server version.

General rules:
=over 4
=item * you can group them on prefix
=item * use underscore as alternative to dots: less quoting needed (see M<new(field_key_simplify)>)
=item * boolean values in Perl will get translated into 'true' and 'false'
=item * when an ARRAY (or LIST), the order of the parameters get preserved
=back
=cut

sub _calling_sub()
{	for(my $i=0;$i <10; $i++)
	{	my $sub = (caller $i)[3];
		return $sub if !$sub || index($sub, 'Apache::Solr::') < 0;
	}
}

sub _simpleExpand($$$)
{	my ($self, $p, $prefix) = @_;
	my @p  = ref $p eq 'HASH' ? %$p : @$p;
	my $sv = $self->serverVersion;

	my @t;
	while(@p)
	{	my ($k, $v) = (shift @p, shift @p);
		$k =~ s/_/./g if $self->fieldKeySimplify;
		$k = $prefix.$k if defined $prefix && index($k, $prefix)!=0;
		my $param   = $k =~ m/^f\.[^\.]+\.(.*)/ ? $1 : $k;

		my ($dv, $iv);
		if(($dv = $deprecated{$param}) && $sv ge $dv)
		{	my $command = _calling_sub;
			$self->deprecated("$command($param) since $dv");
		}
		elsif(($iv = $introduced{$param}) && $iv gt $sv)
		{	my $command = _calling_sub;
			$self->ignored("$command($param) introduced in $iv");
			next;
		}

		push @t, $k => $boolparams{$param} ? _to_bool($_) : $_
			for ref $v eq 'ARRAY' ? @$v : $v;
	}
	@t;
}

=method expandTerms %pairs|\@pairs
Used by M<queryTerms()> only.
=examples
  my @t = $solr->expandTerms('terms.lower.incl' => 'true');
  my @t = $solr->expandTerms([lower_incl => 1]);   # same

  my $r = $self->queryTerms(fl => 'subject', limit => 100);
=cut

sub expandTerms(@)
{	my $self = shift;
	my $p = @_==1 ? shift : [@_];
	my @t = $self->_simpleExpand($p, 'terms.');
	wantarray ? @t : \@t;
}

=method expandExtract %pairs|\@pairs
Used by M<extractDocument()>.

[0.93] If the key is C<literal> or C<literals>, then the keys in the
value HASH (or @pairs ARRAY) get 'literal.' prepended.  "Literals"
are fields you add yourself to the SolrCEL output.  Unless C<extractOnly>,
you need to specify the 'id' literal.

[0.94] You can also use C<fmap>, C<boost>, and C<resource> with an
HASH (or @pairs ARRAY).  [0.97] the value in each PAIR may be a SCALAR
(ref string) which circumvents some copying.

=example
  my $result = $solr->extractDocument(string => $document,
      resource_name => $fn, extractOnly => 1,
      literals => { id => 5, b => 'tic' }, literal_xyz => 42,
      fmap => { id => 'doc_id' }, fmap_subject => 'mysubject',
      boost => { abc => 3.5 }, boost_xyz => 2.0
  );
=cut

sub _expand_flatten($$)
{	my ($self, $v, $prefix) = @_;
	my @l = ref $v eq 'HASH' ? %$v : @$v;
	my @s;
	push @s, $prefix.(shift @l) => (shift @l) while @l;
	@s;
}

sub expandExtract(@)
{	my $self = shift;
	my @p = @_==1 ? @{(shift)} : @_;
	my @s;
	while(@p)
	{	my ($k, $v) = (shift @p, shift @p);
		if(!ref $v || ref $v eq 'SCALAR')
			{	push @s, $k => $v }
		elsif($k eq 'literal' || $k eq 'literals')
			{	push @s, $self->_expand_flatten($v, 'literal.') }
		elsif($k eq 'fmap' || $k eq 'boost' || $k eq 'resource')
			{	push @s, $self->_expand_flatten($v, "$k.") }
		else { panic "unknown set '$k'" }
	}

	my @t = @s ? $self->_simpleExpand(\@s) : ();
	wantarray ? @t : \@t;
}

=method expandSelect %pairs
The M<select()> method accepts many, many parameters.  These are passed
to modules in the server, which need configuration before being usable.

Besides the common parameters, like 'q' (query) and 'rows', there
are parameters for various (pluggable) backends, usually prefixed
by the backend abbreviation.
=over 4
=item * expand
=item * facet -> L<https://wiki.apache.org/solr/SimpleFacetParameters>
=item * hl (highlight) -> L<https://wiki.apache.org/solr/HighlightingParameters>
=item * mlt -> L<https://solr.apache.org/guide/8_11/morelikethis.html>
=item * stats -> L<https://wiki.apache.org/solr/StatsComponent>
=item * suggest -> L<https://solr.apache.org/guide/8_11/suggester.html>
=item * group -> L<https://wiki.apache.org/solr/FieldCollapsing>
=back

You may use WebService::Solr::Query to construct the query ('q').

=examples
  my @r = $solr->expandSelect(
      q => 'inStock:true', rows => 10,
      facet => {limit => -1, field => [qw/cat inStock/], mincount => 1},
      f_cat_facet => {missing => 1},
      hl    => {},
      mlt   => { fl => 'manu,cat', mindf => 1, mintf => 1 },
      stats => { field => [ 'price', 'popularity' ] },
      group => { query => 'price:[0 TO 99.99]', limit => 3 },
  );

  # becomes (one line)
  ...?rows=10&q=inStock:true
    &facet=true&facet.limit=-1&facet.field=cat
       &f.cat.facet.missing=true&facet.mincount=1&facet.field=inStock
    &mlt=true&mlt.fl=manu,cat&mlt.mindf=1&mlt.mintf=1
    &stats=true&stats.field=price&stats.field=popularity
    &group=true&group.query=price:[0+TO+99.99]&group.limit=3

=error set $set cannot be used per field, in $field.
=error field $field is not simple for a set.
=error unknown field set $set.
=cut

# probably more config later, currently only one column
# "also-per-field" means, not only $set.$more, but also f.$field.$set.$more
my %sets = (  #also-per-field?
	expand  => [0],
	facet   => [1],
	hl      => [1],
	mlt     => [0],
	stats   => [0],
	suggest => [0],
	group   => [0],
);

sub expandSelect(@)
{	my $self = shift;
	my @s;
	my (@flat, %seen_set);
	while(@_)
	{	my ($k, $v) = (shift, shift);
		$k =~ s/_/./g if $self->fieldKeySimplify;
		my @p = split /\./, $k;

		# fields are $set.$more or f.$field.$set.$more
		my $per_field    = $p[0] eq 'f' && @p > 2;
		my ($set, $more) = $per_field ? @p[2,3] : @p[0,1];

		if(my $def = $sets{$set})
		{	$seen_set{$set} = 1;
			!$per_field || $def->[0]
				or error __x"set {set} cannot be used per field, in {field}.", set => $set, field => $k;

			if(ref $v eq 'HASH')
			{	!$more or error __x"field {field} is not simple for a set.", field => $k;
				push @s, $self->_simpleExpand($v, "$k.");
			}
			elsif($more)    # skip $set=true for now
			{	push @flat, $k => $v;
			}
		}
		elsif(ref $v eq 'HASH')
		{	error __x"unknown field set {set}.", set => $set;
		}
		else
		{	push @flat, $k => $v;
		}
	}
	push @flat, %seen_set;
	unshift @s, $self->_simpleExpand(\@flat);
	wantarray ? @s : \@s;
}

=method deprecated $message
Produce a warning $message about deprecated parameters with the
indicated server version.

=warning deprecated solr $message
=cut

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

=method ignored $message
Produce a warning $message about parameters which will get ignored
because they were not yet supported by the indicated server version.

=warning ignored solr $message
=cut

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

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

=warning removed solr $message
=cut

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


#--------------------
=subsection Other helpers

=method endpoint $action, %options
Compute the address to be called (for HTTP)

=option  core $name
=default core M<new(core)>
If no core is specified, the default of the server is addressed.

=option  params %params|\@params
=default params []
The order of the parameters will be preserved when an ARRAY or parameters
is passed; you never know for a HASH.
=cut

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;

	# remove paramers with undefined value
	my @p = @$params;
	my @params;
	while(@p)
	{	push @params, $p[0] => $p[1] if defined $p[1];
		shift @p, shift @p;
	}

	$take->query_form(@params) if @params;
	$take;
}

=method request $url, $result, $body, $ct
Send a request to the server $url and return the response
(an HTTP::Response object).  A trace of the activity is
added to the $result object.  The $body of the request
can be provided as bytes or reference to bytes (SCALAR). The
content-type $ct must match the body bytes.

=alert Solr request failed with $code, $retries retries left: $!
=error Solr request failed with: $err
=fault Solr request failed after $elapse seconds after $retries retries: $!
=cut

sub request($$;$$)
{	my ($self, $url, $result, $body, $body_ct) = @_;

	my $req;
	if($body)
	{	# request with 'form' payload
		$req       = HTTP::Request->new(
			POST => $url,
			[ Content_Type        => $body_ct
			, Content_Disposition => 'form-data; name="content"'
			],
			(ref $body eq 'SCALAR' ? $$body : $body)
		);
	}
	else
	{	# request without payload
		$req = HTTP::Request->new(GET => $url);
	}

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

		error __x"Solr request failed with: {err}",
			err => ($result->solrError || $result->httpError), result => $result;
	}

	unless($resp->is_success)
	{	$! = $resp->code==500 ? ENETDOWN : ENETUNREACH;
		fault __x"Solr request failed after {elapse} seconds after {retries} retries",
			elapse => time - $start, retries => $self->{AS_retry_max} - $retries -1, result => $result;
	}

	$resp;
}

sub decodeResponse($) { undef }

#--------------------
=chapter DETAILS

=section Comparison with other implementations

=subsection Compared to WebService::Solr

WebService::Solr is a good module, with a lot of miles.  The main
differences is that C<Apache::Solr> has much more abstraction.

=over 4
=item * simplified parameter syntax, improving readibility
=item * real Perl-level boolean parameters, not 'true' and 'false'
=item * warnings for deprecated and ignored parameters
=item * smart result object with built-in trace and timing
=item * hidden paging of results
=item * flexible logging framework (Log::Report)
=item * both-way XML or both-way JSON, not requests in XML and answers in JSON
=item * access to plugings like terms and tika
=item * no Moose
=back

=cut

1;
