summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes3
-rw-r--r--Makefile.PL18
-rw-r--r--README27
-rw-r--r--dist.ini28
-rw-r--r--lib/AnyEvent/Riak.pm303
-rw-r--r--lib/AnyEvent/Riak/Bucket.pm113
-rw-r--r--lib/AnyEvent/Riak/Object.pm52
-rw-r--r--lib/AnyEvent/Riak/Role/CVCB.pm24
-rw-r--r--lib/AnyEvent/Riak/Role/Client.pm12
-rw-r--r--lib/AnyEvent/Riak/Role/HTTPUtils.pm16
-rw-r--r--t/10_async.t88
-rw-r--r--t/basic.t102
-rw-r--r--xt/00_sync.t39
-rw-r--r--xt/01_async.t150
14 files changed, 378 insertions, 597 deletions
diff --git a/Changes b/Changes
index d06fe45..2551dc4 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,7 @@
Revision history for Perl extension AnyEvent::Riak
+0.02 Fri 04 Jun 2010 11:03:49 AM CEST
+ - reflect API changes from riak 0.9 to 0.10
+
0.01 Thu Dec 10 14:22:38 2009
- original version
diff --git a/Makefile.PL b/Makefile.PL
deleted file mode 100644
index 03e958a..0000000
--- a/Makefile.PL
+++ /dev/null
@@ -1,18 +0,0 @@
-use inc::Module::Install;
-name 'AnyEvent-Riak';
-all_from 'lib/AnyEvent/Riak.pm';
-
-requires 'URI';
-requires 'JSON::XS';
-requires 'AnyEvent';
-requires 'AnyEvent::HTTP';
-
-tests 't/*.t';
-author_tests 'xt';
-
-build_requires 'Test::More';
-build_requires 'Test::Exception';
-use_test_base;
-auto_include;
-auto_set_repository;
-WriteAll;
diff --git a/README b/README
deleted file mode 100644
index 6ffa4fa..0000000
--- a/README
+++ /dev/null
@@ -1,27 +0,0 @@
-This is Perl module AnyEvent::Riak.
-
-INSTALLATION
-
-AnyEvent::Riak installation is straightforward. If your CPAN shell is set up,
-you should just be able to do
-
- % cpan AnyEvent::Riak
-
-Download it, unpack it, then build it as per the usual:
-
- % perl Makefile.PL
- % make && make test
-
-Then install it:
-
- % make install
-
-DOCUMENTATION
-
-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
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..70d8dc1
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,28 @@
+name = AnyEvent-Riak
+author = franck cuny <franck@lumberjaph.net>
+license = Perl_5
+copyright_holder = linkfluence
+copyright_year = 2010
+version = 0.02
+
+[@Filter]
+bundle = @Basic
+
+[MetaConfig]
+[MetaJSON]
+[PkgVersion]
+[PodSyntaxTests]
+[PodCoverageTests]
+[NoTabsTests]
+[EOLTests]
+
+[MetaResources]
+repository = git://github.com/franckcuny/anyevent-riak.git
+bugtracker = http://rt.cpan.org/Public/Dist/Display.html?Name=AnyEvent::Riak
+homepage = http://search.cpan.org/perldoc?AnyEvent::Riak
+
+[PodWeaver]
+[AutoPrereq]
+[ReadmeFromPod]
+[CheckChangeLog]
+[UploadToCPAN]
diff --git a/lib/AnyEvent/Riak.pm b/lib/AnyEvent/Riak.pm
index ab72249..96b9c47 100644
--- a/lib/AnyEvent/Riak.pm
+++ b/lib/AnyEvent/Riak.pm
@@ -1,46 +1,32 @@
package AnyEvent::Riak;
-use strict;
-use warnings;
+# ABSTRACT: non-blocking Riak client
-use Carp;
use JSON;
use AnyEvent;
use AnyEvent::HTTP;
-use MIME::Base64;
-use YAML::Syck;
-
use Moose;
-with qw/
- AnyEvent::Riak::Role::CVCB
- AnyEvent::Riak::Role::HTTPUtils
- /;
-use AnyEvent::Riak::Bucket;
+with qw/AnyEvent::Riak::Role::HTTPUtils AnyEvent::Riak::Role::CVCB/;
our $VERSION = '0.02';
has host => (is => 'rw', isa => 'Str', default => 'http://127.0.0.1:8098');
-has path => (is => 'rw', isa => 'Str', default => 'riak');
+has path => (is => 'rw', isa => 'Str', default => 'riak');
has mapred_path => (is => 'rw', isa => 'Str', default => 'mapred');
has r => (is => 'rw', isa => 'Int', default => 2);
has w => (is => 'rw', isa => 'Int', default => 2);
has dw => (is => 'rw', isa => 'Int', default => 2);
-has client_id => (
- is => 'rw',
- isa => 'Str',
- default =>
- sub { "perl_anyevent_riak" . encode_base64(int(rand(10737411824)), '') }
-);
sub is_alive {
- my ($self, %options) = @_;
+ my $self = shift;
- my ($cv, $cb) = $self->cvcb(\%options);
+ my ($cv, $cb) = $self->_cvcb(\@_);
+ my $options = shift;
http_request(
GET => $self->_build_uri([qw/ping/]),
- headers => $self->_build_headers($options{params}),
+ headers => $self->_build_headers(),
sub {
my ($body, $headers) = @_;
if ($headers->{Status} == 200) {
@@ -49,46 +35,51 @@ sub is_alive {
else {
$cv->send($cb->(0));
}
- },
+ }
);
- return $cv;
+ $cv;
}
sub list_bucket {
- my ($self, $bucket_name, %options) = @_;
- my ($cv, $cb) = $self->cvcb(\%options);
+ my $self = shift;
+ my $bucket_name = shift;
+
+ my ($cv, $cb) = $self->_cvcb(\@_);
+ my $options = shift;
+
+ my $params = {
+ props => delete $options->{props} || 'true',
+ keys => delete $options->{keys} || 'true',
+ };
http_request(
- GET => $self->_build_uri(
- [$self->{path}, $bucket_name],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
+ GET => $self->_build_uri([$self->path, $bucket_name], $params),
+ headers => $self->_build_headers(),
sub {
-
my ($body, $headers) = @_;
if ($body && $headers->{Status} == 200) {
my $res = JSON::decode_json($body);
$cv->send($cb->($res));
}
else {
- $cv->send(undef);
+ $cv->send($cb->(undef));
}
}
);
- return $cv;
+ $cv;
}
sub set_bucket {
- my ($self, $bucket, $schema, %options) = @_;
+ my $self = shift;
+ my $bucket_name = shift;
+ my $schema = shift;
- my ($cv, $cb) = $self->cvcb(\%options);
+ my ($cv, $cb) = $self->_cvcb(\@_);
http_request(
- PUT =>
- $self->_build_uri([$self->{path}, $bucket], $options{params}),
- headers => $self->_build_headers($options{params}),
- body => JSON::encode_json({props => $schema}),
+ PUT => $self->_build_uri([$self->path, $bucket_name]),
+ headers => $self->_build_headers(),
+ body => JSON::encode_json({props => $schema}),
sub {
my ($body, $headers) = @_;
if ($headers->{Status} == 204) {
@@ -103,18 +94,32 @@ sub set_bucket {
}
sub fetch {
- my ($self, $bucket, $key, %options) = @_;
+ my $self = shift;
+ my $bucket_name = shift;
+ my $key = shift;
+
+ my ($cv, $cb) = $self->_cvcb(\@_);
+ my $options = shift;
+
+ my $params = {r => $options->{params}->{r} || $self->r,};
- my ($cv, $cb) = $self->cvcb(\%options);
+ if ($options->{vtag}) {
+ $params->{vtag} = delete $options->{vtag};
+ }
+
+ my $headers = {};
+ foreach (qw/If-None-Match If-Modified-Since Accept/) {
+ $headers->{$_} = delete $options->{headers}->{$_}
+ if (exists $options->{headers}->{$_});
+ }
http_request(
- GET => $self->_build_uri(
- [$self->{path}, $bucket, $key],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
+ GET =>
+ $self->_build_uri([$self->path, $bucket_name, $key], $params),
+ headers => $self->_build_headers($headers),
sub {
my ($body, $headers) = @_;
+ # XXX 300 && 304
if ($body && $headers->{Status} == 200) {
$cv->send($cb->(JSON::decode_json($body)));
}
@@ -127,67 +132,80 @@ sub fetch {
}
sub store {
- my ($self, $bucket, $key, $object, %options) = @_;
+ my $self = shift;
+ my $bucket_name = shift;
+ my $object = shift;
+
+ my ($cv, $cb) = $self->_cvcb(\@_);
+ my $options = shift;
+ my $key = '';
+
+ my $params = {
+ w => $options->{params}->{w} || $self->w,
+ dw => $options->{params}->{dw} || $self->dw,
+ returnbody => $options->{params}->{returnbody} || 'true',
+ };
- my ($cv, $cb) = $self->cvcb(\%options);
+ if ($options->{key}) {
+ $key = delete $options->{key};
+ $params->{r} = $options->{params}->{r} || $self->r;
+ }
+
+ # XXX headers
my $json = JSON::encode_json($object);
http_request(
- POST => $self->_build_uri(
- [$self->{path}, $bucket, $key],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
+ POST => $self->_build_uri([$self->path, $bucket_name, $key,], $params),
+ headers => $self->_build_headers(),
body => $json,
sub {
my ($body, $headers) = @_;
my $result;
- if ($headers->{Status} == 204) {
+ if ($body && ($headers->{Status} == 201 || $headers->{Status} == 200)) {
$result = $body ? JSON::decode_json($body) : 1;
}
+ elsif ($headers->{Status} == 204) {
+ $result = 1;
+ }
else {
$result = 0;
}
- $cv->send($cb->($result));
+ $cv->send($cb->($result, $headers));
}
);
$cv;
}
sub delete {
- my ($self, $bucket, $key, %options) = @_;
+ my $self = shift;
+ my $bucket_name = shift;
+ my $key = shift;
- my ($cv, $cb) = $self->cvcb(\%options);
+ my ($cv, $cb) = $self->_cvcb(@_);
http_request(
- DELETE => $self->_build_uri(
- [$self->{path}, $bucket, $key],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
+ DELETE => $self->_build_uri([$self->path, $bucket_name, $key],),
+ headers => $self->_build_headers(),
sub {
- $cv->send($cb->(@_));
+ my ($body, $headers) = @_;
+ if ($headers->{Status} == 204) {
+ $cv->send($cb->(1));
+ }
+ else {
+ $cv->send($cb->(0));
+ }
}
);
$cv;
}
-sub bucket {
- my ($self, $name) = @_;
- return AnyEvent::Riak::Bucket->new(name => $name, _client => $self);
-}
-
no Moose;
1;
__END__
-=head1 NAME
-
-AnyEvent::Riak - Non-blocking Riak client
-
=head1 SYNOPSIS
use AnyEvent::Riak;
@@ -197,132 +215,87 @@ AnyEvent::Riak - Non-blocking Riak client
path => 'riak',
);
- die "Riak is not running" unless $riak->is_alive->recv;
-
- my $bucket = $riak->set_bucket('foo', {props => {n_val => 5}})->recv;
-
This version is not compatible with the previous version (0.01) of this module and with Riak < 0.91.
-For a complete description of the Riak REST API, please refer to
-L<https://wiki.basho.com/display/RIAK/REST+API>.
+For a complete description of the Riak REST API, please refer to L<https://wiki.basho.com/display/RIAK/REST+API>.
=head1 DESCRIPTION
AnyEvent::Riak is a non-blocking riak client using C<AnyEvent>. This client allows you to connect to a Riak instance, create, modify and delete Riak objects.
-There is two interfaces for this module :
-
-=over 4
-
-=item B<raw JSON>
-
-This interface will only serialize and deserialize JSON return from the Riak REST API.
-
-=item B<OO>
-
-This interface will turn Riak buckets into Object, the same for Riak objects.
-
-=back
-
=head2 METHODS
-=head3 RAW
-
=over 4
-=item B<is_alive>([callback => sub { }, params => { }])
-
-Check if the Riak server is alive. If the ping is successful, 1 is returned,
-else 0.
+=item B<is_alive> ([$cv, $cb])
- my $ping = $riak->is_alive->recv;
+Check if the Riak server is alive. If the ping is successful, 1 is returned, else 0.
-=item B<list_bucket>($bucketname, [callback => sub { }, params => { }])
+Options can be:
-Get the schema and key list for 'bucket'. Possible parameters are:
-
-=over 2
+=over 4
-=item
+=item B<headers>
-props=[true|false] - whether to return the bucket properties
+A list of valid HTTP headers that will be send with the query
-=item
+=back
-keys=[true|false|stream] - whether to return the keys stored in the bucket
+=item B<list_bucket> ($bucket_name, [$options, $cv, $cb])
-=back
+Reads the bucket properties and/or keys.
-If the operation failed, C<undef> is returned, else an hash reference
-describing the bucket is returned.
-
- my $bucket = $riak->list_bucket(
- 'bucketname',
- parameters => {
- props => 'false',
- },
- callback => sub {
- my $struct = shift;
- if ( scalar @{ $struct->{keys} } ) {
- # do something
- }
+ $riak->list_bucket(
+ 'mybucket',
+ {props => 'true', keys => 'false'},
+ sub {
+ my $res = shift;
+ ...
}
- );
+ );
-=item B<set_bucket>($bucketname, $bucketschema, [parameters => { }, callback => sub { }])
+=item B<set_bucket> ($bucket_name, $schema, [%options, $cv, $cb])
Sets bucket properties like n_val and allow_mult.
-=over 2
-
-=item
-
-n_val - the number of replicas for objects in this bucket
-
-=item
-
-allow_mult - whether to allow sibling objects to be created (concurrent updates)
-
-=back
-
-If successful, B<1> is returned, else B<0>.
-
- my $result = $riak->set_bucket('bucket'), {n_val => 5}->recv;
+ $riak->set_bucket(
+ 'mybucket',
+ {n_val => 5},
+ sub {
+ my $res = shift;
+ ...;
+ }
+ );
-=item B<fetch>($bucketname, $object, [parameters => { }, callback => sub { }])
+=item B<fetch> ($bucket_name, $key, [$options, $cv, $cb])
Reads an object from a bucket.
-=item B<store>($bucketname, $objectname, $objectdata, [parameters => { }, callback => sub { }]);
-
-=item B<delete>($bucketname, $objectname, [parameters => { }, callback => sub { }]);
-
-=back
-
-=head3 OO
-
-=item B<bucket>($bucketname);
-
-Return a C<AnyEvent::Riak::Bucket> object.
-
- my $r = AnyEvent::Riak->new(...);
- my $bucket = $r->bucket('foo');
- say $bucket->name;
- say $bucket->properties->{props}->{nval};
-
-=head1 AUTHOR
+ $riak->fetch(
+ 'mybucket', 'mykey',
+ {params => {r = 2}, headers => {'If-Modified-Since' => $value}},
+ sub {
+ my $res = shift;
+ }
+ );
-franck cuny E<lt>franck@lumberjaph.netE<gt>
+=item B<store> ($bucket_name, $key, $object, [$options, $cv, $cb])
-=head1 SEE ALSO
+Stores a new object in a bucket.
-=head1 LICENSE
+ $riak->store(
+ 'mybucket', $object,
+ {key => 'mykey', headers => {''}, params => {w => 2}},
+ sub {
+ my $res = shift;
+ ...
+ }
+ );
-Copyright 2009, 2010 by linkfluence.
+=item B<delete> ($bucket, $key, [$options, $cv, $cb])
-L<http://linkfluence.net>
+Deletes an object from a bucket.
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+ $riak->delete('mybucket', 'mykey', sub { my $res = shift;... });
-=cut
+=back
diff --git a/lib/AnyEvent/Riak/Bucket.pm b/lib/AnyEvent/Riak/Bucket.pm
deleted file mode 100644
index 0c690dd..0000000
--- a/lib/AnyEvent/Riak/Bucket.pm
+++ /dev/null
@@ -1,113 +0,0 @@
-package AnyEvent::Riak::Bucket;
-
-use Moose;
-use AnyEvent::HTTP;
-
-use AnyEvent::Riak::Object;
-
-with qw/
- AnyEvent::Riak::Role::CVCB
- AnyEvent::Riak::Role::HTTPUtils
- AnyEvent::Riak::Role::Client
- /;
-
-has name => (is => 'rw', isa => 'Str', required => 1);
-has _properties =>
- (is => 'rw', isa => 'HashRef', predicate => '_has_properties');
-has r => (
- is => 'rw',
- isa => 'Int',
- lazy => 1,
- default => sub { my $self = shift; $self->_client->r }
-);
-has w => (
- is => 'rw',
- isa => 'Int',
- lazy => 1,
- default => sub { my $self = shift; $self->_client->w }
-);
-has dw => (
- is => 'rw',
- isa => 'Int',
- lazy => 1,
- default => sub { my $self = shift; $self->_client->dw }
-);
-
-sub get_properties {
- my ($self, %options) = @_;
-
- my ($cv, $cb) = $self->cvcb(\%options);
-
- if ($self->_has_properties) {
- $cv->send($self->_properties);
- }
- else {
- http_request(
- GET => $self->_build_uri(
- [$self->_client->path, $self->name],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
- sub {
- my ($body, $headers) = @_;
- if ($body && $headers->{Status} == 200) {
- my $prop = JSON::decode_json($body);
- $self->_properties($prop);
- $cv->send($cb->($self->_properties));
- }
- else {
- $cv->send(undef);
- }
- }
- );
- }
- return $cv;
-}
-
-sub set_properties {
- my ($self, $schema, %options) = @_;
-
- my ($cv, $cb) = $self->cvcb(\%options);
-
- http_request(
- PUT =>
- $self->_build_uri([$self->{path}, $self->name], $options{params}),
- headers => $self->_build_headers($options{params}),
- body => JSON::encode_json({props => $schema}),
- sub {
- my ($body, $headers) = @_;
- if ($headers->{Status} == 204) {
- $cv->send($cb->(1));
- }
- else {
- $cv->send($cb->(0));
- }
- }
- );
- return $cv;
-}
-
-sub create {
- my ($self, $key, $content) = @_;
- my $object = AnyEvent::Riak::Object->new(
- _client => $self->_client,
- key => $key,
- content => $content,
- bucket => $self,
- );
- return $object;
-}
-
-sub object {
- my ($self, $key, $r) = @_;
- my $obj = AnyEvent::Riak::Object->new(
- _client => $self->_client,
- key => $key,
- r => $r,
- bucket => $self,
- );
-}
-
-no Moose;
-
-1;
diff --git a/lib/AnyEvent/Riak/Object.pm b/lib/AnyEvent/Riak/Object.pm
deleted file mode 100644
index d106254..0000000
--- a/lib/AnyEvent/Riak/Object.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package AnyEvent::Riak::Object;
-
-use Moose;
-use AnyEvent::HTTP;
-
-with qw/
- AnyEvent::Riak::Role::Client
- AnyEvent::Riak::Role::HTTPUtils
- AnyEvent::Riak::Role::CVCB
- /;
-
-has key => (is => 'rw', isa => 'Str');
-has _content => (is => 'rw', isa => 'HashRef', predicate => '_has_content');
-has content_type => (is => 'rw', isa => 'Str', default => 'application/json');
-has bucket => (is => 'rw', isa => 'AnyEvent::Riak::Bucket', required => 1);
-has status => (is => 'rw', isa => 'Int');
-has r => (is => 'rw', isa => 'Int');
-
-sub get {
- my ($self, %options) = @_;
-
- my ($cv, $cb) = $self->cvcb(\%options);
-
- if ($self->_has_content) {
- $cv->send($self->_content);
- }
- else {
- http_request(
- GET => $self->_build_uri(
- [$self->_client->path, $self->bucket->name, $self->key],
- $options{params}
- ),
- headers => $self->_build_headers($options{params}),
- sub {
- my ($body, $headers) = @_;
- if ($body && $headers->{Status} == 200) {
- my $content = JSON::decode_json($body);
- $self->_content($content);
- $cv->send($cb->($self->_content));
- }
- else {
- $cv->send(undef);
- }
- }
- );
- }
- return $cv;
-}
-
-no Moose;
-
-1;
diff --git a/lib/AnyEvent/Riak/Role/CVCB.pm b/lib/AnyEvent/Riak/Role/CVCB.pm
index 74684c2..73812c2 100644
--- a/lib/AnyEvent/Riak/Role/CVCB.pm
+++ b/lib/AnyEvent/Riak/Role/CVCB.pm
@@ -1,27 +1,19 @@
package AnyEvent::Riak::Role::CVCB;
-use Moose::Role;
+# ABSTRACT: return a default condvar and callback if none defined
-sub default_cb {
- my ($self, $options) = @_;
- return sub {
- my $res = shift;
- return $res;
- };
-}
+use Moose::Role;
-sub cvcb {
+sub _cvcb {
my ($self, $options) = @_;
- my ($cv, $cb);
- $cv = AE::cv;
- if ($options->{callback}) {
- $cb = delete $options->{callback};
- }
- else {
- $cb = $self->default_cb();
+ my ($cv, $cb) = (AnyEvent->condvar, sub { return @_ });
+ if ($options && @$options) {
+ $cv = pop @$options if UNIVERSAL::isa($options->[-1], 'AnyEvent::CondVar');
+ $cb = pop @$options if ref $options->[-1] eq 'CODE';
}
($cv, $cb);
}
1;
+
diff --git a/lib/AnyEvent/Riak/Role/Client.pm b/lib/AnyEvent/Riak/Role/Client.pm
deleted file mode 100644
index 0623e71..0000000
--- a/lib/AnyEvent/Riak/Role/Client.pm
+++ /dev/null
@@ -1,12 +0,0 @@
-package AnyEvent::Riak::Role::Client;
-
-use Moose::Role;
-
-has _client => (
- is => 'rw',
- isa => 'AnyEvent::Riak',
- required => 1,
- handles => {host => 'host', client_id => 'client_id'}
-);
-
-1;
diff --git a/lib/AnyEvent/Riak/Role/HTTPUtils.pm b/lib/AnyEvent/Riak/Role/HTTPUtils.pm
index 399f369..701af5d 100644
--- a/lib/AnyEvent/Riak/Role/HTTPUtils.pm
+++ b/lib/AnyEvent/Riak/Role/HTTPUtils.pm
@@ -1,15 +1,23 @@
package AnyEvent::Riak::Role::HTTPUtils;
+# ABSTRACT: HTTP methods
+
use Moose::Role;
use AnyEvent;
use AnyEvent::HTTP;
use URI;
-
use MIME::Base64;
+has client_id => (is => 'rw', isa => 'Str', lazy_build => 1,);
+
+sub _build_client_id {
+ "perl_anyevent_riak" . encode_base64(int(rand(10737411824)), '');
+}
+
sub _build_uri {
my ($self, $path, $options) = @_;
+
my $uri = URI->new($self->host);
$uri->path(join("/", @$path));
$uri->query_form($self->_build_query($options));
@@ -17,8 +25,8 @@ sub _build_uri {
}
sub _build_headers {
- my ($self, $options) = @_;
- my $headers = delete $options->{headers} || {};
+ my $self = shift;
+ my $headers = shift || {};
$headers->{'X-Riak-ClientId'} = $self->client_id;
$headers->{'Content-Type'} = 'application/json'
@@ -28,7 +36,7 @@ sub _build_headers {
sub _build_query {
my ($self, $options) = @_;
- my $valid_options = [qw/props keys returnbody/];
+ my $valid_options = [qw/props keys returnbody w r dw/];
my $query;
foreach (@$valid_options) {
$query->{$_} = $options->{$_} if exists $options->{$_};
diff --git a/t/10_async.t b/t/10_async.t
deleted file mode 100644
index 9e88280..0000000
--- a/t/10_async.t
+++ /dev/null
@@ -1,88 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use JSON::XS;
-use Test::Exception;
-use AnyEvent::Riak;
-use YAML::Syck;
-
-plan tests => 5;
-
-my ( $host, $path );
-
-BEGIN {
- my $riak_test = $ENV{RIAK_TEST_SERVER};
- ($host, $path) = split ";", $riak_test if $riak_test;
- plan skip_all => 'set $ENV{RIAK_TEST_SERVER} if you want to run the tests'
- unless ($host && $path);
-}
-
-my $bucket = 'test';
-
-ok my $riak = AnyEvent::Riak->new(
- host => $host,
- path => $path,
- w => 1,
- dw => 1
- ),
- 'create riak object';
-
-{
- my $cv = AnyEvent->condvar;
- $cv->begin(sub { $cv->send });
- $cv->begin;
- # ping
- $riak->is_alive(
- callback => sub {
- my $res = shift;
- pass "is alive in cb" if $res;
- $cv->end;
- }
- );
- $cv->end;
- $cv->recv;
-}
-
-{
- my $cv = AnyEvent->condvar;
- $cv->begin(sub { $cv->send });
- $cv->begin;
- # list bucket
- $riak->list_bucket(
- $bucket,
- parameters => {props => 'true', keys => 'true'},
- callback => sub {
- my $res = shift;
- ok $res->{props}, 'got props';
- $cv->end;
- }
- );
- $cv->end;
- $cv->recv;
-}
-
-{
- my $value = {foo => 'bar',};
- my $cv = AnyEvent->condvar;
- $cv->begin(sub { $cv->send });
- $cv->begin;
-
- # store object
- $riak->store(
- $bucket, 'bar3', $value,
- callback => sub {
- pass "store value ok";
- $riak->fetch(
- 'foo', 'bar3',
- callback => sub {
- my $body = shift;
- is_deeply($body, $value, 'value is ok in cb');
- $cv->end;
- }
- );
- }
- );
- $cv->end;
- $cv->recv;
-}
diff --git a/t/basic.t b/t/basic.t
deleted file mode 100644
index 89da815..0000000
--- a/t/basic.t
+++ /dev/null
@@ -1,102 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use JSON::XS;
-use Test::Exception;
-use AnyEvent::Riak;
-use YAML::Syck;
-
-#plan tests => 15;
-
-my ( $host, $path );
-
-BEGIN {
- my $riak_test = $ENV{RIAK_TEST_SERVER};
- ( $host, $path ) = split ";", $riak_test if $riak_test;
- plan skip_all =>
- 'set $ENV{RIAK_TEST_SERVER} if you want to run the tests'
- unless ( $host && $path );
-}
-
-ok my $riak = AnyEvent::Riak->new( host => $host, path => $path, w => 1,
- dw => 1),
- 'create riak object';
-
-# ping
-ok my $ping_one = $riak->is_alive(
- callback => sub {
- my $res = shift;
- pass "is alive in cb" if $res;
- }
- ),
- 'ping with callback';
-
-ok my $ping_two = $riak->is_alive()->recv, 'ping without callback';
-
-ok my $s = $ping_one->recv, 'response from ping without callback';
-is $s, 1, 'valid response from ping';
-
-# list bucket
-ok my $bucket_cb = $riak->list_bucket(
- 'bar',
- parameters => { props => 'true', keys => 'true' },
- callback => sub {
- my $res = shift;
- ok $res->{props};
- is scalar @{ $res->{keys} }, 0, '0 keys in cb';
- }
- ),
- 'fetch bucket list';
-
-ok my $buckets = $riak->list_bucket('bar')->recv, "fetch bucket list, twice";
-is scalar @{ $buckets->{keys} }, '0', 'no keys';
-
-ok my $res_bucket = $bucket_cb->recv, 'get bucket';
-
-# set bucket
-ok my $new_bucket
- = $riak->set_bucket( 'foo', { props => { n_val => 2 } } )->recv,
- 'set a new bucket';
-
-my $value = {
- foo => 'bar',
-};
-
-ok my $res = $riak->store('foo', 'bar', $value)->recv, 'set a new key';
-
-ok $res = $riak->fetch( 'foo', 'bar' )->recv, 'fetch our new key';
-is_deeply $res, $value, 'value is ok';
-# ok $res = $riak->delete( 'foo', 'bar' )->recv, 'delete our key';
-
-# ok my $store_w_cb = $riak->store(
-# 'foo', 'bar3', $value, undef, undef,
-# sub {
-# pass "store value ok";
-# $riak->fetch(
-# 'foo', 'bar3', undef,
-# sub {
-# my $body = shift;
-# is_deeply (JSON::decode_json($body), $value, 'value is ok in cb');
-# }
-# );
-# }
-# );
-
-# ok my $final_res = $store_w_cb->recv;
-# $final_res->recv; # FIXME all cb should be called at this point
-
-# ok $res = $riak->store($value)->recv, '... set a new key';
-# my $second_value = {
-# bucket => 'foo',
-# key => 'baz',
-# object => { foo => "bar", baz => 2 },
-# links => [ [ 'foo', 'bar', 'tagged' ] ],
-# };
-# ok $res = $riak->store($second_value)->recv, '... set another new key';
-
-# ok $res = $riak->walk( 'foo', 'baz', [ { bucket => 'foo', } ] )->recv,
-# '... walk';
-# is $res->{results}->[0]->[0]->{key}, "bar", "... walked to bar";
-
-done_testing();
diff --git a/xt/00_sync.t b/xt/00_sync.t
new file mode 100644
index 0000000..a8cf910
--- /dev/null
+++ b/xt/00_sync.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+use JSON;
+use Test::More;
+use AnyEvent::Riak;
+
+#plan tests => 4;
+
+my $host = 'http://10.0.0.42:8098';
+my $path = 'riak';
+
+ok my $riak = AnyEvent::Riak->new(
+ host => $host,
+ path => $path,
+ w => 1,
+ dw => 1
+ ),
+ 'create riak object';
+
+ok my $ping = $riak->is_alive()->recv, 'ping: host is alive';
+ok my $buckets =
+ $riak->list_bucket('blog_content_temp', {keys => 'false'})->recv,
+ "fetch bucket list";
+
+my $value = {foo => 1};
+
+ok my ($res, $headers) = $riak->store('foo', $value)->recv,
+ 'set a new key';
+($res, $headers) = $riak->store('foo', $value, {key => 'foo_test'})->recv;
+ok $res, 'stored key foo_test';
+
+ok $res = $riak->fetch('foo', 'foo_test')->recv, 'fetch our new key';
+
+is_deeply $value, $res, 'got same data';
+
+ok $res = $riak->delete( 'foo', 'foo_test' )->recv, 'delete our key';
+
+done_testing;
diff --git a/xt/01_async.t b/xt/01_async.t
new file mode 100644
index 0000000..a42f751
--- /dev/null
+++ b/xt/01_async.t
@@ -0,0 +1,150 @@
+use strict;
+use warnings;
+
+use Test::More;
+use JSON::XS;
+use Test::Exception;
+use AnyEvent::Riak;
+use YAML::Syck;
+
+#plan tests => 6;
+
+my $host = 'http://10.0.0.42:8098';
+my $path = 'riak';
+
+ok my $riak = AnyEvent::Riak->new(
+ host => $host,
+ path => $path,
+ w => 1,
+ dw => 1
+ ),
+ 'create riak object';
+
+my $cv = AnyEvent->condvar;
+
+$riak->is_alive(
+ callback => sub {
+ my $res = shift;
+ ok $res, "is alive in cb";
+ }
+);
+
+$riak->list_bucket(
+ 'blog_content_temp',
+ {keys => 'false'},
+ sub {
+ my $res = shift;
+ ok $res, "got result list_bucket";
+ }
+);
+
+$riak->set_bucket(
+ 'blog_content_temp',
+ {n_val => 5},
+ sub {
+ my $res = shift;
+ ok $res, "got result in set_bucket"
+ }
+);
+
+$riak->fetch(
+ 'blog_content_temp',
+ '012853de99ce67c2f0f09c0c2ea28cbe5de8f653137d273803f85a398d1de840',
+ sub {
+ my $res = shift;
+ ok $res, "got result in fetch"
+ }
+);
+
+$riak->store(
+ 'blog_content_temp',
+ {foo => 1},
+ sub {
+ my $res = shift;
+ ok $res, "got result in store"
+ }
+);
+
+$cv->recv;
+
+# my ( $host, $path );
+
+# BEGIN {
+# my $riak_test = $ENV{RIAK_TEST_SERVER};
+# ($host, $path) = split ";", $riak_test if $riak_test;
+# plan skip_all => 'set $ENV{RIAK_TEST_SERVER} if you want to run the tests'
+# unless ($host && $path);
+# }
+
+# my $bucket = 'test';
+
+# ok my $riak = AnyEvent::Riak->new(
+# host => $host,
+# path => $path,
+# w => 1,
+# dw => 1
+# ),
+# 'create riak object';
+
+# {
+ # my $cv = AnyEvent->condvar;
+ # $cv->begin(sub { $cv->send });
+ # $cv->begin;
+ # # ping
+
+
+# }
+
+# # {
+# # my $cv = AnyEvent->condvar;
+# # $cv->begin(sub { $cv->send });
+# # $cv->begin;
+# # # list bucket
+# # $riak->list_bucket(
+# # $bucket,
+# # parameters => {props => 'true', keys => 'true'},
+# # callback => sub {
+# # my $res = shift;
+# # ok $res->{props}, 'got props';
+# # $cv->end;
+# # }
+# # );
+# # $cv->end;
+# # $cv->recv;
+# # }
+
+# # {
+# # my $key = 'bar';
+# # my $value = {foo => 'bar',};
+# # my $cv = AnyEvent->condvar;
+# # $cv->begin(sub { $cv->send });
+# # $cv->begin;
+
+# # # store object
+# # $riak->store(
+# # $bucket, $key, $value,
+# # callback => sub {
+# # pass "store value ok";
+# # $riak->fetch(
+# # $bucket, $key,
+# # callback => sub {
+# # my $body = shift;
+# # is_deeply($body, $value, 'value is ok in cb');
+# # $riak->delete(
+# # $bucket, $key,
+# # callback => sub {
+# # my $res = shift;
+# # is $res, 1, 'key deleted';
+# # $cv->end;
+# # }
+# # );
+
+# # }
+# # );
+# # }
+# # );
+# # $cv->end;
+# # $cv->recv;
+# # }
+
+done_testing();
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-06 03:36:37 +0000