koha/RiakSearch.pm

   1 package RiakSearch;
   2
   3 # https://wiki.basho.com/display/RIAK/Riak+Search
   4
   5 use strict;
   6 use warnings;
   7
   8 use LWP::UserAgent;
   9 use JSON::XS;
  10 use Data::Dump qw/dump/;
  11
  12 sub new {
  13         my ($class, $url) = @_;
  14
  15         my $ua = LWP::UserAgent->new;
  16         $ua->timeout(10);
  17         $ua->env_proxy;
  18
  19         return bless {
  20                 ua  => $ua,
  21                 url => $url,
  22         }, $class;
  23 }
  24
  25 sub request {
  26         my ($self, $method, $uri, $content, $headers) = @_;
  27
  28         my $full_url = $self->{url} . "/riak/$uri";
  29         $full_url =~ s{//+}{/}g;
  30         $full_url =~ s{http:/}{http://};
  31
  32         $headers->{'Content-Type'} = 'application/json' unless exists $headers->{'Content-Type'};
  33
  34         my $req;
  35
  36         if (defined $content) {
  37                 $content = encode_json $content if ref $content;
  38                 $req = HTTP::Request->new( $method, $full_url, undef, $content );
  39         } else {
  40                 $req = HTTP::Request->new( $method, $full_url );
  41         }
  42
  43         $req->header( $_ => $headers->{$_} ) foreach keys %$headers;
  44         $req->header( 'Host' => $1 ) if $self->{url} =~ m{http://([^/]+)};
  45
  46 #       warn "## $method $full_url ", dump($req, $content);
  47         my $response = $self->{ua}->request($req);
  48
  49         warn "$method $full_url ", $response->status_line,$/;
  50
  51         if ($response->is_success) {
  52                 #return $response->content;
  53         } else {
  54                 warn "## header,content ",dump( $headers, $content );
  55                 die $response->status_line . ":" . $response->content;
  56         }
  57 }
  58
  59 1;