File Coverage

blib/lib/Couchbase/Test/Common.pm
Criterion Covered Total %
statement 39 100 39.0
branch 4 36 11.1
condition 3 19 15.7
subroutine 10 17 58.8
pod 1 9 11.1
total 57 181 31.4


line stmt bran cond sub pod time code
1             package Couchbase::Test::Common;
2 2     2   4952 use strict;
  2         2  
  2         58  
3 2     2   8 use warnings;
  2         2  
  2         48  
4 2     2   6 use base qw(Test::Class);
  2         2  
  2         1192  
5 2     2   50094 use Test::More;
  2         9856  
  2         16  
6 2     2   1288 use Couchbase::MockServer;
  2         4  
  2         56  
7 2     2   8 use Data::Dumper;
  2         4  
  2         96  
8             use Class::XSAccessor {
9 2         8 accessors => [qw(mock res_buckets)]
10 2     2   8 };
  2         4  
11              
12             my $have_confua = eval {
13             require Couchbase::Config::UA; 1;
14             };
15              
16             our $Mock;
17             our $RealServer = $ENV{PLCB_TEST_REAL_SERVER};
18             our $MemdPort = $ENV{PLCB_TEST_MEMD_PORT};
19              
20             sub SKIP_CLASS {
21 4     4 1 24 my ($cls,$msg) = @_;
22 4 50       12 if(defined $msg) {
23 4 50       8 my $cstr = ref $cls ? ref $cls : $cls;
24 4         10 my $header = ("#" x 10) . " $cstr SKIP " . ("#" x 10);
25              
26 4         20 diag $header;
27 4         440 diag "";
28 4         426 diag $msg;
29 4         454 diag "";
30             }
31 4         470 goto &Test::Class::SKIP_CLASS;
32             }
33              
34             sub mock_init
35             {
36 0     0 0 0 my $self = shift;
37 0 0 0     0 if ( (!$Mock) && (!$RealServer) ) {
38 0         0 die("Mock object not found. Initialize mock object with Initialize()");
39             }
40 0         0 $self->{mock} = $Mock;
41             }
42              
43             sub fetch_config {
44 0     0 0 0 my $self = shift;
45 0 0       0 if(!$have_confua) {
46 0         0 return;
47             }
48 0         0 my $confua = Couchbase::Config::UA->new(
49             $self->common_options->{server},
50             username => $self->common_options->{username},
51             password => $self->common_options->{password}
52             );
53 0         0 my $defpool = $confua->list_pools();
54 0         0 $confua->pool_info($defpool);
55 0         0 my $buckets = $confua->list_buckets($defpool);
56 0         0 $self->res_buckets($buckets);
57             }
58              
59             use constant {
60 2         1418 BUCKET_MEMCACHED => 1,
61             BUCKET_COUCHBASE => 2,
62             BUCKET_DEFAULT => 3
63 2     2   762 };
  2         4  
64              
65             sub common_options {
66 0     0 0 0 my ($self,$bucket_type) = @_;
67              
68 0 0       0 if($RealServer) {
69 0         0 return { %$RealServer };
70             }
71 0         0 my $mock = $self->mock;
72 0         0 my $opthash = {};
73              
74 0 0       0 if(!$bucket_type) {
    0          
    0          
75 0         0 $bucket_type = BUCKET_DEFAULT;
76             } elsif ($bucket_type =~ /mem/) {
77 0         0 $bucket_type = BUCKET_MEMCACHED;
78             } elsif ($bucket_type =~ /couch/) {
79 0         0 $bucket_type = BUCKET_COUCHBASE;
80             } else {
81 0         0 warn("No such bucket type $bucket_type");
82 0         0 $bucket_type = BUCKET_DEFAULT;
83             }
84              
85 0 0       0 my $bucket = $self->mock->buckets->[0] or die "No buckets!";
86 0 0       0 if($bucket_type == BUCKET_MEMCACHED) {
    0          
87 0         0 $bucket = (grep $_->{type} eq 'memcache',
88 0         0 @{$mock->buckets})[0];
89             } elsif ($bucket == BUCKET_COUCHBASE) {
90 0 0       0 $bucket = (grep { (!$_->{type}) || $_->{type} eq 'couchbase' }
  0         0  
91 0         0 @{$mock->buckets})[0];
92             }
93 0 0       0 if(!$bucket) {
94 0         0 die("Can't find common options for bucket (@_)");
95             }
96              
97 0 0       0 if($bucket->{password}) {
98 0         0 $opthash->{username} = "some_user";
99 0         0 $opthash->{password} = $bucket->{password};
100             }
101 0         0 $opthash->{server} = "127.0.0.1:" . $self->mock->port;
102 0         0 $opthash->{bucket} = $bucket->{name};
103 0         0 return $opthash;
104             }
105              
106             sub memd_options {
107 0 0   0 0 0 if(!$MemdPort) {
108 0         0 die("Cannot find Memcached port");
109             }
110 0         0 my ($hostname) = split(/:/, $RealServer->{server});
111 0         0 $hostname .= ":$MemdPort";
112             return {
113 0         0 servers => [ $hostname ]
114             };
115             }
116              
117             sub make_cbo {
118 0     0 0 0 my $self = shift;
119 0         0 my %options = %{ $self->common_options };
  0         0  
120 0         0 $options{compress_threshold} = 100;
121 0         0 return Couchbase::Client->new(\%options);
122             }
123              
124             sub k2v {
125 0     0 0 0 my ($self,$k) = @_;
126 0         0 reverse($k);
127             }
128              
129             sub v2k {
130 0     0 0 0 my ($self,$v) = @_;
131 0         0 reverse($v);
132             }
133              
134             my $init_pid = $$;
135             sub Initialize {
136 2     2 0 142 my ($cls,%opts) = @_;
137 2 50 33     14 if($RealServer && (!ref $RealServer) ) {
138 0         0 my @kvpairs = split(/,/, $RealServer);
139 0         0 $RealServer = {};
140 0         0 foreach my $pair (@kvpairs) {
141 0         0 my ($k,$v) = split(/=/, $pair);
142 0 0       0 $RealServer->{$k} = $v if $k =~
143             /server|bucket|username|password|memd_port/;
144             }
145 0   0     0 $RealServer->{server} ||= "localhost:8091";
146 0   0     0 $RealServer->{bucket} ||= "default";
147 0   0     0 $MemdPort ||= delete $RealServer->{memd_port};
148             } else {
149 2         2 eval {
150 2         32 $Mock = Couchbase::MockServer->new(%opts);
151 1 50 33     118 }; if( ($@ || (!$Mock)) && $$ == $init_pid) {
      33        
152 1         30 $cls->SKIP_ALL("Cannot run tests without mock server ($@)");
153             }
154 0           return $Mock;
155             }
156             }
157             1;