X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=CouchDB.pm;fp=CouchDB.pm;h=c2c9cdac96e7f430a98402a2fbddd15eb28a720f;hb=3b589c57c8b5dab4d1967e2407fb39914978231d;hp=9f8cf561fad17c8888211a08ab3ceb4c7941626d;hpb=2df4ed6146b9fef5c869d920e0068f2c610d915a;p=ILL-Zotero-RT

diff --git a/CouchDB.pm b/CouchDB.pm
index 9f8cf56..c2c9cda 100644
--- 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,43 @@ sub post {
   $self->request(POST => $url, $json);
 }
 
-sub update {
+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 );
+		}
+
+		my $json_md5 = md5_hex encode_json $json;
+		$json->{x_sync}->{json_md5} = $json_md5;
+
+		warn "# json_md5 $json_md5 == $old->{x_sync}->{json_md5}\n";
+		if ( $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';
 		warn "# insert $url ", dump($json);
-		$self->put( $url => $json );
+		$ret = $self->put( $url => $json );
 	}
 
+	return $ret;
 }
 
 1;