File Coverage

blib/lib/Couchbase/Test/Settings.pm
Criterion Covered Total %
statement 45 181 24.8
branch 0 2 0.0
condition n/a
subroutine 15 26 57.6
pod 0 8 0.0
total 60 217 27.6


line stmt bran cond sub pod time code
1             package Couchbase::Test::Settings;
2 2     2   982 use strict;
  2         4  
  2         64  
3 2     2   8 use warnings;
  2         2  
  2         48  
4 2     2   6 use base qw(Couchbase::Test::Common);
  2         2  
  2         138  
5 2     2   8 use Test::More;
  2         4  
  2         14  
6 2     2   506 use Couchbase::Client::Errors;
  2         2  
  2         338  
7 2     2   8 use Data::Dumper;
  2         2  
  2         94  
8              
9             use Class::XSAccessor {
10 2         10 accessors => [qw(cbo)]
11 2     2   8 };
  2         4  
12              
13             my $have_zlib = eval {
14             require Compress::Zlib;
15             };
16              
17             my $SERIALIZATION_CALLED = 0;
18             my $DESERIALIZATION_CALLED = 0;
19             my $COMPRESSION_CALLED = 0;
20             my $DECOMPRESSION_CALLED = 0;
21              
22             my $COMPRESS_METHOD;
23             my $DECOMPRESS_METHOD;
24             if($have_zlib) {
25             $COMPRESS_METHOD = sub {
26             $COMPRESSION_CALLED = 1;
27             ${$_[1]} = Compress::Zlib::memGzip(${$_[0]});
28             };
29             $DECOMPRESS_METHOD = sub {
30             $DECOMPRESSION_CALLED = 1;
31             ${$_[1]} = Compress::Zlib::memGunzip(${$_[0]});
32             };
33             } else {
34             $COMPRESS_METHOD = sub {
35             $COMPRESSION_CALLED = 1;
36             ${$_[1]} = scalar reverse ${$_[0]};
37             };
38             $DECOMPRESS_METHOD = sub {
39             $DECOMPRESSION_CALLED = 1;
40             ${$_[1]} = scalar reverse ${$_[0]};
41             };
42             }
43              
44             sub setup_client :Test(startup)
45             {
46 0     0 0 0 my $self = shift;
47 0         0 $self->mock_init();
48 2     2   600 }
  2         4  
  2         10  
49              
50             sub reset_vars {
51 0     0 0   $COMPRESSION_CALLED = 0;
52 0           $DECOMPRESSION_CALLED = 0;
53 0           $SERIALIZATION_CALLED = 0;
54 0           $DESERIALIZATION_CALLED = 0;
55             }
56             #We make a new client for each test
57             sub _pretest :Test(setup) {
58 0     0   0 my $self = shift;
59 0         0 reset_vars();
60 0         0 my %options = (
61 0         0 %{$self->common_options},
62             compress_threshold => 100,
63             compress_methods => [$COMPRESS_METHOD, $DECOMPRESS_METHOD]
64             );
65              
66 0         0 my $o = Couchbase::Client->new(\%options);
67              
68 0         0 $self->cbo( $o );
69              
70 2     2   510 }
  2         10  
  2         4  
71              
72             sub T20_settings_connect :Test(no_plan)
73             {
74 0     0 0 0 my $self = shift;
75              
76 0         0 my $client = Couchbase::Client->new({
77             username => "bad",
78             password => "12345",
79             bucket => "nonexistent",
80             no_init_connect => 1,
81             server => '127.0.0.1:0'
82             });
83 0         0 is(scalar @{$client->get_errors()}, 0,
  0         0  
84             "No error on initial connect with no_init_connect => 1");
85              
86 0         0 my $ret = $client->set("Foo", "Bar");
87 0         0 is($ret->errnum, COUCHBASE_CLIENT_ETMPFAIL, "Got ETMPFAIL on non-connected server");
88              
89 0         0 ok(!$client->connect, "Failure to connect to nonexistent host");
90 0         0 my $errors = $client->get_errors;
91 0         0 ok(scalar @$errors, "Have error");
92 0         0 is($errors->[0]->[0], COUCHBASE_CONNECT_ERROR, "Got CONNECT_ERROR");
93              
94 0         0 $client = Couchbase::Client->new({
95 0         0 %{$self->common_options},
96             bucket => 'nonexist',
97             });
98 0         0 $errors = $client->get_errors();
99 0         0 ok(scalar @$errors, "Have error for nonexistent bucket");
100 0         0 is($errors->[0]->[0], COUCHBASE_BUCKET_ENOENT,
101             "Got BUCKET_ENOENT for nonexistent bucket");
102              
103 0         0 my $warnmsg;
104             {
105 0     0   0 local $SIG{__WARN__} = sub { $warnmsg = shift };
  0         0  
  0         0  
106 0         0 ok($self->cbo->connect, "connect on connected instance returns OK");
107 0         0 like($warnmsg, qr/already connected/i,
108             "warning on already connected instance");
109             }
110 2     2   764 }
  2         4  
  2         8  
111              
112             sub T21_default_settings :Test(no_plan)
113             {
114 0     0 0 0 my $self = shift;
115 0         0 my $cbo = Couchbase::Client->new({
116             no_init_connect => 1,
117             server => "localhost:0",
118             });
119              
120 0         0 ok(!$cbo->dereference_scalar_ref_settings,
121             "SCALAR ref deref disabled by default");
122 0         0 ok($cbo->deconversion_settings, "deconversion enabled by default");
123 0         0 ok(!$cbo->enable_compress, "compression disabled by default");
124 0         0 ok($cbo->serialization_settings, "Serialization enabled by default");
125 2     2   454 }
  2         4  
  2         6  
126              
127             sub T22_compress_settings :Test(no_plan)
128             {
129 0     0 0 0 my $self = shift;
130 0         0 my $v;
131              
132 0         0 my $key = "compressed";
133 0         0 my $value = "foo" x 100;
134              
135 0         0 my $cbo = $self->cbo;
136              
137 0         0 my $ret = $cbo->set($key, $value);
138 0         0 ok($ret->is_ok, "No problem setting key: " . $ret->errstr . " " . $ret->errnum);
139 0         0 is($COMPRESSION_CALLED, 1, "compression method called");
140              
141 0         0 $ret = $cbo->get($key);
142 0         0 ok($ret->is_ok, "Got back our data");
143 0         0 is($ret->value, $value, "same value");
144 0         0 ok($DECOMPRESSION_CALLED, "Decompression method called");
145              
146 0         0 $v = $cbo->enable_compress(0);
147 0         0 is($cbo->enable_compress, 0, "Compression disabled via setter");
148 0         0 reset_vars();
149              
150 0         0 $ret = $cbo->get($key);
151 0         0 ok($ret->is_ok, "status OK");
152 0         0 ok($DECOMPRESSION_CALLED,
153             "decompression still called with compressiond disabled");
154 0         0 is($ret->value, $value, "Got same value");
155              
156 0         0 reset_vars();
157 0         0 $ret = $cbo->set($key, $value);
158 0         0 ok($ret->is_ok, "storage operation ok");
159 0         0 is($COMPRESSION_CALLED, 0, "compression not called");
160              
161 0         0 $ret = $cbo->get($key);
162 0         0 ok($ret->is_ok, "uncompressed retrieval ok");
163 0         0 is($DECOMPRESSION_CALLED, 0,
164             "decompression not called for non-compressed value");
165 0         0 is($ret->value, $value, "got same value");
166              
167 0         0 reset_vars();
168 0         0 $cbo->enable_compress(1);
169 0         0 ok($cbo->enable_compress, "compression re-enabled");
170              
171              
172              
173 0         0 $cbo->set($key, $value);
174 0         0 ok($COMPRESSION_CALLED,
175             "compression method called when compression re-enabled");
176              
177 0         0 $cbo->enable_compress(0);
178 0         0 is($cbo->enable_compress, 0, "compression disabled");
179              
180 0         0 ok($cbo->deconversion_settings, "deconversion still enabled");
181 0         0 $cbo->deconversion_settings(0);
182 0         0 is($cbo->deconversion_settings, 0, "deconversion now disabled");
183              
184 0         0 reset_vars();
185 0         0 $ret = $cbo->get($key);
186 0         0 ok($ret->is_ok, "got compressed value ok");
187 0         0 is($DECOMPRESSION_CALLED, 0, "decompression not called");
188 0         0 ok($ret->value ne $value, "compressed data does not match original");
189              
190 0         0 reset_vars();
191 0         0 $cbo->deconversion_settings(1);
192 0         0 $ret = $cbo->get($key);
193 0         0 is($ret->value, $value, "deconversion enabled, deompression enabled");
194 2     2   906 }
  2         2  
  2         8  
195              
196             sub T23_serialize_settings :Test(no_plan)
197             {
198 0     0 0 0 my $self = shift;
199 0         0 my $cbo = $self->cbo;
200              
201 0         0 $cbo->serialization_settings(0);
202 0         0 $cbo->dereference_scalar_ref_settings(1);
203              
204             #try to store a reference:
205              
206 0         0 eval {
207 0         0 $cbo->set("serialized", [qw(foo bar baz)]);
208             };
209 0         0 ok($@, "got error for serializing data - ($@)");
210 0         0 is($SERIALIZATION_CALLED, 0, "serialization method not called on pre-check");
211              
212 0         0 my $key = "compressed_key";
213 0         0 my $value = \"Hello world";
214              
215 0         0 my $ret = $cbo->set($key, $value);
216 0         0 ok($ret->is_ok, "set value ok");
217 0         0 is($SERIALIZATION_CALLED, 0, "serialization not performed");
218              
219 0         0 $ret = $cbo->get($key);
220 0         0 ok($ret->is_ok, "Got value ok");
221 0         0 is($ret->value, $$value, "dereference scalar ref");
222 2     2   530 }
  2         4  
  2         6  
223              
224             sub T24_timeout_settings :Test(no_plan)
225             {
226 0     0 0 0 my $self = shift;
227             #here we can just get/set the timeout value, the real timeout tests happen
228             #in a different test module:
229 0         0 my $cbo = $self->cbo();
230 0         0 my $orig_timeo = $cbo->timeout;
231 0         0 is($orig_timeo, 2.5);
232              
233              
234 0         0 my $warnmsg;
235             {
236 0     0   0 local $SIG{__WARN__} = sub { $warnmsg = shift };
  0         0  
  0         0  
237 0         0 ok(!$cbo->timeout(-1), "Return nothing on bad argument");
238             };
239 0         0 like($warnmsg, qr/cannot disable timeouts/i, "cannot disable timeouts");
240 0         0 is($cbo->timeout, $orig_timeo, "still have the same timeout");
241              
242 0         0 ok($cbo->timeout(0.1), "set timeout to value under 1");
243 2     2   548 }
  2         2  
  2         8  
244              
245             sub T25_multi_server_list :Test(no_plan)
246             {
247 0     0 0   my $self = shift;
248             # We can't use null for a port here because it might fail on GAI for
249             # SOCK_STREAM
250              
251 0           my $server_list = ['localhost:1'];
252 0           my %options = %{$self->common_options};
  0            
253 0           my $bucket = $options{bucket};
254 0           my ($username,$password) = @options{qw(username password)};
255 0           push @$server_list, delete $options{server};
256 0           $options{servers} = $server_list;
257              
258 0           my $errors;
259             my $cbo;
260 0           my $ret;
261              
262 0           $cbo = Couchbase::Client->new({%options});
263 0           note "Connecting with bucket $bucket";
264 0           isa_ok($cbo, 'Couchbase::Client');
265              
266 0           if (0) {
267             ok(scalar @{$cbo->get_errors}, "have error(s)");
268             is($cbo->get_errors->[0]->[0], COUCHBASE_CONNECT_ERROR,
269             "Got network error for nonexistent host");
270              
271             # If we have more than a single error, print them out (via dumper);
272             if(@{$cbo->get_errors()} > 1) {
273             diag "We really expected a single error. Extra info:";
274             diag Dumper($cbo->get_errors());
275             }
276             } else {
277 0           $self->builder->skip("Can't get info on failed nodes");
278             }
279              
280 0           $ret = $cbo->set("foo", "fooval");
281 0           ok($ret->is_ok, "connected and can set value (retry ok)");
282 0 0         if(!$ret->is_ok){
283 0           print Dumper($ret);
284             }
285 0           $cbo = Couchbase::Client->new({
286             %options,
287             servers => [$self->common_options->{server}, 'localhost:0'],
288             bucket => 'nonexistent'
289             });
290 0           is(scalar @{$cbo->get_errors}, 1, "Got one non-retriable error");
  0            
291 0           is($cbo->get_errors->[0]->[0], COUCHBASE_BUCKET_ENOENT,
292             "BUCKET_ENOENT as expected");
293 2     2   834 }
  2         8  
  2         6  
294             1;