3 # http://wiki.apache.org/couchdb/Getting_started_with_Perl
10 use Data::Dump qw/dump/;
11 use Time::HiRes qw/time/;
12 use Data::Structure::Util qw(unbless);
13 use Scalar::Util qw/blessed/;
14 use Storable qw/dclone/;
17 my ($class, $host, $port, $options) = @_;
19 my $ua = LWP::UserAgent->new;
23 $host ||= 'localhost';
30 base_uri => "http://$host:$port/",
34 sub ua { shift->{ua} }
35 sub base { shift->{base_uri} }
38 my ($self, $method, $uri, $content) = @_;
40 my $full_uri = $self->base . $uri;
43 if (defined $content) {
44 #Content-Type: application/json
46 $req = HTTP::Request->new( $method, $full_uri, undef, $content );
47 $req->header('Content-Type' => 'application/json');
49 $req = HTTP::Request->new( $method, $full_uri );
52 my $response = $self->ua->request($req);
54 if ($response->is_success) {
55 return $response->content;
57 die($response->status_line . ":" . $response->content);
64 my ($self, $url) = @_;
66 $self->request(DELETE => $url);
70 my ($self, $url) = @_;
72 JSON->new->utf8->decode( $self->request(GET => $url) );
76 my ($self, $url, $json) = @_;
77 warn "put $url ",dump($json);
79 if ( ! defined $json->{_rev} ) {
80 my $old = eval { $self->get( $url )->{_rev} };
81 $rev->{$url} = $json->{_rev} = $old if defined $old;
84 $json = unbless dclone $json if blessed $json;
86 $json = JSON->new->utf8->encode( $json ) if $json;
88 $self->request(PUT => $url, $json);
92 my ($self, $url, $json) = @_;
94 $self->request(POST => $url, $json);
97 our $audit = __PACKAGE__->new;
102 my $url = join(' ', @_);
106 my ( $package, undef, $line, $sub ) = caller(1);
107 ( $package, undef, $line ) = caller(0) if $package eq 'main';
112 'package' => $package,
117 $audit->put( "pxelator/$package.$url", $data );