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);
90 my ($self, $url, $json) = @_;
92 carp "# modify $url ", ref $json;
96 if ( my $old = eval { $self->get( $url ) } ) {
97 warn "# old ", $old->{_rev}, dump($old);
99 if ( ref $json eq 'CODE' ) {
100 $json = $json->( clone $old );
101 warn "# json CODE ",dump($json);
103 warn "# overwrite old";
104 $json->{_rev} = $old->{_rev};
107 my $json_md5 = md5_hex encode_json $json;
108 $json->{x_sync}->{json_md5} = $json_md5;
110 warn "# json_md5 $json_md5 == $old->{x_sync}->{json_md5}\n";
111 if ( $json_md5 ne $old->{x_sync}->{json_md5} ) {
112 warn "# modify $url";
113 $ret = $self->put( $url => $json );
115 warn "# unchanged $url";
116 $ret->{rev} = $old->{_rev};
117 $ret->{id} = $old->{_id};
120 $json = $json->({}) if ref $json eq 'CODE';
121 warn "# insert $url ", dump($json);
122 $ret = $self->put( $url => $json );