Couch-DB

 view release on metacpan or  search on metacpan

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

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
package Couch::DB::Client;{
our $VERSION = '0.200';
}
 
 
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);
 
my $seqnr = 0;
 
 
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_seqnr}  = ++$seqnr;
 
        $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

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
package Couch::DB::Cluster;{
our $VERSION = '0.200';
}
 
 
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

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
our $VERSION = '0.200';
}
 
 
use Log::Report 'couch-db';
 
use Couch::DB::Util   qw(flat);
use Couch::DB::Document ();
use Couch::DB::Design   ();
 
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

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
# SPDX-FileCopyrightText: 2024 Mark Overmeer <mark@overmeer.net>
# SPDX-License-Identifier: Artistic-2.0
 
package Couch::DB::Document;{
our $VERSION = '0.200';
}
 
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->row(delete $args->{row});
        $self;
}
 
sub DESTROY()
{       my $self = shift;
        $self->{CDD_revs}{_new} || ! in_global_destruction
                or panic "Unsaved new document.";
}

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

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
{       my ($self, $id, $rev, $data) = @_;
        $self->{CDD_id} ||= $id;
        $self->{CDD_revs}{$rev} = $data || delete $self->{CDD_revs}{_new};
}
 
 
sub row(;$)
{       my $self = shift;
        @_ or return $self->{CDD_row};
        $self->{CDD_row} = shift;
        weaken($self->{CDD_row});
        $self->{CDD_row};
}
 
#-------------
 
sub isLocal() { $_[0]->{CDD_local} }
 
 
sub isDeleted() { $_[0]->{CDD_deleted} }

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

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
package Couch::DB::Node;{
our $VERSION = '0.200';
}
 
 
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

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
our $VERSION = '0.200';
}
 
 
use Couch::DB::Util     qw(flat pile);
use Couch::DB::Document ();
use Couch::DB::Row      ();
 
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.',
);
 
my $seqnr = 0;

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

277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
 
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->setStatus($code, delete $data->{message});
 
        delete $self->{CDR_answer};  # remove cached while paging
        delete $self->{CDR_values};
        delete $self->{CDR_rows};