From 478a13f928ba0a40e6d6e3c58d4ee3ccdfde3aa3 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Tue, 26 Oct 2010 14:19:21 +0200 Subject: [PATCH 01/22] Add username and password attributes to the argument hash for CouchDB::Client::new. It's possible that as it is written now, it'll only work for database administrator accounts, due to the hardcoded realm string. Once i figure out what other realm strings CouchDB can use, I intend to add them as well to the credentials data in the UA object. --- lib/CouchDB/Client.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lib/CouchDB/Client.pm b/lib/CouchDB/Client.pm index 69f06b1..636c895 100644 --- a/lib/CouchDB/Client.pm +++ b/lib/CouchDB/Client.pm @@ -11,6 +11,7 @@ use LWP::UserAgent qw(); use HTTP::Request qw(); use Encode qw(encode); use Carp qw(confess); +use URI; use CouchDB::Client::DB; @@ -31,6 +32,16 @@ sub new { $self{json} = ($opt{json} || JSON::Any->new(utf8 => 1, allow_blessed => 1)); $self{ua} = ($opt{ua} || LWP::UserAgent->new(agent => "CouchDB::Client/$VERSION")); + if ($opt{username} and $opt{password}) { + my $uri = URI->new($self{uri}); + $self{ua}->credentials( + $uri->host . ':' . $uri->port, + 'administrator', + $opt{username}, + $opt{password}, + ); + } + return bless \%self, $class; } From fb25ebe6b765b35b1a8aeead79f610676c13a9e5 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Wed, 27 Oct 2010 11:57:59 +0200 Subject: [PATCH 02/22] Since the Basic auth realm is a configuration matter in couchdb, make it so here too. --- lib/CouchDB/Client.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/CouchDB/Client.pm b/lib/CouchDB/Client.pm index 636c895..c782dd1 100644 --- a/lib/CouchDB/Client.pm +++ b/lib/CouchDB/Client.pm @@ -36,7 +36,7 @@ sub new { my $uri = URI->new($self{uri}); $self{ua}->credentials( $uri->host . ':' . $uri->port, - 'administrator', + ($opt{realm} || 'administrator'), $opt{username}, $opt{password}, ); From ff84a633ce105f93391da82af5f2de4ef19545a0 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Wed, 27 Oct 2010 12:05:36 +0200 Subject: [PATCH 03/22] Add documentation for our new functionality. --- lib/CouchDB/Client.pm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/CouchDB/Client.pm b/lib/CouchDB/Client.pm index c782dd1..b97803a 100644 --- a/lib/CouchDB/Client.pm +++ b/lib/CouchDB/Client.pm @@ -148,11 +148,16 @@ This module is a client for the CouchDB database. =item new -Constructor. Takes a hash or hashref of options: C which specifies the server's URI; -C, C, C which are used if C isn't provided and default to 'http', -'localhost', and '5984' respectively; C which defaults to a JSON::Any object with -utf8 and allow_blessed turned on but can be replaced with anything with the same interface; -and C which is a LWP::UserAgent object and can also be replaced. +Constructor. Takes a hash or hashref of options: C which specifies the +server's URI; C, C, C which are used if C isn't +provided and default to 'http', 'localhost', and '5984' respectively; C +which defaults to a JSON::Any object with utf8 and allow_blessed turned on but +can be replaced with anything with the same interface; and C which is a +LWP::UserAgent object and can also be replaced. For ease of use you can also +pass C, C and C, which will if so be used to add +login credentials to the LWP::UserAgent object. C is optional, and will +if not specified default to "administrator" (which is the default used by +CouchDB). =item testConnection From 80e9190925ee8f89ef85080528d5d5450fc804be Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 1 Nov 2010 10:06:57 +0100 Subject: [PATCH 04/22] Add support for the 'group' boolean argument to view queries. --- lib/CouchDB/Client/DB.pm | 3 ++- t/12-small-things.t | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 23efa26..6d2eaa6 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -233,6 +233,7 @@ sub bulkDelete { # update=false # descending=true # skip=rows to skip +# group=do grouping for reducing views sub fixViewArgs { my $self = shift; my %args = @_; @@ -248,7 +249,7 @@ sub fixViewArgs { } } } - elsif ($k eq 'descending') { + elsif ($k eq 'descending' or $k eq 'group') { if ($args{$k}) { $args{$k} = 'true'; } diff --git a/t/12-small-things.t b/t/12-small-things.t index 3a941fa..df0f588 100644 --- a/t/12-small-things.t +++ b/t/12-small-things.t @@ -36,14 +36,16 @@ my $DB = $C->newDB('blah'); endkey => 'foo', descending => 1, update => 1, - keeps => 'me correctly' + keeps => 'me correctly', + group => 1, ); is_deeply(\%encoded, { startkey => '42', endkey => '"foo"', descending => 'true', - keeps => 'me correctly' + keeps => 'me correctly', + group => 'true', }, "fixViewArgs works as expected"); %encoded = $DB->fixViewArgs(descending => 0, update => 0); From 1b4a1c8a20aa92da57b3364555ef7eb4417b1b40 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 1 Nov 2010 11:18:18 +0100 Subject: [PATCH 05/22] Make it so we can create documents with entirely numeric ids. --- lib/CouchDB/Client/Doc.pm | 2 +- t/15-client.t | 12 +++++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lib/CouchDB/Client/Doc.pm b/lib/CouchDB/Client/Doc.pm index 01671c8..1ad8adf 100644 --- a/lib/CouchDB/Client/Doc.pm +++ b/lib/CouchDB/Client/Doc.pm @@ -71,7 +71,7 @@ sub create { sub contentForSubmit { my $self = shift; my $content = $self->{data}; - $content->{_id} = $self->{id} if $self->{id}; + $content->{_id} = '' . $self->{id} if $self->{id}; # Force stringness of id attribute $content->{_rev} = $self->{rev} if $self->{rev}; $content->{_attachments} = $self->{attachments} if $self->{attachments} and keys %{$self->{attachments}}; return $content; diff --git a/t/15-client.t b/t/15-client.t index 8a055c2..febbb64 100644 --- a/t/15-client.t +++ b/t/15-client.t @@ -21,7 +21,7 @@ if($cdb->testConnection) { plan skip_all => "Requires CouchDB version 0.8.0 or better; running $v"; } else { - plan tests => 77; + plan tests => 78; } } else { @@ -367,6 +367,16 @@ my $REP_DB; } } + +### Test for numeric id bug + +{ + my $numeric_id_doc = $DB->newDoc(17, undef, {some_data => 4711}); + eval {$numeric_id_doc->create}; + ok($numeric_id_doc && !$@, 'doc with numeric id created'); + eval {$numeric_id_doc->delete}; # cleanup +} + ### --- THE CLEANUP AT THE END $DD->delete; From 75f057c9b7106bc6571544de66c87c8da29ffa7b Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 1 Nov 2010 15:16:34 +0100 Subject: [PATCH 06/22] More subtle way to tell apart numeric and string values. --- lib/CouchDB/Client/DB.pm | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 6d2eaa6..b7a9ddc 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -11,6 +11,8 @@ use URI::Escape qw(uri_escape_utf8); use CouchDB::Client::Doc; use CouchDB::Client::DesignDoc; +use B qw[svref_2object SVf_IOK SVf_POK]; + sub new { my $class = shift; my %opt = @_ == 1 ? %{$_[0]} : @_; @@ -224,6 +226,32 @@ sub bulkDelete { return $res->{json} if $res->{success}; } +sub _is_currently_numeric($) { + # Get a B::-type object from whatever it is + my $ref = svref_2object(\$_[0]); + my $type = ref($ref); + + # It's a pure numeric value + return 1 if ($type eq 'B::NV' or $type eq 'B::IV'); + + # It's a pure string value. + return if $type eq 'B::PV'; + + # It has a current public integer value. + return 1 if $ref->FLAGS & SVf_IOK; + + # It's a mixed string/float. No way to tell which part is current without + # dropping to the C level, so let's always call it numeric. If it's necessary + # to get a mixed value treated as a string, putting it into a double-quoted + # string and assigning the result to a fresh variable (my $new = "$old";) + # works. + return 1 if $type eq 'B::PVNV'; + + # It's none of the above, so call it not numeric (might still be, due to + # magic). + return; +} + # from docs # key=keyvalue # startkey=keyvalue @@ -244,7 +272,7 @@ sub fixViewArgs { $args{$k} = $self->{client}->{json}->encode($args{$k}); } else { - unless ($args{$k} =~ /^\d+(?:\.\d+)*$/s) { + unless (_is_currently_numeric($args{$k})) { $args{$k} = '"' . $args{$k} . '"'; } } From 4e47f72900a6f6278c5ddee6831fa2539ff841bd Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 1 Nov 2010 16:29:58 +0100 Subject: [PATCH 07/22] There was an easier and safer way after all. --- lib/CouchDB/Client/DB.pm | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index b7a9ddc..e1c64ac 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -11,7 +11,7 @@ use URI::Escape qw(uri_escape_utf8); use CouchDB::Client::Doc; use CouchDB::Client::DesignDoc; -use B qw[svref_2object SVf_IOK SVf_POK]; +use B qw[svref_2object SVf_IOK SVf_NOK]; sub new { my $class = shift; @@ -240,12 +240,8 @@ sub _is_currently_numeric($) { # It has a current public integer value. return 1 if $ref->FLAGS & SVf_IOK; - # It's a mixed string/float. No way to tell which part is current without - # dropping to the C level, so let's always call it numeric. If it's necessary - # to get a mixed value treated as a string, putting it into a double-quoted - # string and assigning the result to a fresh variable (my $new = "$old";) - # works. - return 1 if $type eq 'B::PVNV'; + # It has a current public float value. + return 1 if $ref->FLAGS & SVf_NOK; # It's none of the above, so call it not numeric (might still be, due to # magic). From 24a177dbfffdc9b4329423e0e90f73919196a4da Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Wed, 1 Dec 2010 10:02:45 +0100 Subject: [PATCH 08/22] Rewrite docExists() to be _much_ more efficient. --- lib/CouchDB/Client/DB.pm | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index e1c64ac..07e582b 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -131,15 +131,18 @@ sub listDocs { return [ map { $self->newDoc($_->{id}, $_->{rev}) } @{$self->listDocIdRevs(%args)} ]; } -sub docExists { +sub docExists { my $self = shift; my $id = shift; my $rev = shift; - if ($rev) { - return (grep { $_->{id} eq $id and $_->{rev} eq $rev } @{$self->listDocIdRevs}) ? 1 : 0; - } - else { - return (grep { $_->{id} eq $id } @{$self->listDocIdRevs}) ? 1 : 0; + my $doc = $self->newDoc($id, $rev); + eval { + $doc->retrieve; + }; + if($@) { + return 0; + } else { + return 1; } } From d9acc47c74e4740caccc8325bf2032773a4b5892 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Wed, 1 Dec 2010 10:32:13 +0100 Subject: [PATCH 09/22] Do this a bit more correctly. --- lib/CouchDB/Client/DB.pm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 07e582b..6d5ae5b 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -131,7 +131,7 @@ sub listDocs { return [ map { $self->newDoc($_->{id}, $_->{rev}) } @{$self->listDocIdRevs(%args)} ]; } -sub docExists { +sub docExists { my $self = shift; my $id = shift; my $rev = shift; @@ -139,10 +139,13 @@ sub docExists { eval { $doc->retrieve; }; - if($@) { + my $err = $@; + if(!$err) { + return 1; + } elsif($err =~ /Object not found/) { return 0; } else { - return 1; + die $err; } } From f65940ccfc033f77e1109491f50f6c19e7749ab8 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Thu, 2 Dec 2010 11:01:49 +0100 Subject: [PATCH 10/22] Change listDesignDocs to filter out the design documents in the database instead of in Perl. Add a couple of tests to make sure it works correctly. --- lib/CouchDB/Client/DB.pm | 4 +++- t/15-client.t | 10 +++++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 6d5ae5b..c4d5529 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -160,7 +160,9 @@ sub newDesignDoc { sub listDesignDocIdRevs { my $self = shift; my %args = @_; - return [grep { $_->{id} =~ m{^_design/} } @{$self->listDocIdRevs(%args)}]; + $args{startkey} = '_design'; + $args{endkey} = '_design0'; + return [@{$self->listDocIdRevs(%args)}]; } sub listDesignDocs { diff --git a/t/15-client.t b/t/15-client.t index febbb64..b4b2b26 100644 --- a/t/15-client.t +++ b/t/15-client.t @@ -21,7 +21,7 @@ if($cdb->testConnection) { plan skip_all => "Requires CouchDB version 0.8.0 or better; running $v"; } else { - plan tests => 78; + plan tests => 80; } } else { @@ -150,11 +150,19 @@ ok $DB, 'DB create'; # list Design Docs { + my $d1 = $DB->newDoc('test'); + $d1->create; + my $d2 = $DB->newDoc('_design/test'); + $d2->create; my $docs = $DB->listDesignDocs; ok ref($docs) eq 'ARRAY', 'listDesignDocs at least returns a list of something'; my $docs2 = $DB->listDesignDocIdRevs; ok ref($docs2) eq 'ARRAY', 'listDesignDocIdRevs at least returns a list of something'; ok @$docs == @$docs2, 'listDesignDocIdRevs and listDesignDocs return the same number of items'; + ok @$docs > 0, 'listDesignDocs returned more than zero items'; + ok ((grep {$_->{id} !~ /^_design/} @$docs) == 0, 'listDesignDocs returned only design docs'); + $d1->delete; + $d2->delete; } # new Design Doc & exists From 85dc654d47a04dfe9322b886f731f3b0fbf91e9d Mon Sep 17 00:00:00 2001 From: Maverick Date: Thu, 9 Dec 2010 10:03:50 -0600 Subject: [PATCH 11/22] Minor tweaks: Modified _is_currently_numeric to be called like a method and to explicitly return 0 and 1; Added tests to validate its behavior. --- lib/CouchDB/Client/DB.pm | 10 +++++----- t/12-small-things.t | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 6 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index c4d5529..ff535fa 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -234,16 +234,16 @@ sub bulkDelete { return $res->{json} if $res->{success}; } -sub _is_currently_numeric($) { +sub _is_currently_numeric { # Get a B::-type object from whatever it is - my $ref = svref_2object(\$_[0]); + my $ref = svref_2object(\$_[1]); my $type = ref($ref); # It's a pure numeric value return 1 if ($type eq 'B::NV' or $type eq 'B::IV'); # It's a pure string value. - return if $type eq 'B::PV'; + return 0 if $type eq 'B::PV'; # It has a current public integer value. return 1 if $ref->FLAGS & SVf_IOK; @@ -253,7 +253,7 @@ sub _is_currently_numeric($) { # It's none of the above, so call it not numeric (might still be, due to # magic). - return; + return 0; } # from docs @@ -276,7 +276,7 @@ sub fixViewArgs { $args{$k} = $self->{client}->{json}->encode($args{$k}); } else { - unless (_is_currently_numeric($args{$k})) { + unless ($self->_is_currently_numeric($args{$k})) { $args{$k} = '"' . $args{$k} . '"'; } } diff --git a/t/12-small-things.t b/t/12-small-things.t index df0f588..07ff78d 100644 --- a/t/12-small-things.t +++ b/t/12-small-things.t @@ -15,7 +15,7 @@ use LWP::UserAgent; my $cdb = CouchDB::Client->new( uri => $ENV{COUCHDB_CLIENT_URI} || 'http://localhost:5984/' ); if($cdb->testConnection) { - plan tests => 14; + plan tests => 22; } else { plan skip_all => 'Could not connect to CouchDB, skipping.'; @@ -60,6 +60,37 @@ my $DB = $C->newDB('blah'); # differences in the various json encoders. ok($encoded{key} =~ /^\s*\[\s*['"]one['"]\s*,\s*['"]two['"]\s*\]\s*$/, "Array encode works"); ok($encoded{startkey} =~ /^\s*\{['"]?key['"]?\s*:\s*['"]value['"]\s*}\s*$/, "Hash encode works"); + +} + +# test _is_currently_numeric +{ + # bare number not assigned to a scalar + is($DB->_is_currently_numeric(10),1,"bare number is numeric"); + + # bare string + is($DB->_is_currently_numeric("string"),0,"bare string is not numeric"); + + my $int = 12; + is($DB->_is_currently_numeric($int),1,"int scalar is numeric"); + + $int = ''.$int; + is($DB->_is_currently_numeric($int),0,"int is not numeric after string concatination"); + + # interesting gotcha. ++ for some reason does *NOT* make it treated like a number again. + $int += 0; + is($DB->_is_currently_numeric($int),1,"int is numeric again after += 0"); + + my $float = 12.34; + is($DB->_is_currently_numeric($float),1,"floating point scalar is numeric"); + + # still just numbers, but I treated it like a string + $float .= '5'; + is($DB->_is_currently_numeric($float),0,"float is not numeric after string concatination"); + + # treated it like a number again + $float++; + is($DB->_is_currently_numeric($float),1,"float is numeric again after ++"); } ### DESIGN DOC From e53920a743b910b1e6a7e790db72918bc7818135 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Thu, 16 Dec 2010 12:03:28 +0100 Subject: [PATCH 12/22] Add method to return total number of documents in a database. --- lib/CouchDB/Client/DB.pm | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index ff535fa..af52d31 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -131,6 +131,15 @@ sub listDocs { return [ map { $self->newDoc($_->{id}, $_->{rev}) } @{$self->listDocIdRevs(%args)} ]; } +sub countDocs { + my $self = shift; + my $qs = $self->argsToQuery(limit => 0); + my $res = $self->{client}->req('GET', $self->uriName . '/_all_docs' . $qs); + confess("Connection error: $res->{msg}") unless $res->{success}; + + return $res->{json}{total_rows}; +} + sub docExists { my $self = shift; my $id = shift; From 5d76f7d7ddfa31cda2d5484b85d45a699f8c6c4f Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Fri, 23 Sep 2011 15:01:16 +0200 Subject: [PATCH 13/22] Add a method that uses the POST to _all_docs interface to fetch many documents with one HTTP call. --- lib/CouchDB/Client/DB.pm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index af52d31..3612ec2 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -243,6 +243,18 @@ sub bulkDelete { return $res->{json} if $res->{success}; } +sub bulkGet { + my $self = shift; + my $ids = shift; + my @id = map {"$_"} @$ids; + + my $res = $self->{client}->req('POST', $self->uriName . '/_all_docs?include_docs=true', {keys => \@id}); + confess("Connection error: " . $res->{msg}) unless $res->{success}; + $res = $res->{json}{rows}; + + return {map {$_->{key} => $_->{doc}} @$res}; +} + sub _is_currently_numeric { # Get a B::-type object from whatever it is my $ref = svref_2object(\$_[1]); @@ -461,6 +473,13 @@ Same as above but performs mass deletion of documents. Note that using bulkStore also obtain the same effect by setting a C<_deleted> field to true on your objects but that is not recommended as fields that begin with an underscore are reserved by CouchDB. +=item bulkGet \@IDS + +Retrieve a large number of documents with one call to the database. The one +argument should be a reference to a list of document ids. It will return a +reference to a hash, where the keys are the given ids and the values are the +corresponding L objects or C. + =item uriName Returns the name of the database escaped. From 5d276c23872a2295f41fef08f92ae1cf3dbaa720 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Fri, 23 Sep 2011 15:05:11 +0200 Subject: [PATCH 14/22] Bump version number, so we can require a version with bulkGet in it. --- lib/CouchDB/Client.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/CouchDB/Client.pm b/lib/CouchDB/Client.pm index b97803a..28c5b2c 100644 --- a/lib/CouchDB/Client.pm +++ b/lib/CouchDB/Client.pm @@ -4,7 +4,7 @@ package CouchDB::Client; use strict; use warnings; -our $VERSION = '0.09'; +our $VERSION = '0.10'; use JSON::Any qw(XS JSON DWIW); use LWP::UserAgent qw(); From 149b06561893ffb02f7ef638b6061dd2061071ef Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 26 Sep 2011 09:43:22 +0200 Subject: [PATCH 15/22] Add bulkGetView method to CouchDB::Client::DesignDoc. --- lib/CouchDB/Client/DesignDoc.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/lib/CouchDB/Client/DesignDoc.pm b/lib/CouchDB/Client/DesignDoc.pm index 513e9f5..443ea15 100644 --- a/lib/CouchDB/Client/DesignDoc.pm +++ b/lib/CouchDB/Client/DesignDoc.pm @@ -72,6 +72,26 @@ sub queryView { return $res->{json}; } +sub bulkGetView { + my $self = shift; + my $view = shift; + my $keys = shift; + my @key = map {"$_"} @$keys; + + confess("No such view: '$view'") unless exists $self->views->{$view}; + my $sn = $self->id; + $sn =~ s{^_design/}{}; + $sn = uri_escape_utf8($sn); + + my $vp = "/_design/$sn/_view/$view"; + + my $res = $self->{db}{client}->req('POST', $self->{db}->uriName . $vp . '?include_docs=true', {keys => \@key}); + confess("Connection error: " . $res->{msg}) unless $res->{success}; + $res = $res->{json}{rows}; + + return [map {{$_->{key} =>$_->{doc}}} @$res]; +} + 1; =pod @@ -133,6 +153,13 @@ The data structure that is returned is a hashref that will contain C C keys, as well as a C field that contains an array ref being the resultset. +=item bulkGetView $VIEW_NAME, $KEYS_AREF + +Takes the name of a view in this design document, and a reference to a list of +keys. It will then use the POST interface to retrieve all documents matching +that key in a single request. It will return a reference to a list of hash +references, where each hash is a single key => document pair. + =back =head1 AUTHOR From db1b9765283fbdf8bf960d9573da82f5ba4ca327 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 26 Sep 2011 09:45:51 +0200 Subject: [PATCH 16/22] Bugfix for previous. --- lib/CouchDB/Client/DesignDoc.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/CouchDB/Client/DesignDoc.pm b/lib/CouchDB/Client/DesignDoc.pm index 443ea15..4145d08 100644 --- a/lib/CouchDB/Client/DesignDoc.pm +++ b/lib/CouchDB/Client/DesignDoc.pm @@ -76,7 +76,6 @@ sub bulkGetView { my $self = shift; my $view = shift; my $keys = shift; - my @key = map {"$_"} @$keys; confess("No such view: '$view'") unless exists $self->views->{$view}; my $sn = $self->id; From 1e62ee64742bcf8a88ac9a3a602131edba8226a6 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 26 Sep 2011 11:23:21 +0200 Subject: [PATCH 17/22] Now we can handle both reducing and non-reducing views. --- lib/CouchDB/Client/DesignDoc.pm | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/lib/CouchDB/Client/DesignDoc.pm b/lib/CouchDB/Client/DesignDoc.pm index 4145d08..161532d 100644 --- a/lib/CouchDB/Client/DesignDoc.pm +++ b/lib/CouchDB/Client/DesignDoc.pm @@ -76,6 +76,7 @@ sub bulkGetView { my $self = shift; my $view = shift; my $keys = shift; + my %args = @_; confess("No such view: '$view'") unless exists $self->views->{$view}; my $sn = $self->id; @@ -83,12 +84,16 @@ sub bulkGetView { $sn = uri_escape_utf8($sn); my $vp = "/_design/$sn/_view/$view"; - - my $res = $self->{db}{client}->req('POST', $self->{db}->uriName . $vp . '?include_docs=true', {keys => \@key}); + if ($self->views->{$view}{reduce}) { + $args{group} = 'true' unless (exists $args{group} or exists $args{group_level}); + } + my $qs = %args ? $self->{db}->argsToQuery(%args) : ''; + + my $res = $self->{db}{client}->req('POST', $self->{db}->uriName . $vp . $qs, {keys => $keys}); confess("Connection error: " . $res->{msg}) unless $res->{success}; $res = $res->{json}{rows}; - return [map {{$_->{key} =>$_->{doc}}} @$res]; + return $res; } 1; @@ -152,12 +157,15 @@ The data structure that is returned is a hashref that will contain C C keys, as well as a C field that contains an array ref being the resultset. -=item bulkGetView $VIEW_NAME, $KEYS_AREF +=item bulkGetView $VIEW_NAME, $KEYS_AREF, %ARGS? -Takes the name of a view in this design document, and a reference to a list of -keys. It will then use the POST interface to retrieve all documents matching -that key in a single request. It will return a reference to a list of hash -references, where each hash is a single key => document pair. +Takes the name of a view in this design document, a reference to a list of +keys and an optional hash of query arguments. It will return a reference to a +list of hash references, where each hash is one fetched result. They will have +at least two keys, C and C. They may also have C (for +non-reducing views) and C (if you set the C argument to +true). If the view is reducing, C will be turned on automatically, +unless it or C is included in the passed-in argument hash. =back From 4f1dff48720b3dacd6120ff32e83b3ae577b1dd7 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Mon, 5 Mar 2012 14:27:57 +0100 Subject: [PATCH 18/22] Autogenerate access methods for views. --- lib/CouchDB/Client/DB.pm | 51 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 49 insertions(+), 2 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 3612ec2..3ded250 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -1,4 +1,3 @@ - package CouchDB::Client::DB; use strict; @@ -20,7 +19,11 @@ sub new { $opt{name} || confess "CouchDB database requires a name."; $opt{client} || confess "CouchDB database requires a client."; - return bless \%opt, $class; + my $self = bless \%opt, $class; + + $self->_install_views; + + return $self; } sub validName { @@ -277,6 +280,27 @@ sub _is_currently_numeric { return 0; } +sub _install_views { + my $self = shift; + + my @ddocs = @{$self->listDesignDocs}; + + foreach my $ddoc (@ddocs) { + $ddoc->retrieve; + my $name = $ddoc->id; + $name =~ s|_design/||; + no strict 'refs'; + foreach my $view ($ddoc->listViews) { + my $method_name = $name . '_' . $view; + *{"CouchDB::Client::DB::$method_name"} = sub { + my $self = shift; + + return $ddoc->queryView($view, @_); + }; + } + } +} + # from docs # key=keyvalue # startkey=keyvalue @@ -349,6 +373,7 @@ CouchDB::Client::DB - CouchDB::Client database my $doc = $db->newDoc('dahut.svg', undef, { foo => 'bar' })->create; my $dd = $db->newDesignDoc('dahut.svg', undef, $myViews)->create; #... + my $result = $db->somedesigndoc_someviewname(); # Autogenerated method $db->delete; =head1 DESCRIPTION @@ -497,6 +522,28 @@ string (complete with leading '?') to pass on to CouchDB. =back +=head1 AUTOGENERATED VIEW QUERY METHODS + +For convenience, methods to send straightforward queries to design +document views will be auto-generated when the database object is +created. The names of the methods will be design document name +(ignoring the "_design/" part), an underscore and then the view name. +So if we have a design document named "utils", and a view in it called +"maxsize", it could be called as: + + my $result = $db->utils_maxsize( group => 1 ); + +Behind the scenes, this calls the C method in the +L module with the name "filled in". This +means that any arguments to the autogenerated method will be used as +the C<%ARGS> to C. In the snippet above, for example, we +include the argument to turn on grouping. + +Note that any new views or design documents added after the object is +created will not automatically show up. Only those that are visible in +the database at the time of object creation will have convenience +methods created for them. + =head1 AUTHOR Robin Berjon, From 84fedd7aa28b831318e968a35fecf97f7b96fd67 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Thu, 29 Mar 2012 11:01:34 +0200 Subject: [PATCH 19/22] Suppress spurious warnings, and make tests pass. --- Makefile.PL | 1 + lib/CouchDB/Client/DB.pm | 12 +++++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/Makefile.PL b/Makefile.PL index 5921459..cb30e71 100755 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,6 +16,7 @@ requires 'LWP::UserAgent'; requires 'HTTP::Request'; requires 'URI::Escape'; requires 'MIME::Base64'; +requires 'Try::Tiny'; # we need a JSON module that isn't Syck (no UTF-8 support makes it useless) sub check_json () { diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index 3ded250..e661917 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -9,6 +9,7 @@ use Carp qw(confess); use URI::Escape qw(uri_escape_utf8); use CouchDB::Client::Doc; use CouchDB::Client::DesignDoc; +use Try::Tiny; use B qw[svref_2object SVf_IOK SVf_NOK]; @@ -283,13 +284,18 @@ sub _is_currently_numeric { sub _install_views { my $self = shift; - my @ddocs = @{$self->listDesignDocs}; + my @ddocs; + + try { + @ddocs = @{$self->listDesignDocs}; + }; foreach my $ddoc (@ddocs) { $ddoc->retrieve; my $name = $ddoc->id; $name =~ s|_design/||; no strict 'refs'; + no warnings 'redefine'; foreach my $view ($ddoc->listViews) { my $method_name = $name . '_' . $view; *{"CouchDB::Client::DB::$method_name"} = sub { @@ -455,6 +461,10 @@ of arguments matching those understood by CouchDB queries. The same as above, but returns an arrayref of C objects. Takes an optional hash of arguments matching those understood by CouchDB queries. +=item countDocs + +Returns the total number of documents in the database. + =item docExists $ID, $REV? Takes an ID and an optional revision and returns true if there is a document with that ID From fdace7c710335fbc39c737837725165100a5a18e Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Fri, 1 Jun 2012 11:54:24 +0200 Subject: [PATCH 20/22] Ignore MYMETA files. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index fcf9adf..d14e672 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ cover_db *.bak *.old inc +MYMETA.* From ced000e0ace9713ca8b73de1b7cc3f2a40e1b8f8 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Fri, 1 Jun 2012 12:02:53 +0200 Subject: [PATCH 21/22] Undo this change. Wrong thinking. Creating namespace-global methods for connection-specific things is not a good idea. --- lib/CouchDB/Client/DB.pm | 53 +--------------------------------------- 1 file changed, 1 insertion(+), 52 deletions(-) diff --git a/lib/CouchDB/Client/DB.pm b/lib/CouchDB/Client/DB.pm index e661917..00f841c 100644 --- a/lib/CouchDB/Client/DB.pm +++ b/lib/CouchDB/Client/DB.pm @@ -22,9 +22,7 @@ sub new { my $self = bless \%opt, $class; - $self->_install_views; - - return $self; + return $self; } sub validName { @@ -281,32 +279,6 @@ sub _is_currently_numeric { return 0; } -sub _install_views { - my $self = shift; - - my @ddocs; - - try { - @ddocs = @{$self->listDesignDocs}; - }; - - foreach my $ddoc (@ddocs) { - $ddoc->retrieve; - my $name = $ddoc->id; - $name =~ s|_design/||; - no strict 'refs'; - no warnings 'redefine'; - foreach my $view ($ddoc->listViews) { - my $method_name = $name . '_' . $view; - *{"CouchDB::Client::DB::$method_name"} = sub { - my $self = shift; - - return $ddoc->queryView($view, @_); - }; - } - } -} - # from docs # key=keyvalue # startkey=keyvalue @@ -379,7 +351,6 @@ CouchDB::Client::DB - CouchDB::Client database my $doc = $db->newDoc('dahut.svg', undef, { foo => 'bar' })->create; my $dd = $db->newDesignDoc('dahut.svg', undef, $myViews)->create; #... - my $result = $db->somedesigndoc_someviewname(); # Autogenerated method $db->delete; =head1 DESCRIPTION @@ -532,28 +503,6 @@ string (complete with leading '?') to pass on to CouchDB. =back -=head1 AUTOGENERATED VIEW QUERY METHODS - -For convenience, methods to send straightforward queries to design -document views will be auto-generated when the database object is -created. The names of the methods will be design document name -(ignoring the "_design/" part), an underscore and then the view name. -So if we have a design document named "utils", and a view in it called -"maxsize", it could be called as: - - my $result = $db->utils_maxsize( group => 1 ); - -Behind the scenes, this calls the C method in the -L module with the name "filled in". This -means that any arguments to the autogenerated method will be used as -the C<%ARGS> to C. In the snippet above, for example, we -include the argument to turn on grouping. - -Note that any new views or design documents added after the object is -created will not automatically show up. Only those that are visible in -the database at the time of object creation will have convenience -methods created for them. - =head1 AUTHOR Robin Berjon, From fdce6e3d42417ca322eb5eaa8b264feea9c79680 Mon Sep 17 00:00:00 2001 From: Calle Dybedahl Date: Wed, 12 Feb 2014 16:00:37 +0100 Subject: [PATCH 22/22] Basic debian packaging files. --- debian/changelog | 5 +++++ debian/compat | 1 + debian/control | 15 +++++++++++++++ debian/copyright | 40 ++++++++++++++++++++++++++++++++++++++++ debian/rules | 4 ++++ 5 files changed, 65 insertions(+) create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/copyright create mode 100755 debian/rules diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..684c63a --- /dev/null +++ b/debian/changelog @@ -0,0 +1,5 @@ +libcouchdb-client-perl (0.10-1) trusty; urgency=medium + + * Packaging. + + -- calle Wed, 12 Feb 2014 15:58:37 +0100 diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +7 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..29dcb98 --- /dev/null +++ b/debian/control @@ -0,0 +1,15 @@ +Source: libcouchdb-client-perl +Section: perl +Priority: optional +Build-Depends: debhelper (>= 7.0.50~) +Build-Depends-Indep: libmodule-install-perl,libjson-any-perl,libjson-xs-perl,libtry-tiny-perl,libwww-perl,liburi-perl +Maintainer: Calle Dybedahl +Standards-Version: 3.9.3 +Homepage: https://github.com/cdybedahl/couchdb-client + +Package: libcouchdb-client-perl +Architecture: all +Depends: ${misc:Depends}, ${perl:Depends},libjson-any-perl,libjson-xs-perl,libtry-tiny-perl,libwww-perl,liburi-perl +Description: Client for talking to CouchDB databases. + This packaging is a patched version, not the one on CPAN. + . diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..98f593a --- /dev/null +++ b/debian/copyright @@ -0,0 +1,40 @@ +Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 +Maintainer: Calle Dybedahl +Source: https://github.com/dotse/dnscheck +Name: DNSCheck + +Files: * +Copyright: 2008-2012 Stiftelsen för Internetinfrastruktur +License: BSD + +Files: debian/* +Copyright: 2009-1012, Stiftelsen för Internetinfrastruktur +License: BSD + +License: BSD + Copyright (c) The Regents of the University of California. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. Neither the name of the University nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + SUCH DAMAGE. diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..2d33f6a --- /dev/null +++ b/debian/rules @@ -0,0 +1,4 @@ +#!/usr/bin/make -f + +%: + dh $@