view release on metacpan or  search on metacpan

lib/Couch/DB/Cluster.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

#oorestyle: not found P for method shardsForDoc($db)
#oorestyle: not found P for method shardsForDoc($db)

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


use warnings;
use strict;

use Log::Report 'couch-db';

use Couch::DB::Util qw/flat/;;

use Scalar::Util    qw/weaken/;
use URI::Escape     qw/uri_escape/;
use Storable        qw/dclone/;

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

sub new(@) { my ($class, %args) = @_; (bless {}, $class)->init(\%args) }

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

	$self->{CDC_couch} = delete $args->{couch} or panic "Requires couch";
	weaken $self->{CDC_couch};

	$self;
}


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

sub couch() { $_[0]->{CDC_couch} }

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

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

	my %query;
	my @need = flat delete $args{ensure_dbs_exists};
	$query{ensure_dbs_exists} = $self->couch->jsonText(\@need, compact => 1)
		if @need;

	$self->couch->call(GET => '/_cluster_setup',
		introduced => '2.0.0',
		query      => \%query,
		$self->couch->_resultsConfig(\%args),
	);
}


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

	$self->couch->toJSON($config, int => qw/port node_count/);

	$self->couch->call(POST => '/_cluster_setup',
		introduced => '2.0.0',
		send       => $config,
		$self->couch->_resultsConfig(\%args),
	);
}

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

sub reshardStatus(%)
{	my ($self, %args) = @_;
	my $path = '/_reshard';
	$path   .= '/state' unless delete $args{counts};

	$self->couch->call(GET => $path,
		introduced => '2.4.0',
		$self->couch->_resultsConfig(\%args),
	);
}


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

	my %send   = (
		state  => (delete $args{state} or panic "Requires 'state'"),
		reason => delete $args{reason},
	);