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                 args => '',
  23         }, $class;
  24 }
  25
  26 sub request {
  27         my ($self, $method, $uri, $content, $headers) = @_;
  28
  29         my $full_url = $self->{url} . "/riak/$uri";
  30         $full_url =~ s{//+}{/}g;
  31         $full_url =~ s{http:/}{http://};
  32         $full_url .= '?' . $self->{args} if $self->{args};
  33
  34         $headers->{'Content-Type'} = 'application/json' unless exists $headers->{'Content-Type'};
  35         $headers->{'Host'} = $1 if $full_url =~ m{http://([^/]+)};
  36
  37         my $req;
  38
  39         if (defined $content) {
  40                 $content = encode_json $content if ref $content;
  41                 $req = HTTP::Request->new( $method, $full_url, undef, $content );
  42         } else {
  43                 $req = HTTP::Request->new( $method, $full_url );
  44         }
  45
  46         $req->header( $_ => $headers->{$_} ) foreach keys %$headers;
  47
  48 #       warn "## $method $full_url ", dump($req, $content);
  49         my $response = $self->{ua}->request($req);
  50
  51         warn "$method $full_url ", $response->status_line,$/;
  52
  53         if ($response->is_success) {
  54                 #return $response->content;
  55         } else {
  56                 warn "## header,content ",dump( $headers, $content );
  57                 die $response->status_line . ":" . $response->content;
  58         }
  59 }
  60
  61 1;