summary refs log tree commit diff
path: root/lib/AnyEvent/Riak.pm
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2009-12-11 17:16:50 +0100
committerfranck cuny <franck@lumberjaph.net>2009-12-11 17:16:50 +0100
commit4a025d943c6a73c2590eed3a6aebdf3d5bd7f28a (patch)
tree3339152844366f87c5dca4204cf48155a9bb4aba /lib/AnyEvent/Riak.pm
parentinitial commit (diff)
downloadanyevent-riak-4a025d943c6a73c2590eed3a6aebdf3d5bd7f28a.tar.gz
requires methods to do simple tasks
Diffstat (limited to '')
-rw-r--r--lib/AnyEvent/Riak.pm124
1 files changed, 123 insertions, 1 deletions
diff --git a/lib/AnyEvent/Riak.pm b/lib/AnyEvent/Riak.pm
index 23fbf30..1b41c54 100644
--- a/lib/AnyEvent/Riak.pm
+++ b/lib/AnyEvent/Riak.pm
@@ -1,8 +1,130 @@
 package AnyEvent::Riak;
 
-use Moose;
+use strict;
+use Carp;
+use URI;
+use JSON::XS;
+use AnyEvent;
+use AnyEvent::HTTP;
+
 our $VERSION = '0.01';
 
+sub new {
+    my ( $class, %args ) = @_;
+
+    my $host = delete $args{host} || 'http://127.0.0.1:8098';
+    my $path = delete $args{path} || 'jiak';
+
+    bless {
+        host => $host,
+        path => $path,
+        %args,
+    }, $class;
+}
+
+sub set_bucket {
+    my ( $self, $bucket, $schema ) = @_;
+
+    carp "your schema is missing allowed_fields"
+        if ( !exists $schema->{allowed_fields} );
+
+    if ( !exists $schema->{required_fields} ) {
+        $schema->{required_fields} = [];
+    }
+    if ( !exists $schema->{read_mask} ) {
+        $schema->{read_mask} = $schema->{allowed_fields};
+    }
+    if ( !exists $schema->{write_mask} ) {
+        $schema->{write_mask} = $schema->{read_mask};
+    }
+
+    $self->_request('PUT', $self->_build_uri([$bucket]), '204',
+        encode_json{schema => $schema});
+}
+
+sub list_bucket {
+    my ( $self, $bucket ) = @_;
+    return $self->_request('GET', $self->_build_uri([$bucket]), '200');
+}
+
+sub fetch {
+    my ($self, $bucket, $key) = @_;
+    return $self->_request('GET', $self->_build_uri([$bucket, $key]), '200');
+}
+
+sub store {
+    my ( $self, $object ) = @_;
+
+    my $bucket = $object->{bucket};
+    my $key    = $object->{key};
+    return $self->_request(
+        'PUT',
+        $self->_build_uri(
+            [ $bucket, $key ],
+            {
+                dw         => 2,
+                returnbody => 'true'
+            }
+        ),
+        '200',
+        encode_json $object);
+}
+
+sub fetch {
+    my ( $self, $bucket, $key, ) = @_;
+
+    return $self->_request( 'GET',
+        $self->_build_uri( [ $bucket, $key ], { r => 2 } ), '200' );
+}
+
+sub delete {
+    my ( $self, $bucket, $key ) = @_;
+
+    return $self->_request( 'DELETE',
+        $self->_build_uri( [ $bucket, $key ], { dw => 2 } ), 204 );
+}
+
+sub _build_uri {
+    my ( $self, $path, $query ) = @_;
+    my $uri = URI->new( $self->{host} );
+    $uri->path( $self->{path} . "/" . join( "/", @$path ) );
+    $uri->query_form(%$query) if $query;
+    return $uri->as_string;
+}
+
+sub _request {
+    my ( $self, $method, $uri, $expected, $body ) = @_;
+    my $cv = AnyEvent->condvar;
+    my $cb = sub {
+        my ( $body, $headers ) = @_;
+        if ( $headers->{Status} == $expected ) {
+            $body
+                ? return $cv->send( decode_json($body) )
+                : return $cv->send(1);
+        }
+        else {
+            return $cv->send(
+                $headers->{Status} . ' : ' . $headers->{Reason} );
+        }
+    };
+    if ($body) {
+        http_request(
+            $method => $uri,
+            headers => { 'Content-Type' => 'application/json', },
+            body    => $body,
+            $cb
+        );
+    }
+    else {
+        http_request(
+            $method => $uri,
+            headers => { 'Content-Type' => 'application/json', },
+            $cb
+        );
+    }
+    $cv;
+}
+
 1;
 __END__