diff options
author | franck cuny <franck@lumberjaph.net> | 2010-05-10 21:55:40 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2010-05-10 21:55:40 +0200 |
commit | 8a6ae158a03dc0fd678954e9db265a09f9841e09 (patch) | |
tree | 4136d8dce17525344202e4e7a66bc03f3ca6dadd | |
parent | class for bucket and object (diff) | |
download | anyevent-riak-8a6ae158a03dc0fd678954e9db265a09f9841e09.tar.gz |
some roles
-rw-r--r-- | lib/AnyEvent/Riak/Role/CVCB.pm | 27 | ||||
-rw-r--r-- | lib/AnyEvent/Riak/Role/HTTPUtils.pm | 48 |
2 files changed, 75 insertions, 0 deletions
diff --git a/lib/AnyEvent/Riak/Role/CVCB.pm b/lib/AnyEvent/Riak/Role/CVCB.pm new file mode 100644 index 0000000..74684c2 --- /dev/null +++ b/lib/AnyEvent/Riak/Role/CVCB.pm @@ -0,0 +1,27 @@ +package AnyEvent::Riak::Role::CVCB; + +use Moose::Role; + +sub default_cb { + my ($self, $options) = @_; + return sub { + my $res = shift; + return $res; + }; +} + +sub cvcb { + my ($self, $options) = @_; + + my ($cv, $cb); + $cv = AE::cv; + if ($options->{callback}) { + $cb = delete $options->{callback}; + } + else { + $cb = $self->default_cb(); + } + ($cv, $cb); +} + +1; diff --git a/lib/AnyEvent/Riak/Role/HTTPUtils.pm b/lib/AnyEvent/Riak/Role/HTTPUtils.pm new file mode 100644 index 0000000..1963d88 --- /dev/null +++ b/lib/AnyEvent/Riak/Role/HTTPUtils.pm @@ -0,0 +1,48 @@ +package AnyEvent::Riak::Role::HTTPUtils; + +use Moose::Role; + +use AnyEvent; +use AnyEvent::HTTP; +use URI; + +use MIME::Base64; + +has client_id => ( + is => 'rw', + isa => 'Str', + default => + sub { "perl_anyevent_riak" . encode_base64(int(rand(10737411824)), '') } +); + +sub _build_uri { + my ($self, $host, $path, $options) = @_; + my $uri = URI->new($host); + $uri->path(join("/", @$path)); + $uri->query_form($self->_build_query($options)); + warn $uri->as_string; + return $uri->as_string; +} + +sub _build_headers { + my ($self, $options) = @_; + my $headers = delete $options->{headers} || {}; + + warn $self->client_id; + $headers->{'X-Riak-ClientId'} = $self->client_id; + $headers->{'Content-Type'} = 'application/json' + unless exists $headers->{'Content-Type'}; + return $headers; +} + +sub _build_query { + my ($self, $options) = @_; + my $valid_options = [qw/props keys returnbody/]; + my $query; + foreach (@$valid_options) { + $query->{$_} = $options->{$_} if exists $options->{$_}; + } + $query; +} + +1; |