File Coverage

blib/lib/MogileFS/Test.pm
Criterion Covered Total %
statement 68 158 43.0
branch 10 58 17.2
condition 7 19 36.8
subroutine 17 31 54.8
pod 0 6 0.0
total 102 272 37.5


line stmt bran cond sub pod time code
1             package MogileFS::Test;
2              
3 20     20   56352 use strict;
  20         31  
  20         723  
4 20     20   314 use warnings;
  20         27  
  20         417  
5 20     20   1568 use DBI;
  20         16724  
  20         788  
6              
7 20     20   918 use FindBin qw($Bin);
  20         1495  
  20         1834  
8 20     20   105 use IO::Socket::INET;
  20         27  
  20         214  
9 20     20   10923 use MogileFS::Server;
  20         28  
  20         348  
10 20     20   13680 use LWP::UserAgent;
  20         265579  
  20         710  
11 20     20   182 use base 'Exporter';
  20         32  
  20         24312  
12              
13             our @EXPORT = qw(&find_mogclient_or_skip &temp_store &create_mogstored &create_temp_tracker &try_for &want);
14              
15             sub find_mogclient_or_skip {
16              
17             # needed for running "make test" from project root directory, with
18             # full svn 'mogilefs' repo checked out, without installing
19             # MogileFS::Client to normal system locations...
20             #
21             # then, second path is when running "make disttest", which is another
22             # directory below.
23 9     9 0 163 foreach my $dir ("$Bin/../../api/perl/MogileFS-Client/lib",
24             "$Bin/../../../api/perl/MogileFS-Client/lib",
25             ) {
26 18 50       438 next unless -d $dir;
27 0         0 unshift @INC, $dir;
28 0 0       0 $ENV{PERL5LIB} = $dir . ($ENV{PERL5LIB} ? ":$ENV{PERL5LIB}" : "");
29             }
30              
31 9 50   9   3903 unless (eval "use MogileFS::Client; 1") {
  9         66268  
  9         181  
  9         1004  
32 0         0 warn "Can't find MogileFS::Client: $@\n";
33 0         0 Test::More::plan('skip_all' => "Can't find MogileFS::Client library, necessary for testing.");
34             }
35              
36 9 50       22 unless (eval { TrackerHandle::_mogadm_exe() }) {
  9         43  
37 9         1120 warn "Can't find mogadm utility $@\n";
38 9         83 Test::More::plan('skip_all' => "Can't find mogadm executable, necessary for testing.");
39             }
40              
41 0         0 return 1;
42             }
43              
44             sub temp_store {
45 5     5 0 58 my $type = $ENV{MOGTEST_DBTYPE};
46 5   50     44 my $host = $ENV{MOGTEST_DBHOST} || '';
47 5   50     40 my $port = $ENV{MOGTEST_DBPORT} || '';
48 5   50     33 my $user = $ENV{MOGTEST_DBUSER} || '';
49 5   50     34 my $pass = $ENV{MOGTEST_DBPASS} || '';
50 5   50     51 my $name = $ENV{MOGTEST_DBNAME} || '';
51 5   50     37 my $rootuser = $ENV{MOGTEST_DBROOTUSER} || '';
52 5   50     30 my $rootpass = $ENV{MOGTEST_DBROOTPASS} || '';
53              
54             # default to mysql, but make sure DBD::MySQL is installed
55 5 50       20 unless ($type) {
56 5         12 $type = "MySQL";
57 5 50   5   499 eval "use DBD::mysql; 1" or
  5         1225  
  0            
  0            
58             die "DBD::mysql isn't installed. Please install it or define MOGTEST_DBTYPE env. variable";
59             }
60              
61 0 0       0 die "Bogus type" unless $type =~ /^\w+$/;
62 0         0 my $store = "MogileFS::Store::$type";
63 0         0 eval "use $store; 1;";
64 0 0       0 if ($@) {
65 0         0 die "Failed to load $store: $@\n";
66             }
67 0         0 my %opts = ( dbhost => $host, dbport => $port,
68             dbuser => $user, dbpass => $pass,
69             dbname => $name);
70 0 0       0 $opts{dbrootuser} = $rootuser unless $rootuser eq '';
71 0 0       0 $opts{dbrootpass} = $rootpass unless $rootpass eq '';
72 0         0 my $sto = $store->new_temp(%opts);
73 0         0 Mgd::set_store($sto);
74 0         0 return $sto;
75             }
76              
77              
78             sub create_temp_tracker {
79 0     0 0 0 my $sto = shift;
80 0   0     0 my $opts = shift || [];
81              
82 0         0 my $pid = fork();
83 0         0 my $whoami = `whoami`;
84 0         0 chomp $whoami;
85              
86             my $connect = sub {
87 0     0   0 return IO::Socket::INET->new(PeerAddr => "127.0.0.1:7001",
88             Timeout => 2);
89 0         0 };
90              
91 0         0 my $conn = $connect->();
92 0 0       0 die "Failed: tracker already running on port 7001?\n" if $conn;
93              
94 0 0       0 unless ($pid) {
95 0 0       0 exec("$Bin/../mogilefsd",
96             ($whoami eq "root" ? "--user=root" : ()),
97             "--skipconfig",
98             "--workers=2",
99             "--dsn=" . $sto->dsn,
100             "--dbuser=" . $sto->user,
101             "--dbpass=" . $sto->pass,
102             @$opts,
103             );
104             }
105              
106 0         0 for (1..3) {
107 0 0       0 if ($connect->()) {
108 0         0 return TrackerHandle->new(pid => $pid);
109             }
110 0         0 sleep 1;
111             }
112 0         0 return undef;
113             }
114              
115             sub create_mogstored {
116 1     1 0 5492 my ($ip, $root, $daemonize) = @_;
117              
118             my $connect = sub {
119 1     1   27 return IO::Socket::INET->new(PeerAddr => "$ip:7500",
120             Timeout => 2);
121 1         14 };
122              
123 1         9 my $conn = $connect->();
124 1 50       3070 die "Failed: tracker already running on port 7500?\n" if $conn;
125 1         18 $ENV{PERL5LIB} .= ":$Bin/../lib";
126 1         17 my @args = ("$Bin/../mogstored",
127             "--skipconfig",
128             "--httplisten=$ip:7500",
129             "--mgmtlisten=$ip:7501",
130             "--maxconns=1000", # because we're not root, put it below 1024
131             "--docroot=$root");
132              
133 1         4 my $pid;
134 1 50       9 if ($daemonize) {
135             # don't set pid. since our fork fid would just
136             # go away, once perlbal daemonized itself.
137 1         4 push @args, "--daemonize";
138 1 50       42794 system(@args) and die "Failed to start daemonized mogstored.";
139             } else {
140 0         0 $pid = fork();
141 0 0       0 die "failed to fork: $!" unless defined $pid;
142 0 0       0 unless ($pid) {
143 0         0 exec(@args);
144             }
145             }
146              
147 0         0 for (1..12) {
148 0 0       0 if ($connect->()) {
149 0         0 return MogstoredHandle->new(pid => $pid, ip => $ip, root => $root);
150             }
151 0         0 select undef, undef, undef, 0.25;
152             }
153 0         0 return undef;
154             }
155              
156             sub try_for {
157 0     0 0 0 my ($tries, $code) = @_;
158 0         0 for (1..$tries) {
159 0 0       0 return 1 if $code->();
160 0         0 sleep 1;
161             }
162 0         0 return 0;
163             }
164              
165             sub want {
166 0     0 0 0 my ($admin, $count, $jobclass) = @_;
167 0         0 my $req = "!want $count $jobclass\r\n";
168              
169 0 0       0 syswrite($admin, $req) or die "syswrite: $!\n";
170              
171 0         0 my $r = <$admin>;
172 0 0 0     0 if ($r =~ /Now desiring $count children doing '$jobclass'/ && <$admin> eq ".\r\n") {
173 0         0 my $rcount;
174             try_for(30, sub {
175 0     0   0 $rcount = -1;
176 0         0 syswrite($admin, "!jobs\r\n");
177 0         0 MogileFS::Util::wait_for_readability(fileno($admin), 10);
178 0         0 while (1) {
179 0         0 my $line = <$admin>;
180 0 0       0 if ($line =~ /\A$jobclass count (\d+)/) {
181 0         0 $rcount = $1;
182             }
183 0 0       0 last if $line eq ".\r\n";
184             }
185 0         0 $rcount == $count;
186 0         0 });
187 0 0       0 return 1 if $rcount == $count;
188 0         0 die "got $jobclass count $rcount (expected=$count)\n";
189             }
190 0         0 die "got bad response for $req: $r\n";
191             }
192              
193             ############################################################################
194             package ProcessHandle;
195             sub new {
196 0     0   0 my ($class, %args) = @_;
197 0         0 bless \%args, $class;
198             }
199              
200 0     0   0 sub pid { return $_[0]{pid} }
201              
202             sub DESTROY {
203 0     0   0 my $self = shift;
204 0 0       0 return unless $self->{pid};
205 0         0 kill 15, $self->{pid};
206             }
207              
208              
209             ############################################################################
210              
211             package TrackerHandle;
212 20     20   116 use base 'ProcessHandle';
  20         33  
  20         9916  
213              
214             sub ipport {
215 0     0   0 my $self = shift;
216 0         0 return "127.0.0.1:7001";
217             }
218              
219             my $_mogadm_exe_cache;
220             sub _mogadm_exe {
221 9 50   9   41 return $_mogadm_exe_cache if $_mogadm_exe_cache;
222 9         111 for my $dir ("$FindBin::Bin/../../utils",
223             "$FindBin::Bin/../../../utils",
224             split(/:/, $ENV{PATH}),
225             "/usr/bin",
226             "/usr/sbin",
227             "/usr/local/bin",
228             "/usr/local/sbin",
229             ) {
230 117         140 my $exe = $dir . '/mogadm';
231 117 50       1406 return $_mogadm_exe_cache = $exe if -x $exe;
232             }
233 9         136 die "mogadm executable not found.\n";
234             }
235              
236             sub mogadm {
237 0     0   0 my $self = shift;
238 0         0 my $rv = system(_mogadm_exe(), "--trackers=" . $self->ipport, @_);
239 0         0 return !$rv;
240             }
241              
242             ############################################################################
243             package MogstoredHandle;
244 20     20   119 use base 'ProcessHandle';
  20         39  
  20         8106  
245              
246             # this space intentionally left blank. all in super class for now.
247              
248             ############################################################################
249             package MogPath;
250             sub new {
251 0     0   0 my ($class, $url) = @_;
252 0         0 return bless {
253             url => $url,
254             }, $class;
255             }
256              
257             sub host {
258 0     0   0 my $self = shift;
259 0         0 my ($host1) = $self->{url} =~ m!^http://(.+:\d+)!;
260 0         0 return $host1
261             }
262              
263             sub device {
264 0     0   0 my $self = shift;
265 0         0 my ($dev) = $self->{url} =~ m!dev(\d+)!;
266 0         0 return $dev
267             }
268              
269             sub path {
270 0     0   0 my $self = shift;
271 0         0 my $path = $self->{url};
272 0         0 $path =~ s!^http://(.+:\d+)!!;
273 0         0 return $path;
274             }
275              
276             1;