view release on metacpan or  search on metacpan

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

package CouchDB::Client::Doc;

use strict;
use warnings;

our $VERSION = $CouchDB::Client::VERSION;

use HTTP::Request   qw();
use URI::Escape     qw(uri_escape_utf8);
use MIME::Base64    qw(encode_base64);
use Carp            qw(confess);

sub new {
	my $class = shift;
	my %opt = @_ == 1 ? %{$_[0]} : @_;

	confess "Doc needs a database" unless $opt{db};

	my %self = (
		id          => $opt{id} || '',
		rev         => $opt{rev} || '',
		attachments => $opt{attachments} || {},
		data        => $opt{data} || {},
		db          => $opt{db},
	);
	return bless \%self, $class;
}

sub id { return $_[0]->{id}; }
sub rev { return $_[0]->{rev}; }

sub data {
	my $self = shift;
	if (@_) {
		my $data = shift;
		$self->{attachments} = delete($data->{_attachments}) || {};
		$self->{data} = $data;
	}
	else {
		return $self->{data};
	}
}
sub attachments { @_ == 2 ? $_[0]->{attachments} = $_[1] : $_[0]->{attachments}; }

sub uriName {
	my $self = shift;
	return undef unless $self->{id};
	return $self->{db}->uriName . '/' . uri_escape_utf8($self->{id});
}

sub create {
	my $self = shift;

	confess("Object already had a revision") if $self->{rev};

	my $content = $self->contentForSubmit;
	my $res;
	if ($self->{id}) {
		$res = $self->{db}->{client}->req('PUT', $self->uriName, $content);
	}
	else {
		$res = $self->{db}->{client}->req('POST', $self->{db}->uriName, $content);
	}
	confess("Storage error: $res->{msg}") unless $res->{success};
	$self->{rev} = $res->{json}->{rev};
	$self->{id} = $res->{json}->{id} unless $self->{id};
	return $self;
}

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

	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;
	my $data = shift;

	my $ret = encode_base64 $data;
	$ret =~ s/\n//g;
	return $ret;
}

1;

=pod

=head1 NAME

CouchDB::Client::Doc - CouchDB::Client document

=head1 SYNOPSIS

	$doc->data->{foo} = 'new bar';
	$doc->addAttachment('file.xml', 'application/xml', '<foo/>);
	$doc->update;
	$doc->delete;

=head1 DESCRIPTION

This module represents documents in the CouchDB database.

We don't yet deal with a number of options such as retrieving revisions and
revision status.

=head1 METHODS