view release on metacpan or  search on metacpan

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

# This code is part of Perl distribution Couch-DB version 0.201.
# The POD got stripped from this file by OODoc version 3.06.
# For contributors see file ChangeLog.

# This software is copyright (c) 2024-2026 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later


package Couch::DB::Design;{
our $VERSION = '0.201';
}

use parent 'Couch::DB::Document';

use warnings;
use strict;

use Couch::DB::Util;

use Log::Report 'couch-db';

use URI::Escape  qw/uri_escape/;
use Scalar::Util qw/blessed/;

my $id_generator;

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

sub init($)
{	my ($self, $args) = @_;
	my $which = $args->{id} || $id_generator->($args->{db} or panic);
	my ($id, $base) = $which =~ m!^_design/(.*)! ? ($which, $1) : ("_design/$which", $which);
	$args->{id} = $id;

	$self->SUPER::init($args);
	$self->{CDD_base} = $base;
	$self;
}

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

$id_generator = sub ($) { $_[0]->couch->freshUUID };
sub setIdGenerator($) { $id_generator = $_[1] }


sub idBase() { $_[0]->{CDD_base} }

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

sub create($%)
{	my $self = shift;
	$self->update(@_);
}


sub update($%)
{	my ($self, $data, %args) = @_;
	$data->{_id} = $self->id;

	$self->couch
		->toJSON($data, bool => qw/autoupdate/)
		->check($data->{lists}, deprecated => '3.0.0', 'DesignDoc create() option list')
		->check($data->{lists}, removed    => '4.0.0', 'DesignDoc create() option list')
		->check($data->{show},  deprecated => '3.0.0', 'DesignDoc create() option show')
		->check($data->{show},  removed    => '4.0.0', 'DesignDoc create() option show')
		->check($data->{rewrites}, deprecated => '3.0.0', 'DesignDoc create() option rewrites');

	#XXX Do we need more parameter conversions in the nested queries?

	$self->SUPER::create($data, %args);
}

# get/delete/etc. are simply produced by extension of the _pathToDoc() which
# adds "_design/" to the front of the path.

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

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

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

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

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

	my $send  = +{ %$config, ddoc => $self->id };
	my $couch = $self->couch;
	$couch->toJSON($send, bool => qw/partitioned/);

	$couch->call(POST => $self->db->_pathToDB('_index'),
		send => $send,
		$couch->_resultsConfig(\%args),
	);
}


sub deleteIndex($%)
{	my ($self, $ddoc, $index, %args) = @_;
	my $id = $self->idBase;  # id() would also work
	$self->couch->call(DELETE => $self->db->_pathToDB("_index/$id/json/" . uri_escape($index)),
		$self->couch->_resultsConfig(\%args),
	);
}


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

	  (	answer    => $answer,