File Coverage

blib/lib/Test/Clustericious/Cluster.pm
Criterion Covered Total %
statement 356 382 93.1
branch 94 128 73.4
condition 43 73 58.9
subroutine 47 48 97.9
pod 16 16 100.0
total 556 647 85.9


line stmt bran cond sub pod time code
1             package Test::Clustericious::Cluster;
2              
3 48     48   2409252 use strict;
  47         144  
  47         1167  
4 38     38   251 use warnings;
  38         146  
  38         1268  
5 35     35   929 use 5.010001;
  35         155  
6 35     35   25504 use if !$INC{'File/HomeDir/Test.pm'}, 'File::HomeDir::Test';
  35         1753  
  35         228  
7 35     35   827575 use Test2::API qw( context );
  35         832568  
  35         2965  
8 35     35   18400 use File::HomeDir;
  35         114407  
  35         2191  
9 35     35   17628 use Mojo::URL;
  35         3429563  
  35         355  
10 35     35   17792 use Mojo::Loader;
  35         499273  
  35         1909  
11 35     35   19692 use Mojo::UserAgent;
  35         6314341  
  35         437  
12 35     35   2064 use Carp qw( croak carp );
  35         102  
  35         2240  
13 35     35   245 use File::Basename ();
  35         88  
  35         498  
14 35     35   196 use File::Path ();
  35         86  
  35         600  
15 35     35   22961 use Test::Mojo;
  35         944030  
  35         477  
16              
17             # ABSTRACT: Test an imaginary beowulf cluster of Clustericious services
18             our $VERSION = '0.36_01'; # TRIAL VERSION
19             $VERSION = eval $VERSION;
20              
21              
22 35     35   20386 BEGIN { $ENV{MOJO_LOG_LEVEL} = 'fatal' }
23              
24              
25             sub new
26             {
27 28     28 1 53779 my $class = shift;
28            
29 28         88 my $args;
30 28 50 33     529 if(ref($_[0]) && eval { $_[0]->isa('Test::Mojo') })
  0         0  
31             {
32             # undocumented and deprecated
33             # you can pass in just an instance of Test::Mojo
34 0         0 carp "passing a Test::Mojo object into Test::Clustericious::Cluster->new deprecated";
35 0         0 $args = { t => $_[0] };
36             }
37             else
38             {
39 28 50       159 $args = ref $_[0] ? { %{ $_[0] } } : {@_};
  0         0  
40             }
41              
42 28 50       185 my $sep = $^O eq 'MSWin32' ? ';' : ':';
43 28         509 my $lite_path = [ split $sep, $ENV{PATH} ];
44              
45 28   100     297 $args->{lite_path} //= [];
46 28 50       142 unshift @$lite_path, ref($args->{lite_path}) ? @{ $args->{lite_path} } : ($args->{lite_path});
  28         99  
47            
48             bless {
49             t => $args->{t},
50 28         410 urls => [],
51             apps => [],
52             stopped => [],
53             index => -1,
54             url => '',
55             servers => [],
56             app_servers => [],
57             auth_url => '',
58             #extra_ua => [$t->ua],
59             lite_path => $lite_path,
60             }, $class;
61             }
62              
63              
64             sub t {
65 76     76 1 2310 my($self) = @_;
66 76   66     516 $self->{t} //= do {
67 24         269 my $t = $self->{t} = Test::Mojo->new;
68 24         534 $self->_update_default_server;
69 24         373 $t;
70             };
71             }
72              
73             sub _update_default_server
74             {
75 45     45   142 my($self) = @_;
76             $self->t->ua->server->app($self->apps->[-1])
77 45 100 66     294 if $self->{t} && @{ $self->apps } && !$self->{stopped}->[-1];
  45   66     174  
78             }
79              
80             sub _extra_ua {
81 54     54   156 my($self) = @_;
82 54   100     407 $self->{extra_ua} //= [ $self->t->ua ];
83             }
84              
85              
86 29     29 1 30846 sub urls { shift->{urls} }
87              
88              
89 179     179 1 3815 sub apps { shift->{apps} }
90              
91              
92 4     4 1 2847 sub index { shift->{index} }
93              
94              
95 49     49 1 12656 sub url { shift->{url} }
96              
97              
98 3     3 1 148 sub auth_url { shift->{auth_url} }
99              
100              
101             BEGIN {
102             # TODO
103             # so we muck with this @INC in two places. Here we do it so
104             # that you can use_ok files in your .t file. Later we do
105             # extract files in create_cluster_ok and add ~/lib to the @INC
106             # path so that we can load as regular files. This is more
107             # reliable for anything that expects a real live file, and we'd
108             # like to do that for use_ok as well in the future.
109              
110             unshift @INC, sub {
111 3437         12840130 my($self, $file) = @_;
112              
113 3437         18626 my $data = Mojo::Loader::data_section('main', "lib/$file");
114 3437 100       1808213 return unless defined $data;
115            
116             # This will make the file really there.
117             # Some stuff depends on that
118 2         26 __PACKAGE__->extract_data_section("lib/$file", 'main');
119              
120 2     5   76 open my $fh, '<', \$data;
  5         96  
  5         72  
  5         53  
121            
122             # fake out %INC because Mojo::Home freeks the heck
123             # out when it sees a CODEREF on some platforms
124             # in %INC
125 2         628 my $home = File::HomeDir->my_home;
126 2 50       62 mkdir "$home/lib" unless -d "$home/lib";
127 2         8 $INC{$file} = "$home/lib/$file";
128            
129 2         524 return $fh;
130 35     35   17456 };
131             };
132              
133             sub _add_app_to_ua
134             {
135 70     70   460 my($self, $ua, $url, $app, $index) = @_;
136             #use Carp qw( confess );
137             #confess "usage: \$cluster->_add_app_to_ua($ua, $url, $app)" unless $url;
138 70         372 my $server = Mojo::Server::Daemon->new(
139             ioloop => $ua->ioloop,
140             silent => 1,
141             );
142 70         3074 $server->app($app);
143 70         742 $server->listen(["$url"]);
144 70         17316 $server->start;
145 70 100       100523 if(defined $index)
146             {
147 64         148 push @{ $self->{app_servers}->[$index] }, $server;
  64         257  
148             }
149             else
150             {
151 6         10 push @{ $self->{servers} }, $server;
  6         22  
152             }
153 70         247 return;
154             }
155              
156             sub _add_app
157             {
158 40     40   184 my($self, $url, $app, $index) = @_;
159 40         105 $self->_add_app_to_ua($_, $url, $app, $index) for @{ $self->_extra_ua };
  40         168  
160 40         266 return;
161             }
162              
163             sub _add_ua
164             {
165 14     14   54 my($self) = @_;
166            
167 14         39 my $max = $#{ $self->{apps} };
  14         67  
168            
169 14         172 my $ua = Mojo::UserAgent->new;
170            
171             $self->_add_app_to_ua($ua, $self->{auth_url}, $self->{auth_url})
172 14 0 33     145 if $self->{auth_url} && $self->{auth_url};
173            
174 14         71 for(my $i=0; $i<=$max; $i++)
175             {
176 20 50       71 next unless defined $self->{apps}->[$i];
177 20         43 my $stopped = $self->{stopped}->[$i];
178 20 100       58 next if $stopped;
179 19         69 $self->_add_app_to_ua($ua, $self->{urls}->[$i], $self->{apps}->[$i], $i);
180             }
181 14         32 push @{ $self->_extra_ua }, $ua;
  14         60  
182 14         305 return $ua;
183             }
184              
185             sub _load_lite_app
186             {
187 3     3   10 my($app_path, $script) = @_;
188 3         12 local @ARGV = ( eval => 'app');
189 3         7 state $index = 0;
190 3         306 eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) . sprintf(q{
191             if(defined $script)
192             {
193             open my $fh, '>', $app_path;
194             print $fh $script;
195             close $fh;
196             }
197             package
198             Test::Clustericious::Cluster::LiteApp%s;
199             my $app = do $app_path;
200             if(!$app && (my $e = $@ || $!)) { die $e }
201             $app;
202             }, $index++);
203             }
204              
205             sub _generate_port
206             {
207 57     57   409 require IO::Socket::INET;
208 57         510 IO::Socket::INET->new(
209             Listen => 5,
210             LocalAddr => '127.0.0.1',
211             )->sockport;
212             }
213              
214             sub _create_config_helper
215             {
216 20     20   65 my($self) = @_;
217              
218 20     11   118 my $helper = sub { return $self };
  11         62  
219            
220 20         55 my $class;
221            
222 20 50       86 unless(defined $class)
223             {
224 20 50       1308 if(eval q{ require Clustericious::Config::Helpers; 1})
    0          
225             {
226 20         78 $class = 'Clustericious::Config::Helpers';
227 20         86 push @Clustericious::Config::Helpers::EXPORT, 'cluster';
228             }
229             elsif(eval q{ Clustericious::Config::Plugin; 1 })
230             {
231 0         0 $class = 'Clustericious::Config::Plugin';
232 0         0 push @Clustericious::Config::Plugin::EXPORT, 'cluster';
233             }
234             }
235            
236 20 50       181 return unless $class;
237            
238 20         57 do {
239             # there are a multitude of sins here aren't there?
240 35     35   412 no warnings 'redefine';
  35         101  
  35         1508  
241 35     35   215 no warnings 'once';
  35         100  
  35         1186  
242 35     35   381 no strict 'refs';
  35         174  
  35         69332  
243 20         51 *{join '::', $class, 'cluster'} = $helper;
  20         220  
244             };
245             }
246              
247             sub create_cluster_ok
248             {
249 20     20 1 156 my $self = shift;
250              
251 20         112 $self->_create_config_helper;
252 20         150 my $ctx = context();
253            
254 20         2857 my $total = scalar @_;
255             my @urls = map {
256 20         373 my $url = Mojo::URL->new("http://127.0.0.1");
  54         400  
257 54         19673 $url->port(_generate_port);
258 54         17549 $url } (0..$total);
259              
260 20         80 push @{ $self->{urls} }, @urls;
  20         168  
261            
262 20         57 my @errors;
263            
264 20         68 my $caller = caller;
265 20 50       94 Mojo::Loader::load_class($caller) if $caller ne 'main';
266              
267 20         128 local @INC = @INC;
268 20         191 $self->extract_data_section(qr{^lib/}, $caller);
269 20         354 my $home = File::HomeDir->my_home;
270 20 100       871 unshift @INC, "$home/lib"
271             if -d "$home/lib";
272              
273 20         125 foreach my $i (0..$#_)
274             {
275 34         213 $self->{index}++;
276 34         142 $self->{url} = shift @urls;
277            
278 34         103 my $app_name;
279             my $cb;
280 34         138 my $config = {};
281 34         117 my $item = $_[$i];
282 34 100       162 unless(ref $item)
283             {
284 31         83 my $fn = $item;
285 31         113 $fn =~ s{::}{-}g;
286 31         109 $fn = "etc/$fn.conf";
287 31 100       172 if(Mojo::Loader::data_section($caller, $fn))
288             {
289 6         100 $item = [ $item, Mojo::Loader::data_section($caller, $fn) ];
290             }
291             }
292              
293 34 100       505 if(ref $item eq 'ARRAY')
294             {
295 9         23 ($app_name, $config, $cb) = @{ $item };
  9         42  
296 9 100       44 unless(ref $config)
297             {
298 6         41 my $home = File::HomeDir->my_home;
299 6 100       291 mkdir "$home/etc" unless -d "$home/etc";
300 6         41 open my $fh, '>', do {
301 6         18 my $fn = $app_name;
302 6         26 $fn =~ s{::}{-}g;
303 6         417 $fn = "$home/etc/$fn.conf";
304             };
305 6         61 print $fh $config;
306 6         180 close $fh;
307 6         100 $config = {};
308             }
309             }
310             else
311             {
312 25         69 $app_name = $item;
313             }
314 34 50       189 my $psgi_name = $app_name =~ /\.psgi$/ ? $app_name : "$app_name.psgi";
315              
316            
317 34         101 my $app;
318             # we want to try to load class first, so that YourApp.pm
319             # will be picked over lite app yourapp on MSWin32
320             # (which is case insensative). So we save the error
321             # (from $@) and only push it onto the @errors list
322             # if loading as a lite app also fails.
323             my $first_try_error;
324            
325 34 50       130 unless(defined $app)
326             {
327 34     23   2622 $app = eval qq{
  23         7171  
  20         13257  
  20         299  
328             use $app_name;
329             if($app_name->isa('Clustericious::App'))
330             {
331             eval { # if they have Clustericious::Log 0.11 or better
332             require Test::Clustericious::Log;
333             Test::Clustericious::Log->import;
334             };
335             }
336             $app_name->new(\$config);
337             };
338 34         62013 $first_try_error = $@;
339             }
340              
341 34 100       173 unless(defined $app)
342             {
343 4 100       23 if(my $script = Mojo::Loader::data_section($caller, "script/$app_name"))
344             {
345 1         14 my $home = File::HomeDir->my_home;
346 1 50       69 mkdir "$home/script" unless -d "$home/script";
347 1         8 $app = _load_lite_app("$home/script/$app_name", $script);
348 1 50       9 if(my $error = $@)
349 0         0 { push @errors, [ $app_name, $error ] }
350             }
351            
352 4 50       58 if(my $script = Mojo::Loader::data_section($caller, "script/$psgi_name"))
353             {
354 0         0 my $home = File::HomeDir->my_home;
355 0         0 require Mojolicious;
356 0         0 require Mojolicious::Plugin::MountPSGI;
357 0         0 $app = Mojolicious->new;
358             # TODO: check syntax of .psgi file?
359 0         0 $self->extract_data_section("script/$psgi_name", $caller);
360 0         0 $app->plugin('Mojolicious::Plugin::MountPSGI' => { '/' => "$home/script/$psgi_name" });
361             }
362             }
363            
364 34 100       224 unless(defined $app)
365             {
366 3         6 foreach my $dir (@{ $self->{lite_path} })
  3         19  
367             {
368 11 100 66     385 if($app_name !~ /\.psgi$/
      66        
369             && (($^O eq 'MSWin32' && -e "$dir/$app_name") || (-x "$dir/$app_name")))
370             {
371 2         14 $app = _load_lite_app("$dir/$app_name");
372 2 50       8 if(my $error = $@)
373 0         0 { push @errors, [ $app_name, $error ] }
374 2         7 last;
375             }
376            
377 9 50       202 if(-e "$dir/$psgi_name")
378             {
379 0         0 require Mojolicious;
380 0         0 require Mojolicious::Plugin::MountPSGI;
381 0         0 $app = Mojolicious->new;
382 0         0 $app->plugin('Mojolicious::Plugin::MountPSGI' => { '/' => "$dir/$psgi_name" });
383             }
384             }
385             }
386            
387 34 100       137 unless(defined $app)
388             {
389 1 50       9 push @errors, [ $app_name, $first_try_error ]
390             if $first_try_error;
391             }
392            
393 34         85 push @{ $self->apps }, $app;
  34         171  
394 34 100       196 if(defined $app)
395 33         148 { $self->_add_app($self->url, $app, $#{ $self->apps }); }
  33         104  
396            
397 34 100       140 if(eval { $app->isa('Clustericious::App') })
  34         374  
398             {
399 12 50       162 if($app->can('auth_ua'))
400             {
401             $app->helper(auth_ua => sub {
402             die "no plug auth service configured for test cluster, either turn off authentication or use Test::Clustericious::Cluster#create_plugauth_lite_ok"
403 0 0   0   0 unless defined $self->{auth_ua};
404 0         0 $self->{auth_ua};
405 0         0 });
406             }
407             }
408              
409 34 100 100     348 if($app && $app->isa('Clustericious::App'))
410             {
411 12         40 my $fn = $app_name;
412 12         48 $fn =~ s{::}{-}g;
413 12         53 $fn = "$home/etc/$fn.conf";
414 12 100       319 unless(-e $fn)
415             {
416             # YAML::XS is a prereq for Clustericious
417             # so we can use it here.
418 4         41 require YAML::XS;
419 4         11 my %config = %{ $app->config };
  4         25  
420 4   66     79 $config{url} //= $self->url->to_string;
421 4         509 my $payload = YAML::XS::Dump(\%config);
422 4         407 open my $fh, '>', $fn;
423 4         60 print $fh $payload;
424 4         292 close $fh;
425             }
426             }
427              
428 34 50       256 $cb->() if defined $cb;
429             }
430              
431 20         219 $ctx->ok(@errors == 0, "created cluster");
432 20         8523 $ctx->diag("exception: " . $_->[0] . ': ' . $_->[1]) for @errors;
433            
434 20 100       203 if($INC{'Clustericious/App.pm'})
435             {
436 7         24 eval { require Clustericious::Client };
  7         182  
437 7 50 33     46837 if(!$@ && Clustericious::Client->can('_mojo_user_agent_factory'))
438             {
439             Clustericious::Client->_mojo_user_agent_factory(sub {
440 6     6   2435 $self->create_ua;
441 7         64 });
442             }
443             }
444            
445 20 50       224 if(defined $self->{t})
446             {
447 20         112 $self->_update_default_server;
448             }
449            
450 20         388 $ctx->release;
451 20         924 return $self;
452             }
453              
454              
455             sub create_plugauth_lite_ok
456             {
457 4     4 1 5269 my($self, %args) = @_;
458 4         10 my $ok = 1;
459 4         18 my $ctx = context();
460            
461 4 50 33     592 if(eval q{ use Clustericious; 1 } && ! eval q{ use Clustericious 0.9925; 1 })
462             {
463 0         0 croak "creat_plugin_lite_ok requires Clustericious 0.9925 or better (see Test::Clustericious::Test for details)";
464             }
465              
466 4         13 my @diag;
467              
468 4 100 66     40 if($self->{auth_ua} || $self->{auth_url})
469             {
470 1         3 $ok = 0;
471 1         3 push @diag, 'only use create_plugauth_lite_ok once';
472             }
473             else
474             {
475 3         17 my $ua = $self->{auth_ua} = $self->_add_ua;
476 3         79 my $url = Mojo::URL->new("http://127.0.0.1");
477 3         1604 $url->port(_generate_port);
478            
479 3         1417 eval {
480 3         31 require PlugAuth::Lite;
481            
482 3         41 my $app = $self->{auth_app} = PlugAuth::Lite->new(\%args);
483 3         38 $self->{auth_url} = $url;
484 3         16 $self->_add_app($url, $app);
485             };
486 3 50       17 if(my $error = $@)
487             {
488 0         0 $ctx->diag("error: $error");
489 0         0 $ok = 0;
490             }
491             }
492            
493 4         26 $ctx->ok($ok, "PlugAuth::Lite instance on " . $self->{auth_url});
494 4         1420 $ctx->diag($_) for @diag;
495 4         86 $ctx->release;
496            
497 4         143 return $self;
498             }
499              
500              
501             sub stop_ok
502             {
503 5     5 1 20108 my($self, $index, $test_name) = @_;
504 5         14 my $ok = 1;
505 5         18 my $ctx = context();
506            
507 5         397 my $error;
508            
509 5         25 my $app = $self->apps->[$index];
510 5 100       17 if(defined $app)
511             {
512 4         22 my $app_name = ref $app;
513 4   33     37 $test_name //= "stop service $app_name ($index)";
514 4         9 $_->stop for @{ $self->{app_servers}->[$index] };
  4         36  
515 4         1316 eval { @{ $self->{app_servers}->[$index] } = () };
  4         11  
  4         23  
516 4         1302 $error = $@;
517 4 50       14 $ok = 0 if $error;
518            
519 4 50 66     11 if($index == $#{ $self->apps } && $self->{t})
  4         13  
520             {
521 1         6 $self->t->ua->server(Mojo::UserAgent::Server->new);
522             }
523            
524             }
525             else
526             {
527 1         8 $error = "no such app for index: $index";
528 1         3 $ok = 0;
529             }
530            
531 5 100       782 $self->{stopped}->[$index] = 1 if $ok;
532            
533 5   66     22 $test_name //= "stop service ($index)";
534            
535 5         22 my $ret = $ctx->ok($ok, $test_name);
536            
537 5 100       1074 $ctx->diag($error) if $error;
538 5         81 $ctx->release;
539            
540 5         145 $ret;
541             }
542              
543              
544             sub start_ok
545             {
546 5     5 1 5207 my($self, $index, $test_name) = @_;
547 5         14 my $ok = 1;
548 5         16 my $ctx = context();
549            
550 5         355 my $error;
551              
552 5         23 my $app = $self->apps->[$index];
553 5 100       18 if(defined $app)
554             {
555 4         13 my $app_name = ref $app;
556 4   33     35 $test_name //= "start service $app_name ($index)";
557 4         9 eval {
558 4         18 $self->_add_app($self->urls->[$index], $app, $index);
559             };
560 4 50       22 if(my $error = $@)
561             {
562 0         0 $ctx->diag("error in start: $error");
563 0         0 $ok = 0;
564             }
565              
566             }
567             else
568             {
569 1         3 $error = "no such app for index: $index";
570 1         2 $ok = 0;
571             }
572            
573 5 100       24 $self->{stopped}->[$index] = 0 if $ok;
574              
575 5 50 66     11 if($index == $#{ $self->apps } && $self->{t})
  5         18  
576             {
577 1         7 $self->_update_default_server;
578             }
579              
580 5   66     32 $test_name //= "start service ($index)";
581            
582 5         46 $ctx->ok($ok, $test_name);
583 5 100       1403 $ctx->diag($error) if $error;
584 5         81 $ctx->release;
585            
586 5         150 $ok;
587             }
588              
589              
590             sub is_stopped
591             {
592 6     6 1 20407 my($self, $index, $test_name) = @_;
593            
594 6         19 my $ok = !!$self->{stopped}->[$index];
595            
596 6   33     42 $test_name //= "servers ($index) is stopped";
597            
598 6         17 my $ctx = context();
599 6         507 $ctx->ok($ok, $test_name);
600 6         921 $ctx->release;
601 6         162 $ok;
602             }
603              
604              
605             sub isnt_stopped
606             {
607 11     11 1 11797 my($self, $index, $test_name) = @_;
608            
609 11         29 my $ok = !$self->{stopped}->[$index];
610            
611 11   33     79 $test_name //= "servers ($index) is not stopped";
612            
613 11         37 my $ctx = context();
614 11         794 $ctx->ok($ok, $test_name);
615 11         1678 $ctx->release;
616            
617 11         268 $ok;
618             }
619              
620              
621             sub create_ua
622             {
623 9     9 1 12554 shift->_add_ua;
624             }
625              
626              
627             sub extract_data_section
628             {
629 26     26 1 6578 my($class, $regex, $caller) = @_;
630              
631 26   66     139 $regex //= qr{};
632            
633 26 100       132 unless(ref $regex eq 'Regexp')
634             {
635 2         10 $regex = quotemeta $regex;
636 2         41 $regex = qr{^$regex$};
637             }
638            
639 26   66     137 $caller //= caller;
640 26         134 my $all = Mojo::Loader::data_section $caller;
641 26         456 my $home = File::HomeDir->my_home;
642 26         2890 my $ctx = context();
643              
644 26         2414 foreach my $name (keys %$all)
645             {
646 35     35   490 use autodie;
  35         268653  
  35         205  
647 52 100       13542 next unless $name =~ $regex;
648 41         1672 my $basename = File::Basename::basename $name;
649 41         935 my $dir = File::Basename::dirname $name;
650              
651 41 100       977 unless(-d "$home/$dir")
652             {
653 28         288 $ctx->note("[extract] DIR $home/$dir");
654 28         33618 File::Path::mkpath "$home/$dir", 0, 0700;
655             }
656 41 100       1027 unless(-f "$home/$dir/$basename")
657             {
658 39         368 $ctx->note("[extract] FILE $home/$dir/$basename");
659 39         8764 open my $fh, '>', "$home/$dir/$basename";
660 39         43994 print $fh $all->{$name};
661 39         200 close $fh;
662             }
663             }
664            
665 26         8290 $ctx->release;
666 26         659 $class;
667             }
668              
669              
670             sub client
671             {
672 6     6 1 16849 my($self, $n) = @_;
673 6         80 my $app = $self->apps->[$n];
674 6 100       17 return unless eval { $app->isa('Clustericious::App') };
  6         52  
675 5         24 my $client_class = ref($app) . '::Client';
676 5 100 66     162 unless($client_class->can('new') || eval qq{ require $client_class; $client_class->isa('Clustericious::Client') })
677             {
678 1         11 require Clustericious::Client;
679 1         4 $client_class = 'Clustericious::Client';
680             }
681 5         16 my %config = %{ $app->config };
  5         26  
682 5         101 $config{url} = $self->urls->[$n];
683 5         35 my $client = $client_class->new( config => Clustericious::Config->new(\%config) );
684             }
685              
686             1;
687              
688             __END__
689              
690             =pod
691              
692             =encoding UTF-8
693              
694             =head1 NAME
695              
696             Test::Clustericious::Cluster - Test an imaginary beowulf cluster of Clustericious services
697              
698             =head1 VERSION
699              
700             version 0.36_01
701              
702             =head1 SYNOPSIS
703              
704             use Test2::Bundle::More;
705             use Test::Clustericious::Cluster;
706            
707             # suppose MyApp1 isa Clustericious::App and
708             # MyApp2 is a Mojolicious app
709             my $cluster = Test::Clustericious::Cluster->new;
710             $cluster->create_cluster_ok('MyApp1', 'MyApp2');
711            
712             my @urls = @{ $cluster->urls };
713             my $t = $cluster->t; # an instance of Test::Mojo
714            
715             $t->get_ok("$url[0]/arbitrary_path"); # tests against MyApp1
716             $t->get_ok("$url[1]/another_path"); # tests against MyApp2
717            
718             done_testing;
719            
720             __DATA__
721            
722             @@ etc/MyApp1.conf
723             ---
724             # Clustericious configuration
725             url: <%= cluster->url %>
726             url_for_my_app2: <%= cluster->urls->[1] %>
727              
728             =head1 DESCRIPTION
729              
730             This module allows you to test an entire cluster of Clustericious services
731             (or just one or two). The only prerequisites are L<Mojolicious> and
732             L<File::HomeDir>, so you can mix and match L<Mojolicious>, L<Mojolicious::Lite>
733             and full L<Clustericious> apps and test how they interact.
734              
735             If you are testing against Clustericious applications, it is important to
736             either use this module as early as possible, or use L<File::HomeDir::Test>
737             as the very first module in your test, as testing Clustericious configurations
738             depend on the testing home directory being setup by L<File::HomeDir::Test>.
739              
740             In addition to passing L<Clustericious> configurations into the
741             C<create_cluster_ok> method as describe below, you can include configuration
742             in the data section of your test script. The configuration files use
743             L<Clustericious::Config>, so you can use L<Mojo::Template> directives to
744             embed Perl code in the configuration. You can access the L<Test::Clustericious::Cluster>
745             instance from within the configuration using the C<cluster> function, which
746             can be useful for getting the URL for the your and other service URLs.
747              
748             __DATA__
749            
750             @@ etc/Foo.conf
751             ---
752             url <%= cluster->url %>
753             % # because YAML is (mostly) a super set of JSON you can
754             % # convert perl structures into config items using json
755             % # function:
756             % # (json method requires Clustericious::Config 0.25)
757             other_urls: <%= json [ @{ cluster->urls } ] %>
758              
759             You can also put perl code in the data section of your test file, which
760             can be useful if there isn't a another good place to put it. This
761             example embeds as L<Mojolicious> app "FooApp" and a L<Clustericious::App>
762             "BarApp" into the test script itself:
763              
764             ...
765             $cluster->create_cluster_ok('FooApp', 'BarApp');
766             ...
767            
768             __DATA__
769            
770             @@ lib/FooApp.pm
771             package FooApp;
772            
773             # FooApp is a Mojolicious app
774            
775             use Mojo::Base qw( Mojolicious );
776            
777             sub startup
778             {
779             shift->routes->get('/' => sub { shift->render(text => 'hello there from foo') });
780             }
781            
782             1;
783            
784             @@ lib/BarApp.pm
785             package BarApp;
786            
787             # BarApp is a Clustericious::App
788            
789             use strict;
790             use warnings;
791             use base qw( Clustericious::App );
792            
793             1;
794            
795             @@ lib/BarApp/Routes.pm
796             package BarApp::Routes;
797            
798             use strict;
799             use warnings;
800             use Clustericious::RouteBuilder;
801            
802             get '/' => sub { shift->render(text => 'hello there from bar') };
803            
804             1;
805              
806             These examples are full apps, but you could also use this
807             feature to implement mocks to test parts of your program
808             that use resources that aren't easily available during
809             unit testing, or may change from host to host. Here is an
810             example that mocks parts of L<Net::hostent>:
811              
812             use strict;
813             use warnings;
814             use Test::Clustericious::Cluster;
815             use Test2::Bundle::More;
816            
817             eval q{ use Net::hostent };
818             is $@, '';
819            
820             is gethost('bar')->name, 'foo.example.com', 'gethost(bar).name = foo.example.com';
821            
822             done_testing;
823            
824             __DATA__
825            
826             @@ lib/Net/hostent.pm
827             package Net::hostent;
828            
829             use strict;
830             use warnings;
831             use base qw( Exporter );
832             our @EXPORT = qw( gethost );
833            
834             sub gethost
835             {
836             my $input_name = shift;
837             return unless $input_name =~ /^(foo|bar|baz|foo.example.com)$/;
838             bless {}, 'Net::hostent';
839             }
840            
841             sub name { 'foo.example.com' }
842             sub aliases { qw( foo.example.com foo bar baz ) }
843            
844             1;
845              
846             =head1 CONSTRUCTOR
847              
848             =head2 new
849              
850             my $cluster = Test::Clustericious::Cluster->new( %args )
851              
852             Arguments:
853              
854             =head3 t
855              
856             The Test::Mojo object to use.
857             If not provided, then a new one will be created.
858              
859             =head3 lite_path
860              
861             List reference of paths to search for L<Mojolicious::Lite>
862             or PSGI apps.
863              
864             =head1 ATTRIBUTES
865              
866             =head2 t
867              
868             my $t = $cluster->t;
869              
870             The instance of Test::Mojo used in testing.
871              
872             =head2 urls
873              
874             my @urls = @{ $cluster->urls };
875              
876             The URLs for the various services.
877             Returned as an array ref.
878              
879             =head2 apps
880              
881             my @apps = @{ $cluster->apps };
882              
883             The application objects for the various services.
884             Returned as an array ref.
885              
886             =head2 index
887              
888             my $index = $cluster->index;
889              
890             The index of the current app (used from within a
891             L<Clustericious::Config> configuration.
892              
893             =head2 url
894              
895             my $url = $cluster->url;
896              
897             The url of the current app (used from within a
898             L<Clustericious::Config> configuration.
899              
900             =head2 auth_url
901              
902             my $url = $cluster->auth_url;
903              
904             The URL for the PlugAuth::Lite service, if one has been started.
905              
906             =head1 METHODS
907              
908             =head2 create_cluster_ok
909              
910             $cluster->create_cluster_ok( @services )
911              
912             Adds the given services to the test cluster.
913             Each element in the services array may be either
914              
915             =over 4
916              
917             =item string
918              
919             The string is taken to be the L<Mojolicious> or L<Clustericious>
920             application class name. No configuration is created or passed into
921             the App.
922              
923             This can also be the name of a L<Mojolicious::Lite> application.
924             The PATH environment variable will be used to search for the
925             lite application. The script for the lite app must be executable.
926             You can specify additional directories to search using the
927             C<lite_path> argument to the constructor.
928              
929             This can also be a PSGI application. In this case it needs to be
930             in the C<__DATA__> section of your test and it must have a name
931             in the form C<script/app.psgi>. This also requires
932             L<Mojolicious::Plugin::MountPSGI> already be installed so if you
933             use this feature make sure you declare that as a prereq.
934              
935             =item list reference in the form: [ string, hashref ]
936              
937             The string is taken to be the L<Mojolicious> application name.
938             The hashref is the configuration passed into the constructor
939             of the app. This form should NOT be used for L<Clustericious>
940             apps (see the third form).
941              
942             =item list reference in the form: [ string, string ]
943              
944             The first string is taken to be the L<Clustericious> application
945             name. The second string is the configuration in either YAML
946             or JSON format (may include L<Mojo::Template> templating in it,
947             see L<Clustericious::Config> for details). This form requires
948             that you have L<Clustericous> installed, and of course should
949             not be used for non-L<Clustericious> L<Mojolicious> applications.
950              
951             =back
952              
953             =head2 create_plugauth_lite_ok
954              
955             $cluster->create_plugauth_lite_ok( %args )
956              
957             Add a L<PlugAuth::Lite> service to the test cluster. The
958             C<%args> are passed directly into the L<PlugAuth::Lite>
959             constructor.
960              
961             You can retrieve the URL for the L<PlugAuth::Lite> service
962             using the C<auth_url> attribute.
963              
964             This feature requires L<PlugAuth::Lite> and L<Clustericious>
965             0.9925 or better, though neither are a prerequisite of this
966             module. If you are using this method you need to either require
967             L<PlugAuth::Lite> and L<Clustericious> 0.9925 or better, or skip
968             your test in the event that the user has an earlier version.
969             For example:
970              
971             use strict;
972             use warnings;
973             use Test::Clustericious::Cluster;
974             use Test2::Bundle::More;
975             BEGIN {
976             skip_all 'test requires Clustericious 0.9925'
977             unless eval q{ use Clustericious 1.00; 1 };
978             skip_all 'test requires PlugAuth::Lite'
979             unless eval q{ use PlugAuth::Lite 0.30; 1 };
980             };
981              
982             =head2 stop_ok
983              
984             $cluster->stop_ok( $index );
985             $cluster->stop_ok( $index, $test_name);
986              
987             Stop the given service. The service is specified by
988             an index, the first application when you created the
989             cluster is 0, the second is 1, and so on.
990              
991             See L<CAVEATS|Test::Clustericious::Cluster#CAVEATS>
992             below on interactions with IPv6 or TLS/SSL.
993              
994             =head2 start_ok
995              
996             $cluster->start_ok( $index );
997             $cluster->start_ok( $index, $test_name );
998              
999             Start the given service. The service is specified by
1000             an index, the first application when you created the
1001             cluster is 0, the second is 1, and so on.
1002              
1003             =head2 is_stopped
1004              
1005             $cluster->is_stopped( $index );
1006             $cluster->is_stopped( $index, $test_name );
1007              
1008             Passes if the given service is stopped.
1009              
1010             =head2 isnt_stopped
1011              
1012             $cluster->isnt_stopped( $index );
1013             $cluster->isnt_stopped( $index, $test_name );
1014              
1015             Passes if the given service is not stopped.
1016              
1017             =head2 create_ua
1018              
1019             my $ua = $cluster->create_ua;
1020              
1021             Create a new instance of Mojo::UserAgent which can be used
1022             to connect to nodes in the test cluster.
1023              
1024             =head2 extract_data_section
1025              
1026             $cluster->extract_data_section($regex);
1027             Test::Clustericious::Cluster->extract_data_section($regex);
1028              
1029             Extract the files from the data section of the current package
1030             that match the given regex. C<$regex> can also be a plain
1031             string for an exact filename match.
1032              
1033             =head2 client
1034              
1035             my $client = $cluster->client($n);
1036              
1037             Return a L<Clustericious::Client> object for use with the C<$n>th
1038             service in the cluster. If there is a corresponding C<YourService::Client>
1039             class then it will be used. Otherwise you will get a generic
1040             L<Clustericious::Client> object with the correct URL configured.
1041              
1042             This method only works with L<Clustericious> services.
1043              
1044             =head1 CAVEATS
1045              
1046             Some combination of Mojolicious, FreeBSD, IPv6 and TLS/SSL
1047             seem to react badly to the use of
1048             L<stop_ok|Test::Clustericious::Cluster#stop_ok>. The work
1049             around is to turn IPv6 and TLS/SSL off in the beginning
1050             of any tests that uses stop_ok your test like thus:
1051              
1052             use strict;
1053             use warnings;
1054             BEGIN { $ENV{MOJO_NO_IPV6} = 1; $ENV{MOJO_NO_TLS} = 1; }
1055             use Test::Clustericious::Cluster;
1056              
1057             A proper fix would be desirable, see
1058              
1059             https://github.com/plicease/Test-Clustericious-Cluster/issues/3
1060              
1061             If you want to help.
1062              
1063             =head1 AUTHOR
1064              
1065             Graham Ollis <plicease@cpan.org>
1066              
1067             =head1 COPYRIGHT AND LICENSE
1068              
1069             This software is copyright (c) 2013 by Graham Ollis.
1070              
1071             This is free software; you can redistribute it and/or modify it under
1072             the same terms as the Perl 5 programming language system itself.
1073              
1074             =cut