# Copyrights 2012-2022 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution Apache-Solr.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Apache::Solr::Result;
use vars '$VERSION';
$VERSION = '1.06';


use warnings;
no warnings 'recursion';  # linked list of pages can get deep

use strict;

use Log::Report    qw(solr);
use Time::HiRes    qw(time);
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 = $self->{ASR_params} = $args->{params} or panic;
    $self->{ASR_endpoint} = $args->{endpoint}     or panic;

    my %params            = @$p;

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

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

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()
{   my $self = shift;
    my @errors;
    if(my $h = $self->httpError)   { push @errors, "HTTP error:",   "   $h" }
    if(my $a = $self->serverError) 
    {   $a =~ s/^/   /gm;
        push @errors, "Server error:", $a;
    }
    if(my $s = $self->solrError)   { push @errors, "Solr error:",   "   $s" }
    join "\n", @errors, '';
}

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

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

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

    $results->{numFound};
}


sub selected($%)
{   my ($self, $rank, %options) = @_;
    my $result   = $self->_getResults
        or panic __x"there are no results in the answer";

	# start for next
    $self->{ASR_next} = $rank +1;

    # in this page?
    my $startnr  = $result->{start};
    if($rank >= $startnr)
    {   my $docs = $result->{doc} // $result->{docs} // [];

        # Decoding XML without schema may give unexpect results
        $docs    = [ $docs ] if ref $docs eq 'HASH'; # when only one result

        if($rank - $startnr < @$docs)
        {   my $doc = $docs->[$rank - $startnr];
            return Apache::Solr::Document->fromResult($doc, $rank);
        }
    }

    $rank < $result->{numFound}       # outside answer range
        or return ();
 
    my $pagenr  = $self->selectedPageNr($rank);
    my $page    = $self->selectedPage($pagenr)
               || $self->selectedPageLoad($pagenr, $self->core);
    $page->selected($rank);
}


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 @_;

    my $r = $self->{ASR_terms}{$field}
        or error __x"no search for terms on field {field} requested"
            , field => $field;

    $r;
}

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

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


sub selectedPageNr($) { my $pz = shift->selectedPageSize; int(shift() / $pz) }
sub selectPages()     { @{shift->{ASR_pages}} }
sub selectedPage($)   { my $pages = shift->{ASR_pages}; $pages->[shift()] }
sub selectedPageSize()
{   my $result = shift->selectedPage(0)->_getResults || {};
    my $docs   = $result->{doc} // $result->{docs};
    ref $docs eq 'HASH'  ? 1 : ref $docs eq 'ARRAY' ? scalar @$docs : 50;
}


sub selectedPageLoad($;$)
{   my ($self, $pagenr, $client) = @_;
    $client
        or error __x"cannot autoload page {nr}, no client provided"
             , nr => $pagenr;

    my $pz     = $self->selectedPageSize;
    my @params = $self->replaceParams
      ( {start => $pagenr * $pz, rows => $pz}, $self->params);

    my $page   = $client->select(@params);
    my $pages  = $self->{ASR_pages};

    # put new page in shared table of pages
    $pages->[$pagenr] = $page;
    $page->_pageset($pages);

	# purge cached previous pages when in sequential mode
	if($pagenr != 0 && $self->sequential)
    {   $pages->[$_] = undef for 0..$pagenr-1;
    }

	$page;
}


sub replaceParams($@)
{   my ($self, $new) = (shift, shift);
    my @out;
    while(@_)
    {    my ($k, $v) = (shift, shift);
         $v = delete $new->{$k} if $new->{$k};
         push @out, $k => $v;
    }
    (@out, %$new);
}

1;
