view release on metacpan or  search on metacpan

lib/Couch/DB/Result.pm  view on Meta::CPAN

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

# This software is copyright (c) 2024-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 Couch::DB::Result;{
our $VERSION = '0.201';
}


use warnings;
use strict;

use Couch::DB::Util     qw/flat pile/;
use Couch::DB::Document ();
use Couch::DB::Row      ();

use Log::Report   'couch-db';
use HTTP::Status  qw/is_success status_constant_name HTTP_OK HTTP_CONTINUE HTTP_MULTIPLE_CHOICES/;
use Scalar::Util  qw/weaken blessed/;

my %couch_code_names   = ();   # I think I saw them somewhere.  Maybe none

my %default_code_texts = (  # do not construct them all the time again
	&HTTP_OK				=> 'Data collected successfully.',
	&HTTP_CONTINUE			=> 'The data collection is delayed.',
	&HTTP_MULTIPLE_CHOICES	=> 'The Result object does not know what to do, yet.',
);

my $seqnr = 0;

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

use overload
	bool     => sub { $_[0]->code < 400 },
	'""'     => 'short',
	fallback => 1;

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

sub new(@) { my ($class, %args) = @_; (bless {}, $class)->init(\%args) }

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

	$self->{CDR_couch}     = delete $args->{couch} or panic;
	$self->{CDR_on_final}  = pile delete $args->{on_final};
	$self->{CDR_on_error}  = pile delete $args->{on_error};
	$self->{CDR_on_chain}  = pile delete $args->{on_chain};
	$self->{CDR_on_values} = pile delete $args->{on_values};
	$self->{CDR_on_row}    = pile delete $args->{on_row};
	$self->{CDR_code}      = HTTP_MULTIPLE_CHOICES;
	$self->{CDR_page}      = delete $args->{paging};
	$self->{CDR_seqnr}     = ++$seqnr;

	$self;
}

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

sub couch()     { $_[0]->{CDR_couch}  }
sub isDelayed() { $_[0]->code == HTTP_CONTINUE }
sub isReady()   { $_[0]->{CDR_ready} }


sub code()      { $_[0]->{CDR_code} }


sub codeName(;$)
{	my ($self, $code) = @_;
	$code ||= $self->code;
	status_constant_name($code) || couch_code_names{$code} || $code;
}


sub message()
{	my $self = shift;
	$self->{CDR_msg} || $default_code_texts{$self->code} || $self->codeName;
}

lib/Couch/DB/Result.pm  view on Meta::CPAN

	$next{start} += (delete $next{skip}) + @{$self->_rowsRef(0)};
	$next{pagenr}++;
	\%next;
}


sub page()
{	my $self = shift;

	$self->inPagingMode
		or panic "Call not in paging mode, use the row* and doc* alternative methods.";

	$self->_thisPage->{harvested};
}

sub _pageAdd($$)
{	my ($self, $bookmark, $found) = @_;
	my $this = $self->_thisPage;
	my $page = $this->{harvested};
	push @$page, @$found;

	if(defined $bookmark)
	{	my $recv = $this->{start} + $this->{skip} + @$page;
		$this->{bookmarks}{$recv} = $bookmark;
	}

	$this->{end_reached} = ! @$found || $this->{stop}->($self);
	$page;
}


sub pageRows() { @{$_[0]->page} }


sub pageNumber() { $_[0]->_thisPage->{pagenr} }


sub pageDocs() { map $_->doc, @{$_[0]->page} }


sub pageDoc($) { my $r = $_[0]->page->[$_[1]-1]; defined $r ? $r->doc : undef }


sub pageIsPartial()
{	my $this = shift->_thisPage;
		$this->{page_mode}
	&& ! $this->{end_reached}
	&& ($this->{all} || @{$this->{harvested}} < $this->{page_size});
}


sub isLastPage() { $_[0]->_thisPage->{end_reached} }

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

sub setFinalResult($%)
{	my ($self, $data, %args) = @_;
	my $code = delete $data->{code} || HTTP_OK;

	$self->{CDR_client}   = my $client = delete $data->{client} or panic "No client";
	weaken $self->{CDR_client};

	$self->{CDR_ready}    = 1;
	$self->{CDR_request}  = delete $data->{request};
	$self->{CDR_response} = delete $data->{response};
	$self->setStatus($code, delete $data->{message});

	delete $self->{CDR_answer};  # remove cached while paging
	delete $self->{CDR_values};
	delete $self->{CDR_rows};

	# "on_error" handler
	unless(is_success $code)
	{	$_->($self) for @{$self->{CDR_on_error}};
		return undef;
	}

	# "on_final" handler
	$_->($self) for @{$self->{CDR_on_final}};

	# "on_change" handler
	# First run inner chains, working towards outer
	my @chains = @{$self->{CDR_on_chain} || []};
	my $tail   = $self;

	while(@chains && $tail)
	{	$tail = (pop @chains)->($tail);
		blessed $tail && $tail->isa('Couch::DB::Result')
			or panic "Chain must return a Result object";
	}

	$tail;
}


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

	$self->{CDR_delayed}  = $plan;
	$self->setStatus(HTTP_CONTINUE);
	$self;
}


sub delayPlan() { $_[0]->{CDR_delayed} }

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

1;