Couch-DB

 view release on metacpan or  search on metacpan

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

package Couch::DB::Client;
use vars '$VERSION';
$VERSION = '0.006';


use Couch::DB::Util   qw(flat);
use Couch::DB::Result ();

use Log::Report 'couch-db';

use Scalar::Util    qw(weaken blessed);
use List::Util      qw(first);
use MIME::Base64    qw(encode_base64);
use Storable        qw(dclone);
use URI::Escape     qw(uri_escape);


sub new(@) { (bless {}, shift)->init( {@_} ) }

sub init($)
{	my ($self, $args) = @_;
	$self->{CDC_server} = my $server = delete $args->{server} or panic "Requires 'server'";
	$self->{CDC_name}   = delete $args->{name} || "$server";
	$self->{CDC_ua}     = delete $args->{user_agent} or panic "Requires 'user_agent'";
	$self->{CDC_uuids}  = [];

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

	$self->{CDC_hdrs}   = my $headers = delete $args->{headers} || {};

	my $username        = delete $args->{username} // '';
	$self->login(
		auth     => delete $args->{auth} || 'BASIC',
		username => $username,
		password => delete $args->{password},
	) if length $username;

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

package Couch::DB::Cluster;
use vars '$VERSION';
$VERSION = '0.006';


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

use Log::Report 'couch-db';

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} }

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

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

package Couch::DB::Database;
use vars '$VERSION';
$VERSION = '0.006';


use Log::Report 'couch-db';

use Couch::DB::Util   qw(flat);

use Scalar::Util      qw(weaken blessed);
use HTTP::Status      qw(HTTP_OK HTTP_NOT_FOUND);
use JSON::PP ();


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

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

	my $name = $self->{CDD_name} = delete $args->{name} or panic "Requires name";
	$name =~ m!^[a-z][a-z0-9_$()+/-]*$!
		or error __x"Illegal database name '{name}'.", name => $name;

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

	$self->{CDD_batch} = delete $args->{batch};
	$self;
}

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

sub name()  { $_[0]->{CDD_name} }
sub couch() { $_[0]->{CDD_couch} }
sub batch() { $_[0]->{CDD_batch} }

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

# SPDX-FileCopyrightText: 2024 Mark Overmeer <mark@overmeer.net>
# SPDX-License-Identifier: Artistic-2.0

package Couch::DB::Document;
use vars '$VERSION';
$VERSION = '0.006';

use Couch::DB::Util;

use Log::Report 'couch-db';
use Scalar::Util             qw/weaken/;
use MIME::Base64             qw/decode_base64/;
use Devel::GlobalDestruction qw/in_global_destruction/;


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

sub init($)
{	my ($self, $args) = @_;
	$self->{CDD_id}    = delete $args->{id};
	$self->{CDD_db}    = my $db = delete $args->{db};
	$self->{CDD_info}  = {};
	$self->{CDD_batch} = exists $args->{batch} ? delete $args->{batch} : $db->batch;
	$self->{CDD_revs}  = my $revs = {};
	$self->{CDD_local} = delete $args->{local};

	$self->{CDD_couch} = $db->couch;
	weaken $self->{CDD_couch};

	if(my $content = delete $args->{content})
	{	$revs->{_new} = $content;
	}

	# The Document is (for now) not linked to its Result source, because
	# that might consume a lot of memory.  Although it may help debugging.
	# weaken $self->{CDD_result} = my $result = delete $args->{result};

	$self;
}

sub DESTROY()
{	my $self = shift;
	$self->{CDD_revs}{_new} || ! in_global_destruction
		or panic "Unsaved new document.";
}

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

package Couch::DB::Node;
use vars '$VERSION';
$VERSION = '0.006';


use Couch::DB::Util;

use Log::Report 'couch-db';

use Scalar::Util   qw/weaken/;


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

sub init($)
{	my ($self, $args) = @_;
	$self->{CDN_name} = delete $args->{name} // panic "Node has no name";

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

	$self;
}

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

sub name()  { $_[0]->{CDN_name} }
sub couch() { $_[0]->{CDN_couch} }

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

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

package Couch::DB::Result;
use vars '$VERSION';
$VERSION = '0.006';


use Couch::DB::Util     qw(flat pile);
use Couch::DB::Document ();

use Log::Report   'couch-db';
use HTTP::Status  qw(is_success status_constant_name HTTP_OK HTTP_CONTINUE HTTP_MULTIPLE_CHOICES);
use Scalar::Util  qw(weaken blessed);

my %couch_code_names   = ();   # I think I saw them somewhere.  Maybe none

my %default_code_texts = (  # do not construct them all the time again
	&HTTP_OK				=> 'Data collected successfully.',
	&HTTP_CONTINUE			=> 'The data collection is delayed.',
	&HTTP_MULTIPLE_CHOICES	=> 'The Result object does not know what to do, yet.',
);


use overload
	bool => sub { $_[0]->code < 400 };


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

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

	$self->{CDR_couch}     = delete $args->{couch} or panic;
	weaken $self->{CDR_couch};

	$self->{CDR_on_final}  = pile delete $args->{on_final};
	$self->{CDR_on_error}  = pile delete $args->{on_error};
	$self->{CDR_on_chain}  = pile delete $args->{on_chain};
	$self->{CDR_on_values} = pile delete $args->{on_values};
	$self->{CDR_code}      = HTTP_MULTIPLE_CHOICES;
	$self->{CDR_page}      = delete $args->{paging};

	$self;
}

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

sub isLastPage() { $_[0]->_thisPage->{end_reached} }

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

sub setFinalResult($%)
{	my ($self, $data, %args) = @_;
	my $code = delete $data->{code} || HTTP_OK;

	$self->{CDR_client}   = my $client = delete $data->{client} or panic "No client";
	weaken $self->{CDR_client};

	$self->{CDR_ready}    = 1;
	$self->{CDR_request}  = delete $data->{request};
	$self->{CDR_response} = delete $data->{response};
	$self->status($code, delete $data->{message});

	delete $self->{CDR_answer};  # remove cached while paging
	delete $self->{CDR_values};

	# "on_error" handler