view release on metacpan or  search on metacpan

lib/CouchDB/Client/Doc.pm  view on Meta::CPAN

	$content->{_id} = $self->{id} if $self->{id};
	$content->{_rev} = $self->{rev} if $self->{rev};
	$content->{_attachments} = $self->{attachments} if $self->{attachments} and keys %{$self->{attachments}};
	return $content;
}

sub retrieve {
	my $self = shift;

	my $res = $self->{db}->{client}->req('GET', $self->uriName);
	confess("Object not found: $res->{msg}") if $res->{status} == 404;
	confess("Connection error: $res->{msg}") unless $res->{success};
	my $data = $res->{json};
	my %private;
	my @keys = keys %$data; # need to two-step this due to delete()
	for my $k (@keys) {
		if ($k =~ m/^_(.+)/) {
			$private{$1} = delete $data->{$k};
		}
	}
	$self->{data} = $data;
	$self->{id} = $private{id};
	$self->{rev} = $private{rev};
	$self->{attachments} = $private{attachments} if exists $private{attachments};
	return $self;
}

sub retrieveFromRev {
	my $self = shift;
	my $rev = shift;

	my $res = $self->{db}->{client}->req('GET', $self->uriName . '?rev=' . $rev);
	confess("Object not found: $res->{msg}") if $res->{status} == 404;
	confess("Connection error: $res->{msg}") unless $res->{success};
	my $data = $res->{json};
	my %private;
	my @keys = keys %$data; # need to two-step this due to delete()
	for my $k (@keys) {
		if ($k =~ m/^_(.+)/) {
			$private{$1} = delete $data->{$k};
		}
	}
	return ref($self)->new({
		id          => $self->id,
		rev         => $rev,
		attachments => $private{attachments},
		data        => $data,
		db          => $self->{db},
	});
}

sub revisionsInfo {
	my $self = shift;

	my $res = $self->{db}->{client}->req('GET', $self->uriName . '?revs_info=true');
	confess("Object not found: $res->{msg}") if $res->{status} == 404;
	confess("Connection error: $res->{msg}") unless $res->{success};
	return $res->{json}->{_revs_info};
}

sub update {
	my $self = shift;

	confess("Object hasn't been retrieved") unless $self->{id} and $self->{rev};
	my $content = $self->contentForSubmit;
	my $res = $self->{db}->{client}->req('PUT', $self->uriName, $content);
	confess("Storage error: $res->{msg}") unless $res->{success};
	$self->{rev} = $res->{json}->{rev};
	return $self;
}

sub delete {
	my $self = shift;

	confess("Object hasn't been retrieved") unless $self->{id} and $self->{rev};
	my $res = $self->{db}->{client}->req('DELETE', $self->uriName . "?rev=" . $self->rev);
	confess("Object not found: $res->{msg}") if $res->{status} == 404;
	confess("Connection error: $res->{msg}") unless $res->{success};
	$self->{deletion_stub_rev} = $res->{json}->{rev};
	$self->{rev} = '';
	$self->{data} = {};
	$self->{attachments} = {};
	return $self;
}

sub fetchAttachment {
	my $self = shift;
	my $attName = shift;

	confess("No such attachment: '$attName'") unless exists $self->{attachments}->{$attName};
	my $res = $self->{db}->{client}->{ua}->request(
		HTTP::Request->new('GET', $self->{db}->{client}->uriForPath($self->uriName . '/' . uri_escape_utf8($attName)))
	);
	return $res->content if $res->is_success;
	confess("Object not found: $res->{msg}");
}

sub addAttachment {
	my $self = shift;
	my $name = shift;
	my $ctype = shift;
	my $data = shift;

	$self->{attachments}->{$name} = {
		content_type    => $ctype,
		data            => $self->toBase64($data),
	};
	return $self;
}

sub deleteAttachment {
	my $self = shift;
	my $attName = shift;

	confess("No such attachment: '$attName'") unless exists $self->{attachments}->{$attName};
	delete $self->{attachments}->{$attName};
	return $self;
}

sub toBase64 {
	my $self = shift;