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