Permalink
Browse files

bug fixes

- $db->view passes authentication info
- options{header} not deleted anymore
- doc refinements
  • Loading branch information...
beppu committed Apr 10, 2011
1 parent 77ca13c commit 8d609263d6b6a9a7c0a566509ccde2765482f3f9
Showing with 90 additions and 36 deletions.
  1. +5 −0 Changes
  2. +2 −2 Makefile.PL
  3. +64 −24 lib/AnyEvent/CouchDB.pm
  4. +13 −6 lib/AnyEvent/CouchDB/Database.pm
  5. +6 −4 lib/AnyEvent/CouchDB/Exceptions.pm
View
@@ -3,6 +3,11 @@ UNRELEASED
* write more tests
* need to improve startkey/endkey/key JSON encoding.
+1.23 2011-04-09
+ - Exception::Class based exceptions implemented in AnyEvent::CouchDB::Exceptions
+ - $options{header} is not deleted anymore
+ - $db->view passes authentication information
+
1.22 2010-10-12
- Reverted a change to the exception code that serialized the exception data to JSON.
View
@@ -24,11 +24,11 @@ WriteMakefile (
PREREQ_PM => {
'AnyEvent::HTTP' => 1.11,
'CouchDB::View' => 0,
- 'JSON::XS' => 0,
+ 'JSON' => 0,
'Data::Dump::Streamer' => 0,
+ 'Exception::Class' => 0,
'IO::All' => 0,
'Scope::Guard' => 0,
- 'Try::Tiny' => 0,
'Scalar::Util' => 0,
},
);
View
@@ -4,29 +4,32 @@ use strict;
use warnings;
our $VERSION = '1.22';
-use JSON::XS;
+use JSON;
use AnyEvent::HTTP;
use AnyEvent::CouchDB::Database;
+use AnyEvent::CouchDB::Exceptions;
use URI;
use URI::Escape;
use File::Basename;
+use MIME::Base64;
use Exporter;
use base 'Exporter';
our @EXPORT = qw(couch couchdb);
+# exception class shortcuts
+our $HTTPError = "AnyEvent::CouchDB::Exception::HTTPError";
+our $JSONError = "AnyEvent::CouchDB::Exception::JSONError";
+
# default JSON encoder
-our $default_json = JSON::XS->new->utf8;
+our $default_json = JSON->new->utf8;
-# arbitrary url support
+# arbitrary uri support
sub _build_headers {
my ( $self, $options ) = @_;
my $headers = $options->{headers};
- if ( ref($headers) eq 'HASH' ) {
- delete $options->{headers};
- }
- else {
+ if ( ref($headers) ne 'HASH' ) {
$headers = {};
}
@@ -38,14 +41,29 @@ sub _build_headers {
$headers->{'Content-Type'} = 'application/json';
}
+ if ( exists $self->{http_auth} ) {
+ $headers->{'Authorization'} = $self->{http_auth};
+ }
+
return $headers;
}
+# return a condvar and callback
+#
+# - The condvar is what most of our methods return.
+# You can call recv on them to get data back, or
+# you can call cb on them to assign an asynchronous callback to
+# run WHEN the data comes back
+#
+# - The callback is the code that handles the
+# generic part of every CouchDB response. This is given
+# to AnyEvent::HTTP.
+#
sub cvcb {
my ($options, $status, $json) = @_;
$status ||= 200;
$json ||= $default_json;
- my $cv = AnyEvent->condvar;
+ my $cv = AE::cv;
# default success handler sends back decoded json response
my $success = sub {
@@ -58,18 +76,30 @@ sub cvcb {
my $error = sub {
my ($headers, $response) = @_;
$options->{error}->(@_) if ($options->{error});
- $cv->croak([$headers, $response]);
+ $cv->croak(
+ $HTTPError->new(
+ message => sprintf("%s - %s - %s", $headers->{Status}, $headers->{Reason}, $headers->{URL}),
+ headers => $headers,
+ body => $response
+ )
+ );
};
my $cb = sub {
my ($body, $headers) = @_;
my $response;
eval { $response = $json->decode($body); };
- $cv->croak(['decode_error', $@, $body, $headers]) if ($@);
+ $cv->croak(
+ $JSONError->new(
+ message => $@,
+ headers => $headers,
+ body => $body
+ )
+ ) if ($@);
if ($headers->{Status} >= $status and $headers->{Status} < 400) {
$success->($response);
} else {
- $error->($headers, $response);
+ $error->($headers, $body);
}
};
($cv, $cb);
@@ -92,16 +122,21 @@ sub couchdb {
}
sub new {
- my ($class, $url) = @_;
- $url ||= 'http://localhost:5984/';
- bless { url => URI->new($url) } => $class;
+ my ($class, $uri) = @_;
+ $uri ||= 'http://localhost:5984/';
+ my $self = bless { uri => URI->new($uri) } => $class;
+ if (my $userinfo = $self->{uri}->userinfo) {
+ my $auth = encode_base64($userinfo, '');
+ $self->{http_auth} = "Basic $auth";
+ }
+ return $self;
}
sub all_dbs {
my ($self, $options) = @_;
my ($cv, $cb) = cvcb($options);
http_request(
- GET => $self->{url}.'_all_dbs',
+ GET => $self->{uri}.'_all_dbs',
headers => $self->_build_headers($options),
$cb
);
@@ -110,7 +145,7 @@ sub all_dbs {
sub db {
my ($self, $name) = @_;
- my $uri = $self->{url}->clone;
+ my $uri = $self->{uri}->clone;
$uri->path(($uri->path ? $uri->path . $name : $name) . "/");
AnyEvent::CouchDB::Database->new($name, $uri);
}
@@ -119,7 +154,7 @@ sub info {
my ($self, $options) = @_;
my ($cv, $cb) = cvcb($options);
http_request(
- GET => $self->{url}->as_string,
+ GET => $self->{uri}->as_string,
headers => $self->_build_headers($options),
$cb
);
@@ -130,7 +165,7 @@ sub config {
my ($self, $options) = @_;
my ($cv, $cb) = cvcb($options);
http_request(
- GET => $self->{url} . '_config',
+ GET => $self->{uri} . '_config',
headers => $self->_build_headers($options),
$cb
);
@@ -146,7 +181,7 @@ sub replicate {
}
my $body = $default_json->encode($replication);
http_request(
- POST => $self->{url}.'_replicate',
+ POST => $self->{uri}.'_replicate',
headers => $self->_build_headers($options),
body => $body,
$cb
@@ -179,6 +214,11 @@ Get an object representing a CouchDB database:
$db = couchdb('database');
$db = couchdb('http://somewhere.com:7777/database/');
+With authentication:
+
+ # user is the username and s3cret is the password
+ $db = couchdb('http://user:s3cret@somewhere.com:7777/database');
+
Work with individual CouchDB documents;
my $user = $db->open_doc('~larry')->recv;
@@ -191,7 +231,7 @@ Query a view:
Finally, an asynchronous example:
- # Calling cb will not block whereas calling recv *will* block.
+ # Calling cb allow you to set a callback that will run when results are available.
$db->all_docs->cb(sub {
my ($cv) = @_;
print pp( $cv->recv ), "\n";
@@ -315,19 +355,19 @@ are not blessed into any kind of document class.
=head2 Convenience Functions
-=head3 $couch = couch([ $url ]);
+=head3 $couch = couch([ $uri ]);
This is a short-cut for:
- AnyEvent::CouchDB->new($url)
+ AnyEvent::CouchDB->new($uri)
and it is exported by default. It will return a connection to a CouchDB server,
and if you don't pass it a URL, it'll assume L<http://localhost:5984/>. Thus,
you can type:
$couch = couch;
-=head3 $db = couchdb($name_or_url);
+=head3 $db = couchdb($name_or_uri);
This function will construct an L<AnyEvent::CouchDB::Database> object for you.
If you only give it a name, it'll assume that the CouchDB server is at
@@ -338,7 +378,7 @@ This function is also exported by default.
=head2 Object Construction
-=head3 $couch = AnyEvent::CouchDB->new([ $url ])
+=head3 $couch = AnyEvent::CouchDB->new([ $uri ])
This method will instantiate an object that represents a CouchDB server.
By default, it connects to L<http://localhost:5984/>, but you may explicitly
@@ -5,15 +5,17 @@ use warnings;
no warnings 'once';
use JSON::XS;
use AnyEvent::HTTP;
+use AnyEvent::CouchDB::Exceptions;
use Data::Dump::Streamer;
use URI::Escape qw( uri_escape uri_escape_utf8 );
use IO::All;
+use MIME::Base64;
our $default_json;
# manual import ;-)
-*cvcb = *AnyEvent::CouchDB::cvcb;
-*default_json = *AnyEvent::CouchDB::default_json;
+*cvcb = *AnyEvent::CouchDB::cvcb;
+*default_json = *AnyEvent::CouchDB::default_json;
*_build_headers = *AnyEvent::CouchDB::_build_headers;
our $query = sub {
@@ -22,7 +24,7 @@ our $query = sub {
my @buf;
if (defined($options) && keys %$options) {
for my $name (keys %$options) {
- next if ($name eq 'error' || $name eq 'success');
+ next if ($name eq 'error' || $name eq 'success' || $name eq 'headers');
my $value = $options->{$name};
if ($name eq 'key' || $name eq 'startkey' || $name eq 'endkey') {
$value = ref($value)
@@ -57,15 +59,20 @@ our $code_to_string = sub {
sub new {
my ($class, $name, $uri, $json_encoder) = @_;
$json_encoder ||= $default_json;
- bless { name => $name, uri => $uri, json_encoder => $json_encoder } => $class;
+ my $self = bless { name => $name, uri => $uri, json_encoder => $json_encoder } => $class;
+ if (my $userinfo = $self->uri->userinfo) {
+ my $auth = encode_base64($userinfo, '');
+ $self->{http_auth} = "Basic $auth";
+ }
+ return $self;
}
sub name {
$_[0]->{name};
}
sub uri {
- $_[0]->{uri}->as_string;
+ $_[0]->{uri};
}
sub json_encoder {
@@ -515,7 +522,7 @@ authentication to your requests if needed:
my $couchdb = couch("http://127.0.0.1:5984/");
my $db = $couchdb->db("mydb");
- my $auth = encode_base64('user:s3kr3t', '');
+ my $auth = encode_base64('user:s3kr3t', '');
my $res = $db->create({headers => {'Authorization' => 'Basic '.$aut}})->recv;
@@ -2,14 +2,14 @@ package AnyEvent::CouchDB::Exceptions;
use Exception::Class (
'AnyEvent::CouchDB::Exception' => {
- fields => [ 'headers', 'response' ],
+ fields => [ 'headers', 'body' ],
},
'AnyEvent::CouchDB::Exception::JSONError' => {
isa => 'AnyEvent::CouchDB::Exception',
description => 'JSON decoding error',
},
'AnyEvent::CouchDB::Exception::HTTPError' => {
- isa => 'AnyEvent::CouchDB::Exception'
+ isa => 'AnyEvent::CouchDB::Exception',
description => 'HTTP error',
},
);
@@ -26,6 +26,7 @@ AnyEvent::CouchDB::Exceptions - Exception::Class-based exceptions for AnyEvent::
=head1 SYNOPSIS
+ use feature 'switch';
use Try::Tiny;
use Data::Dump 'pp';
use AnyEvent::CouchDB;
@@ -45,7 +46,7 @@ AnyEvent::CouchDB::Exceptions - Exception::Class-based exceptions for AnyEvent::
$_->show_trace(1);
warn "$_";
warn "HEADERS : " . pp($_->headers);
- warn "RESPONSE : " . $_->response;
+ warn "BODY : " . $_->body;
}
};
@@ -82,9 +83,10 @@ by L<Exception::Class::Base>.
This method will return the HTTP response headers if they were available at
the time the exception was thrown.
-=head3 $e->response
+=head3 $e->body
This method will return the HTTP response body if it was available at
the time the exception was thrown.
+
=cut

0 comments on commit 8d60926

Please sign in to comment.