git.rot13.org Git - ILL-Zotero-RT/blob - CouchDB.pm

   1 package CouchDB;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LWP::UserAgent;
   7 use JSON;
   8
   9 sub new {
  10   my ($class, $host, $port, $options) = @_;
  11
  12   my $ua = LWP::UserAgent->new;
  13   $ua->timeout(10);
  14   $ua->env_proxy;
  15
  16   return bless {
  17                 ua       => $ua,
  18                 host     => $host,
  19                 port     => $port,
  20                 base_uri => "http://$host:$port/",
  21                }, $class;
  22 }
  23
  24 sub ua { shift->{ua} }
  25 sub base { shift->{base_uri} }
  26
  27 sub request {
  28   my ($self, $method, $uri, $content) = @_;
  29
  30   my $full_uri = $self->base . $uri;
  31   my $req;
  32
  33   if (defined $content) {
  34     #Content-Type: application/json
  35
  36     $req = HTTP::Request->new( $method, $full_uri, undef, encode_json $content );
  37     $req->header('Content-Type' => 'application/json');
  38   } else {
  39     $req = HTTP::Request->new( $method, $full_uri );
  40   }
  41
  42   my $response = $self->ua->request($req);
  43
  44   if ($response->is_success) {
  45     return decode_json $response->content;
  46   } else {
  47     die($response->status_line . ":" . $response->content);
  48   }
  49 }
  50
  51 sub delete {
  52   my ($self, $url) = @_;
  53
  54   $self->request(DELETE => $url);
  55 }
  56
  57 sub get {
  58   my ($self, $url) = @_;
  59
  60   warn "## GET $url";
  61   $self->request(GET => $url);
  62 }
  63
  64 sub put {
  65   my ($self, $url, $json) = @_;
  66
  67   warn "## PUT $url";
  68   $self->request(PUT => $url, $json);
  69 }
  70
  71 sub post {
  72   my ($self, $url, $json) = @_;
  73
  74   $self->request(POST => $url, $json);
  75 }
  76
  77 1;