File Coverage

blib/lib/Couchbase/Test/Common.pm
Criterion Covered Total %
statement 24 96 25.0
branch 0 36 0.0
condition 0 16 0.0
subroutine 8 16 50.0
pod 1 8 12.5
total 33 172 19.1


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