allow json encoder to be configurable

beppu · Apr 21, 2009 · b0eed23 · b0eed23
1 parent ff2155e
commit b0eed23
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 41 deletions.
diff --git a/Changes b/Changes
@@ -1,8 +1,10 @@
-1.10 UNRELEASED
+UNRELEASED
   * see if we can load new attachment data asynchronously.
-  * write tests
+  * write more tests
   * need to improve startkey/endkey/key JSON encoding.
-    Perhaps I should allow for a custom $json object.
+
+1.10 2009-04-21
+  - allow the use of custom JSON encoding objects
 
 1.09 2009-04-02
   - added support for _all_docs_by_seq

diff --git a/lib/AnyEvent/CouchDB.pm b/lib/AnyEvent/CouchDB.pm
@@ -2,7 +2,7 @@ package AnyEvent::CouchDB;
 
 use strict;
 use warnings;
-our $VERSION = '1.09';
+our $VERSION = '1.10';
 
 use JSON::XS;
 use AnyEvent::HTTP;
@@ -17,9 +17,13 @@ use base 'Exporter';
 
 our @EXPORT = qw(couch couchdb);
 
+# default JSON encoder
+our $default_json = JSON::XS->new;
+
 sub cvcb {
-  my ($options, $status) = @_;
+  my ($options, $status, $json) = @_;
   $status ||= 200;
+  $json   ||= $default_json;
   my $cv = AnyEvent->condvar;
 
   # default success handler sends back decoded json response
@@ -39,8 +43,8 @@ sub cvcb {
   my $cb = sub {
     my ($body, $headers) = @_;
     my $response;
-    eval { $response = decode_json($body); };
-    $cv->croak(pp(['decode_error', $@, $body, encode_json($headers)])) if ($@);
+    eval { $response = $json->decode($body); };
+    $cv->croak(pp(['decode_error', $@, $body, $json->decode($headers)])) if ($@);
     if ($headers->{Status} >= $status and $headers->{Status} < 400) {
       $success->($response);
     } else {
@@ -103,7 +107,7 @@ sub config {
 sub replicate {
   my ($self, $source, $target, $options) = @_;
   my ($cv, $cb) = cvcb($options);
-  my $body = encode_json({ source => $source, target => $target });
+  my $body = $default_json->encode({ source => $source, target => $target });
   http_request(
     POST    => $self->{url}.'_replicate', 
     headers => { 'Content-Type' => 'application/json' },

diff --git a/lib/AnyEvent/CouchDB/Database.pm b/lib/AnyEvent/CouchDB/Database.pm
@@ -2,24 +2,33 @@ package AnyEvent::CouchDB::Database;
 
 use strict;
 use warnings;
+no  warnings 'once';
 use JSON::XS;
 use AnyEvent::HTTP;
 use Data::Dump::Streamer;
 use URI::Escape 'uri_escape_utf8';
 use IO::All;
 
+our $default_json;
+
 # manual import ;-)
-*cvcb = \&AnyEvent::CouchDB::cvcb;
+*cvcb         = *AnyEvent::CouchDB::cvcb;
+*default_json = *AnyEvent::CouchDB::default_json;
 
 our $query = sub {
   my $options = shift;
+  my $json    = $default_json;
   my @buf;
   if (defined($options) && keys %$options) {
     for my $name (keys %$options) {
       next if ($name eq 'error' || $name eq 'success');
       my $value = $options->{$name};
       if ($name eq 'key' || $name eq 'startkey' || $name eq 'endkey') {
-        $value = ref($value) ? encode_json($value) : (defined $value) ? qq{"$value"} : 'null';
+        $value = ref($value)
+          ? $json->encode($value)
+          : (defined $value)
+            ? qq{"$value"}
+            : 'null';
       }
       if ($name eq 'group' || $name eq 'reduce' || $name eq 'descending' || $name eq 'include_docs') {
         $value = $value
@@ -42,13 +51,10 @@ our $code_to_string = sub {
   # ^- taken from CouchDB::View::Document ------^
 };
 
-our $json = sub {
-  ref($_[0]) ? encode_json($_[0]) : $_[0];
-};
-
 sub new {
-  my ($class, $name, $uri) = @_;
-  bless { name => $name, uri => $uri } => $class;
+  my ($class, $name, $uri, $json_encoder) = @_;
+  $json_encoder ||= $default_json;
+  bless { name => $name, uri => $uri, json_encoder => $json_encoder } => $class;
 }
 
 sub name {
@@ -59,9 +65,23 @@ sub uri {
   $_[0]->{uri}->as_string;
 }
 
+sub json_encoder {
+  my ($self, $encoder) = @_;
+  if ($encoder) {
+    $self->{json_encoder} = $encoder;
+  } else {
+    $self->{json_encoder};
+  }
+}
+
+sub json {
+  my ($self, $target) = @_;
+  ref($target) ? $self->json_encoder->encode($target) : $target;
+}
+
 sub compact {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options, 202);
+  my ($cv, $cb) = cvcb($options, 202, $self->json_encoder);
   http_request(
     POST    => ($self->uri . "_compact"),
     headers => { 'Content-Type' => 'application/json' },
@@ -72,7 +92,7 @@ sub compact {
 
 sub create {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options, 201);
+  my ($cv, $cb) = cvcb($options, 201, $self->json_encoder);
   http_request(
     PUT     => $self->uri,
     headers => { 'Content-Type' => 'application/json' },
@@ -83,7 +103,7 @@ sub create {
 
 sub drop {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_request(
     DELETE  => $self->uri,
     $cb
@@ -93,41 +113,41 @@ sub drop {
 
 sub info {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_get($self->uri, $cb);
   $cv;
 }
 
 sub all_docs {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_get($self->uri.'_all_docs'.$query->($options), $cb);
   $cv;
 }
 
 sub all_docs_by_seq {
   my ($self, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_get($self->uri.'_all_docs_by_seq'.$query->($options), $cb);
   $cv;
 }
 
 sub open_doc {
   my ($self, $doc_id, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_get($self->uri.uri_escape_utf8($doc_id).$query->($options), $cb);
   $cv;
 }
 
 sub open_docs {
   my ($self, $doc_ids, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   $options ||= {};
   $options->{'include_docs'} = 'true';
   http_request(
     POST => $self->uri.'_all_docs'.$query->($options),
     headers => { 'Content-Type' => 'application/json' },
-    body    => $json->({"keys" => $doc_ids}),
+    body    => $self->json({"keys" => $doc_ids}),
     $cb
   );
   $cv;
@@ -150,7 +170,7 @@ sub save_doc {
       $doc->{_rev} = $resp->{rev};
     };
   }
-  my ($cv, $cb) = cvcb($options, 201);
+  my ($cv, $cb) = cvcb($options, 201, $self->json_encoder);
   my ($method, $uri);
   if (not defined $doc->{_id}) {
     $method = 'POST';
@@ -162,7 +182,7 @@ sub save_doc {
   http_request(
     $method => $uri.$query->($options),
     headers => { 'Content-Type' => 'application/json' },
-    body    => $json->($doc),
+    body    => $self->json($doc),
     $cb
   );
   $cv;
@@ -171,7 +191,7 @@ sub save_doc {
 sub remove_doc {
   my ($self, $doc, $options) = @_;
   die("Document is missing _id!") unless (defined $doc->{_id});
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_request(
     DELETE  => $self->uri.uri_escape_utf8($doc->{_id}).$query->({ rev => $doc->{_rev} }),
     $cb
@@ -210,7 +230,7 @@ sub attach {
       };
     };
   }
-  my ($cv, $cb) = cvcb($options, 201);
+  my ($cv, $cb) = cvcb($options, 201, $self->json_encoder);
   http_request(
     PUT => $self->uri.uri_escape_utf8($doc->{_id}).
       "/".uri_escape_utf8($attachment).$query->({ rev => $doc->{_rev} }),
@@ -240,7 +260,7 @@ sub detach {
       delete $doc->{_attachments}->{$attachment};
     };
   }
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_request(
     DELETE  => $self->uri.uri_escape_utf8($doc->{_id}).
       "/".uri_escape_utf8($attachment).$query->({ rev => $doc->{_rev} }),
@@ -251,19 +271,19 @@ sub detach {
 
 sub bulk_docs {
   my ($self, $docs, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   http_request(
     POST    => $self->uri.'_bulk_docs',
     headers => { 'Content-Type' => 'application/json' },
-    body    => $json->({ docs => $docs }),
+    body    => $self->json({ docs => $docs }),
     $cb
   );
   $cv;
 }
 
 sub query {
   my ($self, $map_fun, $reduce_fun, $language, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   $language ||= (ref($map_fun) eq 'CODE') ? 'text/perl' : 'javascript';
   my $body = {
     language => $language,
@@ -275,23 +295,23 @@ sub query {
   http_request(
     POST    => $self->uri.'_temp_view'.$query->($options),
     headers => { 'Content-Type' => 'application/json' },
-    body    => encode_json($body),
+    body    => $self->json($body),
     $cb
   );
   $cv;
 }
 
 sub view {
   my ($self, $name, $options) = @_;
-  my ($cv, $cb) = cvcb($options);
+  my ($cv, $cb) = cvcb($options, undef, $self->json_encoder);
   my ($dname, $vname) = split('/', $name);
   my $uri = $self->uri."/_design/".$dname."/_view/".$vname;
   if ($options->{keys}) {
     my $body = { keys => $options->{keys} };
     http_request(
       'POST' => $uri,
       headers => { 'Content-Type' => 'application/json' },
-      body    => encode_json($body),
+      body    => $self->json($body),
       $cb
     );
   } else {
@@ -300,11 +320,6 @@ sub view {
   $cv;
 }
 
-sub search {
-  my ($self, $query, $options) = @_;
-  warn "NOT IMPLEMENTED YET";
-}
-
 1;
 
 __END__
@@ -347,6 +362,12 @@ This method returns the name of the database.
 
 This method returns the base URI of the database.
 
+=head3 $db->json_encoder([ $json_encoder ])
+
+This method is a mutator for setting a custom JSON encoder.  You should
+pass in an object that responds to C<encode> and C<decode>.  L<JSON> and
+L<JSON::XS> are good candidates.
+
 =head2 Database Level Operations
 
 =head3 $cv = $db->create