8 use Digest::MD5 qw(md5_hex);
9 use Data::Dump qw(dump);
15 my ($class, $host, $port, $options) = @_;
17 my $ua = LWP::UserAgent->new;
22 $ua->add_handler("request_send", sub { shift->dump; return });
23 $ua->add_handler("response_done", sub { shift->dump; return });
30 base_uri => "http://$host:$port/",
34 sub ua { shift->{ua} }
35 sub base { shift->{base_uri} }
38 my ($self, $method, $uri, $content, $content_type) = @_;
39 $content_type ||= 'application/json';
41 my $full_uri = $self->base . $uri;
44 warn "# request $method $full_uri ", $content ? length($content) : '-' , " $content_type\n";
46 if (defined $content) {
47 $req = HTTP::Request->new( $method, $full_uri, undef );
48 $req->header( 'Content-Type' => $content_type );
49 my $bytes = ref($content) ? encode_json($content) : $content;
50 $req->content( $bytes ); # convert to bytes
51 warn "### ",dump($bytes);
53 $req = HTTP::Request->new( $method, $full_uri );
56 my $response = $self->ua->request($req);
58 if ($response->is_success) {
59 return decode_json $response->content;
61 die($response->status_line . ":" . $response->content);
66 my ($self, $url) = @_;
68 $self->request(DELETE => $url);
72 my ($self, $url) = @_;
74 $self->request(GET => $url);
78 my ($self, $url, $json) = @_;
80 $self->request(PUT => $url, $json);
84 my ($self, $url, $json) = @_;
86 $self->request(POST => $url, $json);
91 $json->{$_} = $old->{$_} foreach keys %{ $old->{x_meta} }; # special persistent x_meta fields
92 my $json_md5 = md5_hex encode_json $json;
93 $json->{x_sync}->{json_md5} = $json_md5;
94 my $o = $old->{x_sync}->{json_md5};
95 my $n = $json->{x_sync}->{json_md5};
96 warn "## x_sync $o ", $o eq $n ? '==' : '!=', " $n\n";
102 my ($self, $url, $json) = @_;
104 carp "# modify $url ", ref $json;
108 if ( my $old = eval { $self->get( $url ) } ) {
109 warn "# old ", $old->{_rev}, dump($old);
111 if ( ref $json eq 'CODE' ) {
112 $json = $json->( clone $old );
113 warn "# json CODE ",dump($json);
115 warn "# overwrite old";
116 $json->{_rev} = $old->{_rev};
119 $json = x_sync($json, $old);
121 if ( $json->{x_sync}->{json_md5} ne $old->{x_sync}->{json_md5} ) {
122 warn "# modify $url";
123 $ret = $self->put( $url => $json );
125 warn "# unchanged $url";
126 $ret->{rev} = $old->{_rev};
127 $ret->{id} = $old->{_id};
130 $json = $json->({}) if ref $json eq 'CODE';
132 $json = x_sync($json);
134 warn "# insert $url ", dump($json);
135 $ret = $self->put( $url => $json );