Permalink
Browse files

use uuid for clientId

added bugs section in README
modified request function to catch exception from decode_json
pretty print error when croak
commented test case for sub walk
  • Loading branch information...
1 parent 72ccd2c commit 15032c332a8495cf83611ff3f2493e874518407f @trung committed Apr 10, 2010
Showing with 43 additions and 29 deletions.
  1. +2 −1 Makefile.PL
  2. +7 −2 README
  3. +30 −22 lib/AnyEvent/Riak.pm
  4. +4 −4 t/basic.t
View
@@ -3,9 +3,10 @@ name 'AnyEvent-Riak';
all_from 'lib/AnyEvent/Riak.pm';
requires 'URI';
-requires 'JSON::XS';
+requires 'JSON:XS';
requires 'AnyEvent';
requires 'AnyEvent::HTTP';
+requires 'Data::UUID';
tests 't/*.t';
author_tests 'xt';
View
9 README
@@ -1,5 +1,12 @@
This is Perl module AnyEvent::Riak.
+====
+BUGS
+====
+
+1. walking function doesn't work
+2. link headers must be present
+
============
INSTALLATION
============
@@ -39,5 +46,3 @@ AnyEvent::Riak documentation is available as in POD. So you can do:
% perldoc AnyEvent::Riak
to read the documentation online with your favorite pager.
-
-franck cuny
View
@@ -17,7 +17,7 @@ sub new {
my $host = delete $args{host} || 'http://127.0.0.1:8098';
my $path = delete $args{path} || 'riak';
- my $clientId = delete $args{clientId} || $uuid->create_b64;
+ my $clientId = delete $args{clientId} || $uuid->create_str;
bless {
host => $host,
@@ -30,22 +30,9 @@ sub new {
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 }
+ '204', encode_json { props => $schema }
);
}
@@ -58,7 +45,7 @@ sub fetch {
my ( $self, $bucket, $key, $r ) = @_;
$r = $self->{r} || 2 if !$r;
return $self->_request( 'GET',
- $self->_build_uri( [ $bucket, $key ], { r => $r } ), '200' );
+ $self->_build_uri( [ $bucket, $key ], { r => $r } ), '200,300,304' );
}
sub store {
@@ -71,6 +58,8 @@ sub store {
my $key = $object->{key};
$object->{links} = [] if !exists $object->{links};
+ # Normal status codes: 200 OK, 204 No Content, 300 Multiple Choices.
+ # FIXME Links must be set in the Links header
return $self->_request(
'PUT',
$self->_build_uri(
@@ -81,7 +70,7 @@ sub store {
returnbody => 'true'
}
),
- '200',
+ '200,204,300',
encode_json $object);
}
@@ -93,6 +82,7 @@ sub delete {
$self->_build_uri( [ $bucket, $key ], { dw => $rw } ), 204 );
}
+# FIXME doesn't work. Must handle multipart/fixed returned content
sub walk {
my ( $self, $bucket, $key, $spec ) = @_;
my $path = $self->_build_uri( [ $bucket, $key ] );
@@ -128,16 +118,34 @@ sub _build_uri {
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);
+ if ( $expected =~ m/$headers->{Status}/ ) {
+ eval {
+ if ($body) {
+ return $cv->send( decode_json($body) );
+ } else {
+ return $cv->send(1);
+ }
+ };
+ if ($@) {
+ return $cv->croak(
+ JSON::XS->new->pretty(1)->encode( { method => $method,
+ uri => $uri,
+ body => $body,
+ status => $headers->{Status},
+ reason => $headers->{Reason},
+ error => $@ } ) );
+ }
}
else {
return $cv->croak(
- encode_json( [ $headers->{Status}, $headers->{Reason} ] ) );
+ JSON::XS->new->pretty(1)->encode( { method => $method,
+ uri => $uri,
+ body => $body,
+ status => $headers->{Status},
+ reason => $headers->{Reason}}) );
}
};
if ($body) {
View
@@ -24,7 +24,7 @@ ok my $buckets = $jiak->list_bucket('bar')->recv, "... fetch bucket list";
is scalar @{ $buckets->{keys} }, '0', '... no keys';
ok my $new_bucket
- = $jiak->set_bucket( 'foo', { allowed_fields => '*' } )->recv,
+ = $jiak->set_bucket( 'foo', { allow_mult => 'false' } )->recv,
'... set a new bucket';
my $value = {
@@ -51,8 +51,8 @@ my $second_value = {
};
ok $res = $jiak->store($second_value)->recv, '... set another new key';
-ok $res = $jiak->walk( 'foo', 'baz', [ { bucket => 'foo', } ] )->recv,
- '... walk';
-is $res->{results}->[0]->[0]->{key}, "bar", "... walked to bar";
+#ok $res = $jiak->walk( 'foo', 'baz', [ { bucket => 'foo', } ] )->recv,
+# '... walk';
+#is $res->{results}->[0]->[0]->{key}, "bar", "... walked to bar";
done_testing();

0 comments on commit 15032c3

Please sign in to comment.