view release on metacpan or  search on metacpan

lib/Couch/DB/Document.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::Document;{
our $VERSION = '0.201';
}


use warnings;
use strict;

use Couch::DB::Util;

use Log::Report 'couch-db';
use Scalar::Util             qw/weaken/;
use MIME::Base64             qw/decode_base64/;
use Devel::GlobalDestruction qw/in_global_destruction/;

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

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

sub init($)
{	my ($self, $args) = @_;
	$self->{CDD_id}    = delete $args->{id};
	$self->{CDD_db}    = my $db = delete $args->{db};
	$self->{CDD_info}  = {};
	$self->{CDD_batch} = exists $args->{batch} ? delete $args->{batch} : $db->batch;
	$self->{CDD_revs}  = my $revs = {};
	$self->{CDD_local} = delete $args->{local};

	$self->{CDD_couch} = $db->couch;
	weaken $self->{CDD_couch};

	if(my $content = delete $args->{content})
	{	$revs->{_new} = $content;
	}

	# The Document is (for now) not linked to its Result source, because
	# that might consume a lot of memory.  Although it may help debugging.
	# weaken $self->{CDD_result} = my $result = delete $args->{result};

	$self->row(delete $args->{row});
	$self;
}

sub DESTROY()
{	my $self = shift;
	$self->{CDD_revs}{_new} || ! in_global_destruction
		or panic "Unsaved new document.";
}

sub _consume($$)
{	my ($self, $result, $data) = @_;
	my $id       = $self->{CDD_id} = delete $data->{_id};
	my $rev      = delete $data->{_rev};

	# Add all received '_' labels to the existing info.
	my $info     = $self->{CDD_info} ||= {};
	$info->{$_}  = delete $data->{$_}
		for grep /^_/, keys %$data;

	my $attdata = $self->{CDD_atts} ||= {};
	if(my $atts = $info->{_attachments})
	{	foreach my $name (keys %$atts)
		{	my $details = $atts->{$name};
			$attdata->{$name} = $self->couch->_attachment($result->response, $name)
				if $details->{follows};

			# Remove sometimes large data
			$attdata->{$name} = decode_base64 delete $details->{data} #XXX need decompression?
				if defined $details->{data};
		}
	}
	$self->{CDD_revs}{$rev} = $data;
	$self;
}


sub fromResult($$$%)
{	my ($class, $result, $data, %args) = @_;
	$class->new(%args, result => $result)->_consume($result, { %$data });
}

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

sub id()      { $_[0]->{CDD_id} }
sub db()      { $_[0]->{CDD_db} }
sub batch()   { $_[0]->{CDD_batch} }
sub couch()   { $_[0]->{CDD_couch} }

sub _pathToDoc(;$)
{	my ($self, $path) = @_;
	if($self->isLocal)
	{	$path and panic "Local documents not supported with path '$path'";
		return $self->db->_pathToDB('_local/' . $self->id);
	}
	$self->db->_pathToDB($self->id . (defined $path ? "/$path" : ''));
}

sub _deleted($)
{	my ($self, $rev) = @_;
	$self->{CDD_revs}{$rev} = {};
	$self->{CDD_deleted} = 1;
}

sub _saved($$;$)
{	my ($self, $id, $rev, $data) = @_;
	$self->{CDD_id} ||= $id;
	$self->{CDD_revs}{$rev} = $data || delete $self->{CDD_revs}{_new};
}


sub row(;$)
{	my $self = shift;
	@_ or return $self->{CDD_row};

	$self->{CDD_row} = shift;
	weaken($self->{CDD_row});
	$self->{CDD_row};
}

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

sub isLocal() { $_[0]->{CDD_local} }


sub isDeleted() { $_[0]->{CDD_deleted} }


sub revision($) { $_[0]->{CDD_revs}{$_[1]} }


sub latest() { $_[0]->revision(($_[0]->revisions)[0]) }



sub revisions()
{	my $revs = $_[0]->{CDD_revs};
	no warnings 'numeric';   # forget the "-hex" part of the rev
	sort {$b <=> $a} keys %$revs;
}


sub rev() { ($_[0]->revisions)[0] }

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

sub _info() { $_[0]->{CDD_info} or panic "no info yet." }


sub conflicts()        { @{ $_[0]->_info->{_conflicts} || [] } }
sub deletedConflicts() { @{ $_[0]->_info->{_deleted_conflicts} || [] } }
sub updateSequence()   { $_[0]->_info->{_local_seq} }


sub revisionsInfo()
{	my $self = shift;
	return $self->{CDD_revinfo} if $self->{CDD_revinfo};

	my $c = $self->_info->{_revs_info}
		or error __x"you have requested the open_revs detail for the document yet.";

	$self->{CDD_revinfo} = +{ map +($_->{rev} => $_), @$c };
}


sub revisionInfo($) { $_[0]->revisionsInfo->{$_[1]} }

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

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

	$self->couch->call(HEAD => $self->_pathToDoc,
		$self->couch->_resultsConfig(\%args),
	);
}