collection_items view

[ILL-Zotero-RT] / CouchDB.pm

diff --git a/CouchDB.pm b/CouchDB.pm
index 9f8cf56..016a7d8 100644 (file)
--- a/CouchDB.pm
+++ b/CouchDB.pm
@@ -7,6 +7,9 @@ use LWP::UserAgent;
 use JSON;
 use Digest::MD5 qw(md5_hex);
 use Data::Dump qw(dump);
+use Encode;
+use Carp;
+use Clone qw(clone);
 
 sub new {
   my ($class, $host, $port, $options) = @_;
@@ -32,16 +35,20 @@ sub ua { shift->{ua} }
 sub base { shift->{base_uri} }
 
 sub request {
-  my ($self, $method, $uri, $content) = @_;
+  my ($self, $method, $uri, $content, $content_type) = @_;
+  $content_type ||= 'application/json';
 
   my $full_uri = $self->base . $uri;
   my $req;
 
-  if (defined $content) {
-    #Content-Type: application/json
+  warn "# request $method $full_uri ", $content ? length($content) : '-' , " $content_type\n";
 
-    $req = HTTP::Request->new( $method, $full_uri, undef, encode_json $content );
-    $req->header('Content-Type' => 'application/json');
+  if (defined $content) {
+    $req = HTTP::Request->new( $method, $full_uri, undef );
+    $req->header( 'Content-Type' => $content_type );
+    my $bytes = ref($content) ? encode_json($content) : $content;
+    $req->content( $bytes ); # convert to bytes
+    warn "### ",dump($bytes);
   } else {
     $req = HTTP::Request->new( $method, $full_uri );
   }
@@ -64,14 +71,12 @@ sub delete {
 sub get {
   my ($self, $url) = @_;
 
-  warn "## GET $url";
   $self->request(GET => $url);
 }
 
 sub put {
   my ($self, $url, $json) = @_;
 
-  warn "## PUT $url";
   $self->request(PUT => $url, $json);
 }
 
@@ -81,29 +86,56 @@ sub post {
   $self->request(POST => $url, $json);
 }
 
-sub update {
+sub x_sync {
+       my ($json,$old) = @_;
+       $json->{$_} = $old->{$_} foreach keys %{ $old->{x_meta} }; # special persistent x_meta fields
+       my $json_md5 = md5_hex encode_json $json;
+       $json->{x_sync}->{json_md5} = $json_md5;
+       my $o =  $old->{x_sync}->{json_md5};
+       my $n = $json->{x_sync}->{json_md5};
+       warn "## x_sync $o ", $o eq $n ? '==' : '!=', " $n\n";
+       return $json;
+}
+
+
+sub modify {
        my ($self, $url, $json) = @_;
 
-       warn "# update_doc $url";
+       carp "# modify $url ", ref $json;
 
-       my $json_md5 = md5_hex encode_json $json;
-       $json->{x_sync}->{json_md5} = $json_md5;
+       my $ret;
 
        if ( my $old = eval { $self->get( $url ) } ) {
-               warn "# old ", $old->{_rev}; #dump($old);
+               warn "# old ", $old->{_rev}, dump($old);
 
-               if ( $json_md5 ne $old->{x_sync}->{json_md5} ) {
+               if ( ref $json eq 'CODE' ) {
+                       $json = $json->( clone $old );
+                       warn "# json CODE ",dump($json);
+               } else {
+                       warn "# overwrite old";
                        $json->{_rev} = $old->{_rev};
-                       warn :"# update $url";
-                       $self->put( $url => $json );
+               }
+
+               $json = x_sync($json, $old);
+
+               if ( $json->{x_sync}->{json_md5} ne $old->{x_sync}->{json_md5} ) {
+                       warn "# modify $url";
+                       $ret = $self->put( $url => $json );
                } else {
                        warn "# unchanged $url";
+                       $ret->{rev} = $old->{_rev};
+                       $ret->{id}  = $old->{_id};
                }
        } else {
+               $json = $json->({}) if ref $json eq 'CODE';
+
+               $json = x_sync($json);
+
                warn "# insert $url ", dump($json);
-               $self->put( $url => $json );
+               $ret = $self->put( $url => $json );
        }
 
+       return $ret;
 }
 
 1;