collection_items view

[ILL-Zotero-RT] / CouchDB.pm

diff --git a/CouchDB.pm b/CouchDB.pm
index 8b13b36..016a7d8 100644 (file)
--- a/CouchDB.pm
+++ b/CouchDB.pm
@@ -5,6 +5,11 @@ use warnings;
 
 use LWP::UserAgent;
 use JSON;
 
 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) = @_;
 
 sub new {
   my ($class, $host, $port, $options) = @_;


@@ -13,6 +18,11 @@ sub new {
   $ua->timeout(10);
   $ua->env_proxy;
 
   $ua->timeout(10);
   $ua->env_proxy;
 

+  if ( $ENV{DEBUG} ) {
+       $ua->add_handler("request_send",  sub { shift->dump; return });
+       $ua->add_handler("response_done", sub { shift->dump; return });
+  }
+

   return bless {
                 ua       => $ua,
                 host     => $host,
   return bless {
                 ua       => $ua,
                 host     => $host,


@@ -25,16 +35,20 @@ sub ua { shift->{ua} }
 sub base { shift->{base_uri} }
 
 sub request {
 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;
 
 
   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 );
   }
   } else {
     $req = HTTP::Request->new( $method, $full_uri );
   }


@@ -57,14 +71,12 @@ sub delete {
 sub get {
   my ($self, $url) = @_;
 
 sub get {
   my ($self, $url) = @_;
 

-  warn "## GET $url";

   $self->request(GET => $url);
 }
 
 sub put {
   my ($self, $url, $json) = @_;
 
   $self->request(GET => $url);
 }
 
 sub put {
   my ($self, $url, $json) = @_;
 

-  warn "## PUT $url";

   $self->request(PUT => $url, $json);
 }
 
   $self->request(PUT => $url, $json);
 }
 


@@ -74,4 +86,56 @@ sub post {
   $self->request(POST => $url, $json);
 }
 
   $self->request(POST => $url, $json);
 }
 

+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) = @_;
+
+       carp "# modify $url ", ref $json;
+
+       my $ret;
+
+       if ( my $old = eval { $self->get( $url ) } ) {
+               warn "# old ", $old->{_rev}, dump($old);
+
+               if ( ref $json eq 'CODE' ) {
+                       $json = $json->( clone $old );
+                       warn "# json CODE ",dump($json);
+               } else {
+                       warn "# overwrite old";
+                       $json->{_rev} = $old->{_rev};
+               }
+
+               $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);
+               $ret = $self->put( $url => $json );
+       }
+
+       return $ret;
+}
+

 1;
 1;