File Coverage

blib/lib/Test/Nightly/Test.pm
Criterion Covered Total %
statement 129 145 88.9
branch 40 68 58.8
condition 0 3 0.0
subroutine 16 16 100.0
pod 2 4 50.0
total 187 236 79.2


line stmt bran cond sub pod time code
1             package Test::Nightly::Test;
2              
3 7     7   39315 use strict;
  7         16  
  7         383  
4 7     7   40 use warnings;
  7         13  
  7         233  
5              
6 7     7   39 use Carp;
  7         15  
  7         743  
7 7     7   41 use File::Spec;
  7         12  
  7         256  
8 7     7   39 use List::Util qw(shuffle);
  7         9  
  7         1191  
9 7     7   8743 use Test::Harness::Straps;
  7         197178  
  7         300  
10              
11 7     7   661 use Test::Nightly;
  7         15  
  7         157  
12 7     7   3410 use Test::Nightly::Email;
  7         24  
  7         60  
13              
14 7     7   319 use base qw(Test::Nightly::Base Class::Accessor::Fast);
  7         16  
  7         13588  
15              
16             my @methods = qw(
17             build_type
18             modules
19             test_directory_format
20             test_file_format
21             test_order
22             tests
23             install_module
24             skip_tests
25             );
26              
27             __PACKAGE__->mk_accessors(@methods);
28              
29             our $VERSION = '0.03';
30              
31             =head1 NAME
32              
33             Test::Nightly::Test - Make and runs your tests.
34              
35             =head1 DESCRIPTION
36              
37             Designed to run our tests, and then store the results back into the object. You probably should not be dealing with this module directly.
38              
39             =head1 SYNOPSIS
40              
41             use Test::Nightly::Test;
42              
43             my $test = Test::Nightly::Test->new();
44              
45             $test->run();
46              
47             The following methods are available:
48              
49             =cut
50              
51             =head2 new()
52              
53             my $test = Test::Nightly::Test->new({
54             modules => \@modules, # Required.
55             build_type => 'make' # || 'build'. 'make' is default.
56             install_module => 'all', # || 'passed'. 'all' is default.
57             skip_tests => 1, # skips the tests.
58             test_directory_format => ['t/', 'tests/'], # Optional, defaults to ['t/'].
59             test_file_format => ['.t', '.pl'], # Optional, defaults to ['.t'].
60             test_order => 'ordered', # || 'random'. 'ordered' is default.
61             });
62              
63             Create a new Test::Nightly::Test object.
64              
65             C is an array of the hash refs that include the path to the module and the build script name. It isn't required that you supply this because the directories are found from the Test::Nightly object. Basically you probably shouldn't be calling this package on it's own, rather use the Test::Nightly as your interface, but if you really want to you can.
66              
67             The rest of the inputs are described below in the List of Methods.
68              
69             =cut
70              
71             sub new {
72              
73 7     7 1 1746 my ($class, $conf) = @_;
74              
75 7         24 my $self = bless {}, $class;
76              
77 7         63 $self->_init($conf, \@methods);
78            
79 7 50       29 croak 'Test::Nightly::Test::new() - "modules" must be supplied' unless ($self->modules());
80              
81 7 100       62 $self->test_directory_format(['t/']) unless ($self->test_directory_format());
82 7 100       85 $self->test_file_format(['.t']) unless ($self->test_file_format());
83 7 100       82 $self->build_type('make') unless ($self->build_type());
84 7 50       100 $self->test_order('ordered') unless ($self->test_order());
85              
86 7         235 return $self;
87              
88             }
89              
90             =head2 run()
91              
92             $test->run({
93             # ... can take the same arguments as new() ...
94             });
95              
96             Loops through the supplied modules, makes those modules and runs their tests.
97              
98             =cut
99              
100             sub run {
101              
102 6     6 1 18 my ($self, $conf) = @_;
103              
104 6 50       25 unless (ref($self->test_directory_format()) eq 'ARRAY') {
105 0         0 croak "Test::Nightly::Test::run(): Supplied 'test_directory_format' must be an array reference";
106             }
107 6 50       60 unless (ref($self->test_file_format()) eq 'ARRAY') {
108 0         0 croak "Test::Nightly::Test::run(): Supplied 'test_file_format' must be an array reference";
109             }
110 6 50       92 unless ($self->build_type() =~ /^(build|make)$/) {
111 0         0 croak "Test::Nightly::Test::run(): Supplied 'build_type' can only be 'build' or 'make'";
112             }
113              
114 6 100       74 if ($self->build_type() eq 'build') {
115 1         14 require Module::Build;
116             }
117            
118             # New strap
119 6         109 my $strap = Test::Harness::Straps->new;
120              
121 6         172 my %tests;
122 6 100       13 if (scalar @{$self->modules()}) {
  6         31  
123              
124 5         36 foreach my $module (@{$self->modules()}) {
  5         17  
125              
126             # Check if dir exists
127 5         126 my $chdir_result = chdir($module->{'directory'});
128 5 50       20 unless ($chdir_result) {
129 0         0 carp 'Test::Nightly::Test::run(): Unable to change directory to: '.$module->{'directory'}.', skipping';
130 0         0 next;
131             }
132              
133             # E.g. "perl Makefile.PL"
134 5         47 my $build_command = $self->_perl_command().' '.$module->{build_script};
135 5         1805557 `$build_command`;
136              
137             # E.g. "make"
138 5         312 my $run_build = $self->_run_build();
139 5         4164451 `$run_build`;
140              
141 5         182 my $all_tests_passed = 1;
142              
143             # Loop through each test_path that has been passed in
144 5 50       430 unless (defined $self->skip_tests()) {
145              
146 5         179 foreach my $test_path (@{$self->test_directory_format()}) {
  5         93  
147              
148 5         391 $self->_debug('Current test path is: ' . $test_path);
149              
150             # Loop through each test extention that has been passed in
151 5         116 foreach my $test_ext (@{$self->test_file_format()}) {
  5         80  
152              
153             # Strip out the leading slash just so we won't get a double slash
154 5         229 my $full_path = File::Spec->canonpath($module->{directory} . $test_path);
155              
156 5 50       612 if(-d $test_path) {
157            
158 5         131 $self->_debug('Looking for tests that match the extention: ' . $test_ext.' in the path: ' . $test_path);
159              
160             # Find all the tests matching the test extention that are in the directory specified.
161 5         216 my $test_rule = File::Find::Rule->new;
162 5         2075 $test_rule->name( '*' . $test_ext);
163 5         1648 my @found_tests = $test_rule->in($test_path);
164              
165              
166             # By default, we wish to run the tests in order. The user can pass in a flag to get them to run at random.
167 5 50       12621 if ($self->test_order() eq 'random') {
168             # Sort randomly with List::Util
169 0         0 @found_tests = shuffle @found_tests
170             } else {
171             # Sort numerically ascending
172 5         123 @found_tests = sort @found_tests;
173             }
174              
175             # Run through each test individually, so our report is more specific.
176 5         24 foreach my $test (@found_tests) {
177              
178             # Just in case we picked up the build script as a 'test'
179 12 50       211 if ($test =~ /$module->{'build_script'}$/i) {
180 0         0 next;
181             }
182            
183             # Grab the perl comment to run the test
184 12         104 my $perl = $self->_perl_command();
185              
186             # Run the test, grab the output.
187 12         1117323 my $output = `$perl $test 2>&1`;
188              
189             # Turn it into an array of lines, because that is what Test::Harness::Straps likes
190 12         603 my @output = split("\n", $output);
191              
192             # Get Test::Harness::Straps to analyze the output of the test
193 12         500 my %results = $strap->analyze('test', \@output);
194              
195             # Put test into hash for our data structure
196 12         12943 my %single_test = (
197             test => $test,
198             );
199            
200 12 50       118 if ($results{passing}) {
201 0         0 $single_test{'status'} = 'passed';
202 0         0 $self->_debug('Test in path ['.$full_path.'] ['.$test.'] passed');
203             } else {
204 12         51 $all_tests_passed = undef;
205 12         94 $single_test{'status'} = 'failed';
206 12         338 $self->_debug('Test in path ['.$full_path.'] ['.$test.'] failed');
207             }
208              
209 12         199 push (@{$tests{$full_path}}, \%single_test);
  12         388  
210            
211             }
212              
213             }
214              
215             }
216              
217             }
218            
219             }
220              
221             # E.g. "make install"
222 5         113 my $install_build = $self->_install_build();
223              
224 5 50       85 if (defined $self->install_module()) {
225            
226 0 0 0     0 if ($self->install_module() eq 'all') {
    0          
227             # Install the module, we don't care if the tests passed or failed.
228 0         0 `$install_build`;
229             } elsif ($self->install_module() eq 'passed' and $all_tests_passed) {
230             # Install the module, only if it's tests pass. If you choose not to run the tests, this will probably install.
231 0         0 `$install_build`;
232             }
233             }
234              
235             # E.g. "make clean"
236 5         97 my $clean_build = $self->_clean_build();
237 5         560962 `$clean_build`;
238              
239             }
240              
241 5         584 $self->tests(\%tests);
242              
243             }
244              
245             }
246              
247             # Extract out only the passed tests from tests()
248              
249             sub passed_tests {
250              
251 3     3 0 38 my $self = shift;
252              
253 3         19 my %passed_tests;
254 3 50       27 if (defined $self->tests()) {
255              
256 3         43 foreach my $module (keys %{$self->tests()}) {
  3         32  
257              
258 3         319 foreach my $tests ($self->tests()->{$module}){
259              
260 3         30 foreach my $test (@{$tests}) {
  3         11  
261              
262 6 50       37 if ($test->{'status'} eq 'passed') {
263 0         0 push (@{$passed_tests{$module}}, $test);
  0         0  
264             }
265             }
266             }
267             }
268              
269              
270             }
271              
272 3 50       20 if ( scalar keys %passed_tests ) {
273 0         0 return \%passed_tests;
274             } else {
275 3         123 return undef;
276             }
277              
278             }
279              
280             # Extract out only the failed tests from tests()
281              
282             sub failed_tests {
283              
284 2     2 0 14 my $self = shift;
285              
286 2         8 my %failed_tests;
287 2 50       7 if (defined $self->tests()) {
288              
289 2         14 foreach my $module (keys %{$self->tests()}) {
  2         9  
290              
291 2         27 foreach my $tests ($self->tests()->{$module}){
292              
293 2         11 foreach my $test (@{$tests}) {
  2         21  
294              
295 4 50       12 if ($test->{'status'} eq 'failed') {
296 4         8 push (@{$failed_tests{$module}}, $test);
  4         14  
297             }
298             }
299             }
300             }
301             }
302              
303 2 50       9 if ( scalar keys %failed_tests ) {
304 2         18 return \%failed_tests;
305             } else {
306 0         0 return undef;
307             }
308              
309             }
310              
311              
312             # Returns the correct build command. E.g. 'make'.
313              
314              
315             sub _run_build {
316              
317 5     5   42 my $self = shift;
318              
319 5 100       148 if ($self->build_type() eq 'build') {
320 1 50       90 return $self->_perl_command().' Build' if $self->{_is_win32};
321 1         17 return './Build';
322             } else {
323             # Default to make
324 4 50       268 return 'nmake' if $self->{_is_win32};
325 4         66 return 'make -s';
326             }
327              
328             }
329              
330             # Returns the correct install command. E.g. 'make install'.
331              
332             sub _install_build {
333              
334 5     5   28 my $self = shift;
335              
336 5 100       85 if ($self->build_type() eq 'build') {
337 1 50       42 return $self->_perl_command().' Build install' if $self->{_is_win32};
338 1         10 return './Build install';
339             } else {
340             # Default to make
341 4 50       106 return 'nmake install' if $self->{_is_win32};
342 4         27 return 'make -s';
343             }
344             }
345              
346             # Returns the correct clean command. E.g. 'make clean'.
347              
348             sub _clean_build {
349              
350 5     5   25 my $self = shift;
351              
352 5 100       29 if ($self->build_type() eq 'build') {
353 1 50       15 return $self->_perl_command().' Build clean' if $self->{_is_win32};
354 1         11 return './Build clean';
355             } else {
356             # Default to make
357 4 50       67 return 'nmake clean' if $self->{_is_win32};
358 4         24 return 'make -s clean';
359             }
360              
361             }
362              
363             =head1 List of methods:
364              
365             =over 4
366              
367             =item build_type
368              
369             Pass this in so we know how you build your modules. There are two options: 'build' and 'make'. Defaults to 'make'.
370              
371             =item install_module
372              
373             Pass this in if you wish to have the module installed.
374              
375             =item modules
376              
377             List of modules. Usually is generated when you call L new method, however it is possible to pass it in directly here.
378             Structure is like so:
379              
380             @modules = (
381             {
382             'directory' => '/dir/to/module01/',
383             'build_script' => 'Makefile.PL',
384             },
385             {
386             'directory' => '/dir/to/module02/',
387             'build_script' => 'Makefile.PL',
388             },
389             );
390              
391             =item skip_tests
392              
393             Pass this in if you wish to skip running the tests.
394              
395             =item test_directory_format
396            
397             An array ref of what format the test directories can be. By default it searches for the tests in 't/'.
398              
399             =item test_file_format
400              
401             An array ref of the test file formats you have. e.g. @file_formats = ('.pl', '.t'); Defaults to ['.t'].
402              
403             =item test_order
404              
405             Pass this in if you wish to influence the way the tests are run. Either 'ordered' or 'random'. Detauls to 'ordered'.
406              
407             =item tests
408              
409             Where the output is stored after running the tests.
410              
411             =head1 TODO
412              
413             Find a way to suppress the output while the tests are running.
414              
415             =head1 AUTHOR
416              
417             Kirstin Bettiol
418              
419             =head1 COPYRIGHT
420              
421             (c) 2005 Kirstin Bettiol
422             This library is free software, you can use it under the same terms as perl itself.
423              
424             =head1 SEE ALSO
425              
426             L,
427             L,
428             L,
429             L,
430             L,
431             L,
432             L.
433              
434             =cut
435              
436             1;
437