view release on metacpan or  search on metacpan

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

	#XXX needs extra features
	$self->couch->call(POST => $self->_pathToDB('_revs_diff'),
		send => $plan,
		$self->couch->_resultsConfig(\%args),
	);
}


#XXX seems not really a useful method.

sub revisionLimit(%)
{	my ($self, %args) = @_;

	$self->couch->call(GET => $self->_pathToDB('_revs_limit'),
		$self->couch->_resultsConfig(\%args),
	);
}


#XXX attribute of database creation

sub revisionLimitSet($%)
{	my ($self, $value, %args) = @_;

	$self->couch->call(PUT => $self->_pathToDB('_revs_limit'),
		send => int($value),
		$self->couch->_resultsConfig(\%args),
	);
}

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

sub design($)
{	my ($self, $which) = @_;

	return $which if blessed $which && $which->isa('Couch::DB::Design');
	Couch::DB::Design->new(id => $which, db => $self);
}


sub __designsPrepare($$$)
{	my ($self, $method, $data, $where) = @_;
	$method eq 'POST' or panic;
	my $s     = +{ %$data };

	# Very close to a view search, but not equivalent.  At least: according to the
	# API documentation :-(
	$self->couch
		->toJSON($s, bool => qw/conflicts descending include_docs inclusive_end update_seq/)
		->toJSON($s, int  => qw/limit skip/);
	$s;
}

sub __designsRow($$%)
{	my ($self, $result, $index, %args) = @_;
	my $answer = $result->answer->{rows}[$index] or return;
	my $values = $result->values->{rows}[$index];

	( answer    => $answer,
		values    => $values,
		ddocdata  => $values->{doc},
		docparams => { db => $self },
	);
}

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

	my ($method, $path, $send) = (GET => $self->_pathToDB('_design_docs'), undef);
	if(@search)
	{	$method = 'POST';
		my @s   = map $self->__designsPrepare($method, $_), @search;

		if(@search==1)
		{	$send  = $s[0];
		}
		else
		{	$send  = +{ queries => \@s };
			$path .= '/queries';
		}
	}

	$self->couch->call($method => $path,
		($send ? (send => $send) : ()),
		$couch->_resultsConfig(\%args,
			on_row => sub { $self->__designsRow(@_, queries => scalar(@search)) },
		),
	);
}


sub __indexesRow($$%)
{	my ($self, $result, $index, %args) = @_;
	my $answer = $result->answer->{indexes}[$index] or return ();

	(	answer => $answer,
		values => $result->values->{indexes}[$index],
	);
}

sub __indexesValues()
{	my ($self, $raw) = @_;
	my %values = %$raw;   # deep not needed (yes)
	$self->couch->toPerl(\%values, bool => qw/partitioned/);
	$values{design} = $self->design($values{ddoc}) if $values{ddoc};
	\%values;
}

sub indexes(%)
{	my ($self, %args) = @_;

	$self->couch->call(GET => $self->_pathToDB('_index'),
		$self->couch->_resultsConfig(\%args,
			on_values => sub { $self->__indexesValues(@_) },
			on_row    => sub { $self->__indexesRow(@_) },
		),
	);
}

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

	my $issues  = delete $args{issues} || sub {};

	my @plan;
	foreach my $doc (@$docs)
	{	my $rev     = $doc->rev;
		my %plan    = %{$doc->revision($rev)};
		$plan{_id}  = $doc->id;
		$plan{_rev} = $rev if $rev ne '_new';
		push @plan, \%plan;
	}

	my @deletes = flat delete $args{delete};
	foreach my $del (@deletes)
	{	push @plan, +{ _id => $del->id, _rev => $del->rev, _deleted => JSON::PP::true };
		$couch->toJSON($plan[-1], bool => qw/_delete/);
	}

	@plan or error __x"need at least on document for bulk processing.";
	my $send    = +{ docs => \@plan };

	$send->{new_edits} = delete $args{new_edits} if exists $args{new_edits};  # default true
	$couch->toJSON($send, bool => qw/new_edits/);

	$couch->call(POST => $self->_pathToDB('_bulk_docs'),
		send     => $send,
		$couch->_resultsConfig(\%args,
			on_final => sub { $self->__bulk($_[0], $docs, \@deletes, $issues) },
		),
	);
}


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

	my $query;
	$query->{revs} = delete $args{revs} if exists $args{revs};
	$couch->toQuery($query, bool => qw/revs/);

	@$docs or error __x"need at least one document for bulk query.";

	#XXX what does "conflicted documents mean?
	#XXX what does "a": 1 mean in its response?

	$self->couch->call(POST => $self->_pathToDB('_bulk_get'),
		query => $query,
		send  => { docs => $docs },
		$couch->_resultsConfig(\%args),
	);
}


sub __allDocsRow($$%)
{	my ($self, $result, $index, %args) = @_;
	my $answer = $result->answer->{rows}[$index] or return ();
	my $values = $result->values->{rows}[$index];

	(	answer    => $answer,
		values    => $values,
		docdata   => $values->{doc},
		docparams => { local => $args{local}, db => $self },
	);
}

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

	my @search = flat $search;
	my $part   = delete $args{partition};
	my $local  = delete $args{local};
	my $view   = delete $args{view};
	my $ddoc   = delete $args{design};
	my $ddocid = blessed $ddoc ? $ddoc->id : $ddoc;

	#XXX The API shows some difference in the parameter combinations, which do not
	#XXX need to be there.  For now, we produce an error for these cases.
	!$view  || $ddoc  or panic "allDocs(view) requires design document.";
	!$local || !$part or panic "allDocs(local) cannot be combined with partition.";
	!$local || !$view or panic "allDocs(local) cannot be combined with a view.";
	!$part  || @search < 2 or panic "allDocs(partition) cannot work with multiple searches.";

	my $set
	= $local ? '_local_docs'
	:   ($part ? '_partition/'. uri_escape($part) . '/' : '')
		. ($view ? "_design/$ddocid/_view/". uri_escape($view) : '_all_docs');

	my $method = !@search || $part ? 'GET' : 'POST';
	my $path   = $self->_pathToDB($set);

	# According to the spec, _all_docs is just a special view.
	my @send   = map $self->_viewPrepare($method, $_, "docs search"), @search;

	my @params;
	if($method eq 'GET')
	{	@send < 2 or panic "Only one search with docs(GET)";
		@params = (query => $send[0]);
	}
	elsif(@send==1)
	{	@params = (send  => $send[0]);
	}
	else
	{	$couch->check(1, introduced => '2.2.0', 'Bulk queries');
		@params = (send => +{ queries => \@send });
		$path .= '/queries';
	}

	$couch->call($method => $path,
		@params,
		$couch->_resultsPaging(\%args,
			on_row   => sub { $self->__allDocsRow(@_, local => $local, queries => scalar(@search)) },
		),
	);
}

my @docview_bools = qw/
	conflicts descending group include_docs attachments att_encoding_info
	inclusive_end reduce sorted stable update_seq
/;

# Handles standard view/_all_docs/_local_docs queries.
sub _viewPrepare($$$)
{	my ($self, $method, $data, $where) = @_;
	my $s     = +{ %$data };
	my $couch = $self->couch;

	# Main doc in 1.5.4.  /{db}/_design/{ddoc}/_view/{view}
	if($method eq 'GET')
	{	$couch
			->toQuery($s, bool => @docview_bools)
			->toQuery($s, json => qw/endkey end_key key keys start_key startkey/);
	}
	else
	{	$couch
			->toJSON($s, bool => @docview_bools)
			->toJSON($s, int  => qw/group_level limit skip/);
	}

	$couch
		->check($s->{attachments}, introduced => '1.6.0', 'Search attribute "attachments"')
		->check($s->{att_encoding_info}, introduced => '1.6.0', 'Search attribute "att_encoding_info"')
		->check($s->{sorted}, introduced => '2.0.0', 'Search attribute "sorted"')
		->check($s->{stable}, introduced => '2.1.0', 'Search attribute "stable"')
		->check($s->{update}, introduced => '2.1.0', 'Search attribute "update"');

	$s;
}


sub __findRow($$%)
{	my ($self, $result, $index, %args) = @_;
	my $answer = $result->answer->{docs}[$index] or return ();
	my $values = $result->values->{docs}[$index];

	  (	answer    => $answer,
		values    => $values,
		docdata   => $values,
		docparams => { local => $args{local}, db => $self },
	  );
}

sub find($%)
{	my ($self, $search, %args) = @_;

	my $part   = delete $args{partition};
	$search->{selector} ||= {};

	my $path   = $self->_pathToDB;
	$path     .= '/_partition/'. uri_escape($part) if $part;

	$self->couch->call(POST => "$path/_find",
		send   => $self->_findPrepare(POST => $search),
		$self->couch->_resultsPaging(\%args,
			on_row => sub { $self->__findRow(@_) },
		),
	);
}

sub _findPrepare($$)
{	my ($self, $method, $data, $where) = @_;
	my $s = +{ %$data };  # no nesting

	$method eq 'POST' or panic;

	$self->couch
		->toJSON($s, bool => qw/conflicts update stable execution_stats/)
		->toJSON($s, int  => qw/limit sip r/)
		#XXX Undocumented when this got deprecated
		->check(exists $s->{stale}, deprecated => '3.0.0', 'Database find(stale)');

	$s;
}


sub findExplain(%)
{	my ($self, $search, %args) = @_;
	my $part = delete $args{partition};
	$search->{selector} ||= {};

	my $path  = $self->_pathToDB;
	$path    .= '/_partition/' . uri_escape($part) if $part;

	$self->couch->call(POST => "$path/_explain",
		send => $self->_findPrepare(POST => $search),
		$self->couch->_resultsConfig(\%args),
	);
}

1;