CouchDB::Client::DB - CouchDB::Client database

	use CouchDB::Client;
	my $c = CouchDB::Client->new(uri => 'https://dbserver:5984/');
	my $db = $c->newDB('my-stuff')->create;
	$db->dbInfo;
	my $doc = $db->newDoc('dahut.svg', undef, { foo => 'bar' })->create;
	my $dd = $db->newDesignDoc('dahut.svg', undef, $myViews)->create;
	#...
	$db->delete;

package CouchDB::Client::DB;

use strict;
use warnings;

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

use Carp        qw(confess);
use URI::Escape qw(uri_escape_utf8);
use CouchDB::Client::Doc;
use CouchDB::Client::DesignDoc;

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

	$opt{name}   || confess "CouchDB database requires a name.";
	$opt{client} || confess "CouchDB database requires a client.";

	return bless \%opt, $class;
}

sub validName {
	shift;
	my $name = shift;
	return $name =~ m{^[a-z0-9_\$\(\)\+/-]+/$};
}

sub uriName {
	my $self = shift;
	my $sn = uri_escape_utf8($self->{name});
	return "$sn";
}

sub dbInfo {
	my $self = shift;
	my $res = $self->{client}->req('GET', $self->uriName);
	return $res->{json} if $res->{success};
	confess("Connection error: $res->{msg}");
}

sub create {
	my $self = shift;
	my $res = $self->{client}->req('PUT', $self->uriName);
	return $self if $res->{success} and $res->{json}->{ok};
	confess("Database '$self->{name}' exists: $res->{msg}") if $res->{status} == 409;
	confess("Connection error: $res->{msg}");
}

sub delete {
	my $self = shift;
	my $res = $self->{client}->req('DELETE', $self->uriName);
	return 1 if $res->{success} and $res->{json}->{ok};
	confess("Database '$self->{name}' not found: $res->{msg}") if $res->{status} == 404;
	confess("Connection error: $res->{msg}");
}

sub replicate {
	my $self = shift;
	my %args = @_;

	my $name = $self->{name};
	$name =~ s/\/$//;

	my $json;
	if (defined($args{source}) && defined($args{target})) {
		confess("Source and target can't be used at the sametime.");
	}
	elsif (defined($args{source})) {
		$json->{source} = $args{source};  # pull replication
		$json->{target} = $name;
	}
	elsif (defined($args{target})) {
		$json->{source} = $name;          # push replication
		$json->{target} = $args{target};
	}
	else {
		confess("Either source or target is required.");
	}

	my @flags = ('continuous');

	my ($M,$m,undef) = split(/\./,$self->{client}->serverInfo()->{version});
	if ($m > 10) {
		# This flag was added after v0.10
		push(@flags,'create_target');
	}

	foreach (@flags) {
		$json->{$_} = (defined($args{$_}) && $args{$_})?$self->{client}->{json}->true:$self->{client}->{json}->false;
	}

	my $res = $self->{client}->req('POST','_replicate',$json);
	confess("Error replicating database: $res->{msg}") if $res->{status} >= 300;

	return $res->{json};
}

sub newDoc {
	my $self = shift;
	my $id = shift;
	my $rev = shift;
	my $data = shift;
	my $att = shift;
	return CouchDB::Client::Doc->new(id => $id, rev => $rev, data => $data, attachments => $att, db => $self);
}

sub listDocIdRevs {
	my $self = shift;
	my %args = @_;
	my $qs = %args ? $self->argsToQuery(%args) : '';
	my $res = $self->{client}->req('GET', $self->uriName . '/_all_docs' . $qs);
	confess("Connection error: $res->{msg}") unless $res->{success};
	return [
		map {
			{
				id  => $_->{id},
				rev => ($_->{value}->{rev})? # The correct key may be version specific;
					$_->{value}->{rev}:      # v0.10.1 returns rev under this key,
					$_->{value}->{_rev}      # older versions may return it here.
			}
		} @{$res->{json}->{rows}}];
}

sub listDocs {
	my $self = shift;
	my %args = @_;
	return [ map { $self->newDoc($_->{id}, $_->{rev}) } @{$self->listDocIdRevs(%args)} ];
}

sub docExists {
	my $self = shift;
	my $id = shift;
	my $rev = shift;
	if ($rev) {
		return (grep { $_->{id} eq $id and $_->{rev} eq $rev } @{$self->listDocIdRevs}) ? 1 : 0;
	}
	else {
		return (grep { $_->{id} eq $id } @{$self->listDocIdRevs}) ? 1 : 0;
	}
}

sub newDesignDoc {
	my $self = shift;
	my $id = shift;
	my $rev = shift;
	my $data = shift;
	return CouchDB::Client::DesignDoc->new(id => $id, rev => $rev, data => $data, db => $self);
}

sub listDesignDocIdRevs {
	my $self = shift;
	my %args = @_;
	return [grep { $_->{id} =~ m{^_design/} } @{$self->listDocIdRevs(%args)}];
}

sub listDesignDocs {
	my $self = shift;
	my %args = @_;
	return [ map { $self->newDesignDoc($_->{id}, $_->{rev}) } @{$self->listDesignDocIdRevs(%args)} ];
}

sub designDocExists {
	my $self = shift;
	my $id = shift;
	my $rev = shift;
	$id = "_design/$id" unless $id =~ m{^_design/};
	if ($rev) {
		return (grep { $_->{id} eq $id and $_->{rev} eq $rev } @{$self->listDesignDocIdRevs}) ? 1 : 0;
	}
	else {
		return (grep { $_->{id} eq $id } @{$self->listDesignDocIdRevs}) ? 1 : 0;
	}
}

sub tempView {
	my $self = shift;
	my $view = shift;
	my $res = $self->{client}->req('POST', $self->uriName . '/_temp_view', $view);
	return $res->{json} if $res->{success};
	confess("Connection error: $res->{msg}");
}

sub bulkStore {
	my $self = shift;
	my $docs = shift;
	my $json = { docs => [map { $_->contentForSubmit } @$docs] };
	my $res = $self->{client}->req('POST', $self->uriName . '/_bulk_docs', $json);
	confess("Connection error: $res->{msg}") unless $res->{success};
	my $i = 0;

	# versions prior to 0.9 returned the results under the new_revs key,
	# newer versions just return an array.
	my $list = (ref($res->{json}) eq "ARRAY")?$res->{json}:$res->{json}->{new_revs};
	for my $ok (@{$list}) {
		my $doc = $docs->[$i];
		$doc->{id} = $ok->{id} unless $doc->{id};
		$doc->{rev} = $ok->{rev};
		$i++;
	}
	return $res->{json} if $res->{success};
}

sub bulkDelete {
	my $self = shift;
	my $docs = shift;
	my $json = { docs => [map { my $cnt = $_->contentForSubmit; $cnt->{_deleted} = $self->{client}->{json}->true; $cnt; } @$docs] };
	my $res = $self->{client}->req('POST', $self->uriName . '/_bulk_docs', $json);
	confess("Connection error: $res->{msg}") unless $res->{success};
	my $i = 0;

	# versions prior to 0.9 returned the results under the new_revs key,
	# newer versions just return an array.
	my $list = (ref($res->{json}) eq "ARRAY")?$res->{json}:$res->{json}->{new_revs};
	for my $ok (@{$list}) {
		my $doc = $docs->[$i];
		$doc->{deletion_stub_rev} = $ok->{rev};
		$doc->{rev} = '';
		$doc->data({});
		$doc->attachments({});
		$i++;
	}
	return $res->{json} if $res->{success};
}

# from docs
# key=keyvalue
# startkey=keyvalue
# startkey_docid=docid
# endkey=keyvalue
# count=max rows to return
# update=false
# descending=true
# skip=rows to skip
sub fixViewArgs {
	my $self = shift;
	my %args = @_;

	for my $k (keys %args) {
		if ($k eq 'key' or $k eq 'startkey' or $k eq 'endkey') {
			if (ref($args{$k}) eq 'ARRAY' or ref($args{$k}) eq 'HASH') {
				$args{$k} = $self->{client}->{json}->encode($args{$k});
			}
			else {
                                unless ($args{$k} =~ /^\d+(?:\.\d+)*$/s) {
                                        $args{$k} = '"' . $args{$k} . '"';
                                }
			}
		}
		elsif ($k eq 'descending') {
			if ($args{$k}) {
				$args{$k} = 'true';
			}
			else {
				delete $args{$k};
			}
		}
		elsif ($k eq 'update') {
			if ($args{$k}) {
				delete $args{$k};
			}
			else {
				$args{$k} = 'false';
			}
		}
	}
	return %args;
}

sub argsToQuery {
	my $self = shift;
	my %args = @_;
	%args = $self->fixViewArgs(%args);
	return  '?' .
			join '&',
			map { uri_escape_utf8($_) . '=' . uri_escape_utf8($args{$_}) }
			keys %args;
}

1;