view release on metacpan or  search on metacpan

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

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

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