summaryrefslogtreecommitdiff
path: root/lib/Net
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Net/Riak.pm12
-rw-r--r--lib/Net/Riak/Bucket.pm28
-rw-r--r--lib/Net/Riak/Client.pm32
-rw-r--r--lib/Net/Riak/MapReduce.pm11
-rw-r--r--lib/Net/Riak/Object.pm16
-rw-r--r--lib/Net/Riak/Role/REST.pm20
6 files changed, 83 insertions, 36 deletions
diff --git a/lib/Net/Riak.pm b/lib/Net/Riak.pm
index ae9319e..77bd773 100644
--- a/lib/Net/Riak.pm
+++ b/lib/Net/Riak.pm
@@ -13,7 +13,7 @@ has client => (
is => 'rw',
isa => 'Net::Riak::Client',
required => 1,
- handles => [qw/request useragent is_alive/]
+ handles => [qw/is_alive http_request http_response/]
);
sub BUILDARGS {
@@ -39,6 +39,8 @@ sub bucket {
$obj->store;
my $obj = $bucket->get('new_post');
+ my $req = $client->http_request; # last request
+ $client->http_response # last response
=head1 DESCRIPTION
@@ -140,6 +142,14 @@ Start assembling a Map/Reduce operation
Start assembling a Map/Reduce operation
+=method http_request
+
+Returns the HTTP::Request object from the last request
+
+=method http_response
+
+Returns a HTTP::Response object from the last request
+
=head2 SEE ALSO
Net::Riak::MapReduce
diff --git a/lib/Net/Riak/Bucket.pm b/lib/Net/Riak/Bucket.pm
index 66359d3..8f263cf 100644
--- a/lib/Net/Riak/Bucket.pm
+++ b/lib/Net/Riak/Bucket.pm
@@ -8,8 +8,9 @@ use Carp;
use Net::Riak::Object;
with 'Net::Riak::Role::Replica' => {keys => [qw/r w dw/]};
-with 'Net::Riak::Role::Base' =>
- {classes => [{name => 'client', required => 1}]};
+with 'Net::Riak::Role::Base' => {
+ classes => [{ name => 'client', required => 1, }]
+};
has name => (
is => 'ro',
@@ -84,14 +85,14 @@ sub get_properties {
$params->{props} = 'true' unless exists $params->{props};
$params->{keys} = 'false' unless exists $params->{keys};
- my $request =
- $self->client->request('GET', [$self->client->prefix, $self->name],
- $params);
+ my $request = $self->client->new_request(
+ 'GET', [$self->client->prefix, $self->name], $params
+ );
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
- if (!$response->is_success) {
- die "Error getting bucket properties: " . $response->status_line . "\n";
+ unless ($response->is_success) {
+ die "Error getting bucket properties: ".$response->status_line."\n";
}
if ($params->{keys} ne 'stream') {
@@ -119,13 +120,16 @@ sub get_properties {
sub set_properties {
my ($self, $props) = @_;
- my $request = $self->client->request('PUT', [$self->client->prefix, $self->name]);
+ my $request = $self->client->new_request(
+ 'PUT', [$self->client->prefix, $self->name]
+ );
+
$request->header('Content-Type' => $self->content_type);
$request->content(JSON::encode_json({props => $props}));
- my $response = $self->client->useragent->request($request);
- if (!$response->is_success) {
- die "Error setting bucket properties: " . $response->status_line . "\n";
+ my $response = $self->client->send_request($request);
+ unless ($response->is_success) {
+ die "Error setting bucket properties: ".$response->status_line."\n";
}
}
diff --git a/lib/Net/Riak/Client.pm b/lib/Net/Riak/Client.pm
index 19d172f..e76a0ef 100644
--- a/lib/Net/Riak/Client.pm
+++ b/lib/Net/Riak/Client.pm
@@ -2,12 +2,10 @@ package Net::Riak::Client;
use Moose;
use MIME::Base64;
+use Moose::Util::TypeConstraints;
-with qw/
- Net::Riak::Role::REST
- Net::Riak::Role::UserAgent
- Net::Riak::Role::Hosts
- /;
+class_type 'HTTP::Request';
+class_type 'HTTP::Response';
has prefix => (
is => 'rw',
@@ -29,6 +27,24 @@ has client_id => (
isa => 'Str',
lazy_build => 1,
);
+has http_request => (
+ is => 'rw',
+ isa => 'HTTP::Request',
+);
+
+has http_response => (
+ is => 'rw',
+ isa => 'HTTP::Response',
+ handles => ['is_success']
+);
+
+with 'Net::Riak::Role::UserAgent';
+with qw/
+ Net::Riak::Role::REST
+ Net::Riak::Role::Hosts
+ /;
+
+
sub _build_client_id {
"perl_net_riak" . encode_base64(int(rand(10737411824)), '');
@@ -36,9 +52,9 @@ sub _build_client_id {
sub is_alive {
my $self = shift;
- my $request = $self->request('GET', ['ping']);
- my $response = $self->useragent->request($request);
- $response->is_success ? return 1 : return 0;
+ my $request = $self->new_request('GET', ['ping']);
+ my $response = $self->send_request($request);
+ $self->is_success ? return 1 : return 0;
}
1;
diff --git a/lib/Net/Riak/MapReduce.pm b/lib/Net/Riak/MapReduce.pm
index f0dffd5..03a3dd3 100644
--- a/lib/Net/Riak/MapReduce.pm
+++ b/lib/Net/Riak/MapReduce.pm
@@ -159,17 +159,18 @@ sub run {
my $content = JSON::encode_json($job);
- my $request =
- $self->client->request('POST', [$self->client->mapred_prefix]);
+ my $request = $self->client->new_request(
+ 'POST', [$self->client->mapred_prefix]
+ );
$request->content($content);
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
unless ($response->is_success) {
- die $response->content;
+ die "MapReduce query failed: ".$response->status_line;
}
- my $result = JSON::decode_json($response->content);
+ my $result = JSON::decode_json($response->content);
if ( $timeout && ( $ua_timeout != $self->client->useragent->timeout() ) ) {
$self->client->useragent->timeout($ua_timeout);
diff --git a/lib/Net/Riak/Object.pm b/lib/Net/Riak/Object.pm
index ba9f475..656d71a 100644
--- a/lib/Net/Riak/Object.pm
+++ b/lib/Net/Riak/Object.pm
@@ -61,7 +61,7 @@ sub store {
my $params = {returnbody => 'true', w => $w, dw => $dw};
my $request =
- $self->client->request('PUT',
+ $self->client->new_request('PUT',
[$self->client->prefix, $self->bucket->name, $self->key], $params);
$request->header('X-Riak-ClientID' => $self->client->client_id);
@@ -82,7 +82,7 @@ sub store {
$request->content($self->data);
}
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
$self->populate($response, [200, 300]);
$self;
}
@@ -98,10 +98,10 @@ sub load {
my $params = {r => $self->r};
my $request =
- $self->client->request('GET',
+ $self->client->new_request('GET',
[$self->client->prefix, $self->bucket->name, $self->key], $params);
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
$self->populate($response, [200, 300, 404]);
$self;
}
@@ -113,10 +113,10 @@ sub delete {
my $params = {dw => $dw};
my $request =
- $self->client->request('DELETE',
+ $self->client->new_request('DELETE',
[$self->client->prefix, $self->bucket->name, $self->key], $params);
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
$self->populate($response, [204, 404]);
$self;
}
@@ -205,9 +205,9 @@ sub sibling {
my $params = {r => $r, vtag => $vtag};
my $request =
- $self->client->request('GET',
+ $self->client->new_request('GET',
[$self->client->prefix, $self->bucket->name, $self->key], $params);
- my $response = $self->client->useragent->request($request);
+ my $response = $self->client->send_request($request);
my $obj = Net::Riak::Object->new(
client => $self->client,
diff --git a/lib/Net/Riak/Role/REST.pm b/lib/Net/Riak/Role/REST.pm
index 1a18ff7..136ea88 100644
--- a/lib/Net/Riak/Role/REST.pm
+++ b/lib/Net/Riak/Role/REST.pm
@@ -6,6 +6,10 @@ use URI;
use HTTP::Request;
use Moose::Role;
+requires 'http_request';
+requires 'http_response';
+requires 'useragent';
+
sub _build_path {
my ($self, $path) = @_;
$path = join('/', @$path);
@@ -20,10 +24,22 @@ sub _build_uri {
$uri;
}
-sub request {
+# constructs a HTTP::Request
+sub new_request {
my ($self, $method, $path, $params) = @_;
my $uri = $self->_build_uri($path, $params);
- HTTP::Request->new($method => $uri);
+ return HTTP::Request->new($method => $uri);
+}
+
+# makes a HTTP::Request returns and stores a HTTP::Response
+sub send_request {
+ my ($self, $req) = @_;
+
+ $self->http_request($req);
+ my $r = $self->useragent->request($req);
+ $self->http_response($r);
+
+ return $r;
}
1;
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 12:59:33 +0000