1package Test::Riak; 2use strict; 3use warnings; 4use Test::More 'no_plan'; 5use_ok 'Net::Riak'; 6 7sub import { 8 no strict 'refs'; 9 *{caller()."::test_riak"} = \&{"Test::Riak::test_riak"}; 10 *{caller()."::test_riak_pbc"} = \&{"Test::Riak::test_riak_pbc"}; 11 *{caller()."::test_riak_rest"} = \&{"Test::Riak::test_riak_rest"}; 12 *{caller()."::new_riak_client"} = \&{"Test::Riak::new_riak_client"}; 13 strict->import; 14 warnings->import; 15} 16 17sub test_riak (&) { 18 my ($test_case) = @_; 19 test_riak_rest($test_case); 20 test_riak_pbc($test_case); 21} 22 23sub test_riak_rest (&) { 24 my ($test_case) = @_; 25 26 if ($ENV{RIAK_REST_HOST}) { 27 diag "Running for REST"; 28 my $client = Net::Riak->new(host => $ENV{RIAK_REST_HOST}, r => 1, w => 1, dw => 1); 29 isa_ok $client, 'Net::Riak'; 30 is $client->is_alive, 1, 'connected'; 31 run_test_case($test_case, $client, 'REST'); 32 } 33 else { 34 diag "Skipping REST tests - RIAK_REST_HOST not set"; 35 } 36} 37 38sub test_riak_pbc (&) { 39 my ($test_case) = @_; 40 41 if ($ENV{RIAK_PBC_HOST}) { 42 43 diag "Running for PBC"; 44 my ($host, $port) = split ':', $ENV{RIAK_PBC_HOST}; 45 46 my $client = Net::Riak->new( 47 transport => 'PBC', 48 host => $host, 49 port => $port, 50 r => 1, 51 w => 1, 52 dw => 1, 53 ); 54 55 isa_ok $client, 'Net::Riak'; 56 is $client->is_alive, 1, 'connected'; 57 run_test_case($test_case, $client, 'PBC'); 58 } 59 else { 60 diag "Skipping PBC tests - RIAK_PBC_HOST not set"; 61 } 62} 63 64sub new_riak_client { 65 my $proto = shift; 66 67 if ($proto eq 'PBC') { 68 my ($host, $port) = split ':', $ENV{RIAK_PBC_HOST}; 69 70 return Net::Riak->new( 71 transport => 'PBC', 72 host => $host, 73 port => $port, 74 r => 1, 75 w => 1, 76 dw => 1, 77 ); 78 } 79 elsif ($proto eq 'REST') { 80 return Net::Riak->new(host => $ENV{RIAK_REST_HOST}); 81 } 82 83 die "Unknown protocol $proto"; 84} 85 86sub run_test_case { 87 my ($case, $client, $proto) = @_; 88 89 my $bucket = "TEST_RIAK_$$".sprintf("%d", rand()*1000); 90 91 local $@; 92 eval { $case->($client, $bucket, $proto) }; 93 94 if ($@) { 95 ok 0, "$@"; 96 } 97 98 #TODO add bucket cleanup 99} 100