view release on metacpan or  search on metacpan

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

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


sub __created($$)
{	my ($self, $result, $data) = @_;
	$result or return;

	my $v = $result->values;
	$v->{ok} or return;

	delete $data->{_id};  # do not polute the data
	$self->_saved($v->{id}, $v->{rev}, $data);
}

sub create($%)
{	my ($self, $data, %args) = @_;
	ref $data eq 'HASH' or panic "Attempt to create document without data.";

	my %query;
	$query{batch} = 'ok'
		if exists $args{batch} ? delete $args{batch} : $self->batch;

	# When the _id is (accidentally) undef, no new one will be picked
	$data->{_id} ||= $self->id;
	defined $data->{_id} or delete $data->{_id};

	$self->couch->call(POST => $self->db->_pathToDB,  # !!
		send     => $data,
		query    => \%query,
		$self->couch->_resultsConfig(\%args,
			on_final => sub { $self->__created($_[0], $data) },
		),
	);
}


sub update($%)
{	my ($self, $data, %args) = @_;
	ref $data eq 'HASH' or panic "Attempt to update the document without data.";

	my $couch     = $self->couch;

	my %query;
	$query{batch} = 'ok' if exists $args{batch} ? delete $args{batch} : $self->batch;
	$query{rev}   = delete $args{rev} || $self->rev;
	$query{new_edits} = delete $args{new_edits} if exists $args{new_edits};
	$couch->toQuery(\%query, bool => qw/new_edits/);

	$couch->call(PUT => $self->_pathToDoc,
		query    => \%query,
		send     => $data,
		$couch->_resultsConfig(\%args, on_final => sub { $self->__created($_[0], $data) }),
	);
}


sub __get($$)
{	my ($self, $result, $flags) = @_;
	$result or return;   # do nothing on unsuccessful access
	$self->_consume($result, $result->answer);

	# meta is a shortcut for other flags
	$flags->{conflicts} = $flags->{deleted_conflicts} = $flags->{revs_info} = 1
		if $flags->{meta};

	$self->{CDD_flags}      = $flags;
}

sub get(%)
{	my ($self, $flags, %args) = @_;
	my $couch = $self->couch;

	my %query  = $flags ? %$flags : ();
	$couch->toQuery(\%query,
		bool => qw/attachments att_encoding_info conflicts deleted_conflicts latest local_seq meta revs revs_info/);

	$couch->call(GET => $self->_pathToDoc,
		query    => \%query,
		$couch->_resultsConfig(\%args,
			on_final => sub { $self->__get($_[0], $flags) },
			_headers => { Accept => $args{attachments} ? 'multipart/related' : 'application/json' },
		),
	);
}


sub __delete($)
{	my ($self, $result) = @_;
	$result or return;

	my $v = $result->values;
	$self->_deleted($v->{rev}) if $v->{ok};
}

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