Changeset 18743 for lang/perl/CouchDB-Object

Timestamp:

09/03/08 19:44:42 (5 years ago)

Author:

masaki

Message:

Documents を無くしてシンプルにした

Location:

lang/perl/CouchDB-Object/trunk

Files:

• Makefile.PL (modified) (1 diff)
• lib/CouchDB/Object.pm (modified) (1 diff)
• lib/CouchDB/Object/Documents.pm (deleted)
• lib/CouchDB/Object/Response.pm (modified) (3 diffs)
• t/00_compile.t (modified) (1 diff)
• t/04_open_doc.t (modified) (3 diffs)
• t/05_remove_doc.t (modified) (1 diff)
• t/06_all_docs.t (modified) (3 diffs)
• t/07_query.t (modified) (4 diffs)

lang/perl/CouchDB-Object/trunk/Makefile.PL

@@ -4 +4 @@
 
 requires 'Moose';
-requires 'MooseX::AttributeHelpers';
 requires 'MooseX::Types::URI';
 requires 'Data::Dump::Streamer';

lang/perl/CouchDB-Object/trunk/lib/CouchDB/Object.pm

@@ -33 +33 @@
 
     my $res = $self->request(GET => $self->uri_for('_all_dbs'));
-    return $self->ping ? map { $self->db($_) } @{ $res->parsed_content } : ();
+    return $self->ping ? map { $self->db($_) } @{ $res->content } : ();
 }
 

lang/perl/CouchDB-Object/trunk/lib/CouchDB/Object/Response.pm

@@ -6 +6 @@
 use JSON::XS ();
 use CouchDB::Object::Document;
-use CouchDB::Object::Documents;
 
 has 'http_response' => (
@@ -29 +28 @@
 has 'content' => (
     is       => 'ro',
-    isa      => 'Hash::AsObject',
+    isa      => 'Object', # XXX
     required => 1,
 );
@@ -40 +39 @@
     my ($class, $res) = @_;
 
-    my $content = {};
-    $content = JSON::XS->new->decode($res->content) if $res->content_type =~ /json/i;
-
     return $class->new(
         http_response => $res,
-        uri           => $res->request->uri,
-        content       => Hash::AsObject->new($content),
+        uri           => $res->request->uri->clone,
+        content       => $class->parse_content($res),
     );
 }
 
-sub to_document {
-    my $self = shift;
+sub parse_content {
+    my ($class, $res) = @_;
 
-    if (exists $self->content->{_id}) {
-        return CouchDB::Object::Document->new_from_json($self->content);
+    my $content = $res->content_type =~ /json/i ? JSON::XS->new->decode($res->content) : {};
+
+    if (ref $content->{rows} eq 'ARRAY') { # _all_docs
+        my @docs = grep { exists $_->{id} and exists $_->{value} } @{ $content->{rows} };
+        for my $doc (@docs) {
+            my $id = delete $doc->{id};
+            $doc = CouchDB::Object::Document->new_from_json($doc->{value});
+            $doc->id($id) if defined $id;
+        }
+        $content->{rows} = \@docs;
     }
-    elsif (exists $self->content->{rows}) {
-        return CouchDB::Object::Documents->new_from_json($self->content);
+    elsif (ref $content->{new_revs} eq 'ARRAY') { # _bulk_docs
+        for my $doc (@{ $content->{new_revs} }) {
+            $doc = CouchDB::Object::Document->new_from_json($doc);
+        }
+    }
+
+    if (exists $content->{_id} and exists $content->{_rev}) {
+        return CouchDB::Object::Document->new_from_json($content);
     }
     else {
-        return;
+        return Hash::AsObject->new($content);
     }
 }

lang/perl/CouchDB-Object/trunk/t/00_compile.t

@@ -1 +1 @@
 use strict;
-use Test::More tests => 7;
+use Test::More tests => 5;
 
 BEGIN {
     use_ok 'CouchDB::Object';
-    use_ok 'CouchDB::Object::Utils';
-    use_ok 'CouchDB::Object::UserAgent';
-    use_ok 'CouchDB::Object::Server';
     use_ok 'CouchDB::Object::Database';
     use_ok 'CouchDB::Object::Document';
     use_ok 'CouchDB::Object::Response';
+    use_ok 'CouchDB::Object::UserAgent';
 }

lang/perl/CouchDB-Object/trunk/t/04_open_doc.t

@@ -8 +8 @@
 }
 else {
-    plan tests => 10;
+    plan tests => 12;
 }
 
@@ -18 +18 @@
     my $res = $db->open_doc('doc id 4');
     ok $res->is_success; # 200
-    my $doc = $res->to_document;
+    my $doc = $res->content;
+    isa_ok $doc => 'CouchDB::Object::Document';
     is $doc->id => 'doc id 4';
     ok $doc->rev;
@@ -29 +30 @@
     my $res = $db->open_doc('doc id 3');
     ok $res->is_success; # 200
-    my $doc = $res->to_document;
+    my $doc = $res->content;
+    isa_ok $doc => 'CouchDB::Object::Document';
     is $doc->id => 'doc id 3';
     ok $doc->rev;

lang/perl/CouchDB-Object/trunk/t/05_remove_doc.t

@@ -16 +16 @@
 for (1..5) {
     my $id = "doc id $_";
-    my $doc = $db->open_doc($id)->to_document;
+    my $doc = $db->open_doc($id)->content;
     ok $db->remove_doc($doc)->is_success; # 200
     ok $db->open_doc($id)->is_error;      # 404

lang/perl/CouchDB-Object/trunk/t/06_all_docs.t

@@ -8 +8 @@
 }
 else {
-    plan tests => 24;
+    plan tests => 22;
 }
 
@@ -18 +18 @@
     ok $res->is_success;
 
-    my $docs = $res->to_document;
-    is $docs->total_docs => 5;
+    my $docs = $res->content;
+    is $docs->total_rows => 5;
     is $docs->offset => 0;
 
-    is $docs->count => 5;
-    for my $doc ($docs->all) { # 2 x 5 = 10
+    for my $doc (@{ $docs->rows }) { # 2 x 5 = 10
         ok $doc->id;
         ok $doc->rev;
@@ -33 +32 @@
     ok $res->is_success;
 
-    my $docs = $res->to_document;
-    is $docs->total_docs => 5;
+    my $docs = $res->content;
+    is $docs->total_rows => 5;
     is $docs->offset => 0;
 
-    is $docs->count => 3;
-    for my $doc ($docs->all) { # 2 x 3 = 6
+    for my $doc (@{ $docs->rows }) { # 2 x 3 = 6
         ok $doc->id;
         ok $doc->rev;

lang/perl/CouchDB-Object/trunk/t/07_query.t

@@ -1 +1 @@
 use strict;
 use t::CouchDB;
-use String::TT qw(strip tt);
+use String::TT qw(strip);
 
 my $couch = test_couch();
@@ -9 +9 @@
 }
 else {
-    plan tests => 8;
+    plan tests => 7;
 }
 
@@ -16 +16 @@
 
 { # doc 3 only
-    my $res = $db->query(strip tt q[
+    my $res = $db->query(strip q[
         function(doc) {
             if (doc.title == "doc 3") {
@@ -25 +25 @@
     ok $res->is_success;
 
-    my $docs = $res->to_document;
-    is $docs->total_docs => 1;
+    my $docs = $res->content;
+    is $docs->total_rows => 1;
     is $docs->offset => 0;
-    is $docs->count => 1;
 
-    for my $doc ($docs->all) { # 1 x 4 = 4
+    for my $doc (@{ $docs->rows }) { # 1 x 4 = 4
         is $doc->id => 'doc id 3';
         ok $doc->rev;