File Coverage

lib/Rex/Test/Base.pm
Criterion Covered Total %
statement 23 102 22.5
branch 0 18 0.0
condition 0 10 0.0
subroutine 8 23 34.7
pod 8 13 61.5
total 39 166 23.4


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             =head1 NAME
6              
7             Rex::Test::Base - Basic Test Module
8              
9             =head1 DESCRIPTION
10              
11             This is a basic test module to test your code with the help of local VMs. You can place your tests in the "t" directory.
12              
13             =head1 EXAMPLE
14              
15             use Rex::Test::Base;
16             use Data::Dumper;
17             use Rex -base;
18              
19             test {
20             my $t = shift;
21              
22             $t->name("ubuntu test");
23              
24             $t->base_vm("http://box.rexify.org/box/ubuntu-server-12.10-amd64.ova");
25             $t->vm_auth(user => "root", password => "box");
26              
27             $t->run_task("setup");
28              
29             $t->has_package("vim");
30             $t->has_package("ntp");
31             $t->has_package("unzip");
32              
33             $t->has_file("/etc/ntp.conf");
34              
35             $t->has_service_running("ntp");
36              
37             $t->has_content("/etc/passwd", qr{root:x:0:}ms);
38              
39             run "ls -l";
40             $t->ok($? == 0, "ls -l returns success.");
41              
42             $t->finish;
43             };
44              
45             1; # last line
46              
47             =head1 METHODS
48              
49             =cut
50              
51             package Rex::Test::Base;
52              
53 1     1   13 use v5.12.5;
  1         3  
54 1     1   5 use warnings;
  1         2  
  1         28  
55              
56 1     1   4 use base 'Test::Builder::Module';
  1         2  
  1         119  
57              
58             our $VERSION = '1.14.3'; # VERSION
59              
60             require Rex::Commands;
61 1     1   11 use Rex::Commands::Box;
  1         4  
  1         6  
62 1     1   15 use Data::Dumper;
  1         6  
  1         52  
63 1     1   5 use Carp;
  1         2  
  1         73  
64              
65             require Exporter;
66 1     1   7 use base qw(Exporter);
  1         2  
  1         74  
67 1     1   8 use vars qw(@EXPORT);
  1         5  
  1         1213  
68             @EXPORT = qw(test);
69              
70             =head2 new(name => $test_name)
71              
72             Constructor if used in OO mode.
73              
74             my $test = Rex::Test::Base->new(name => "test_name");
75              
76             =cut
77              
78             sub new {
79 0     0 1   my $that = shift;
80 0   0       my $proto = ref($that) || $that;
81 0           my $self = {@_};
82              
83 0           bless( $self, $proto );
84              
85 0           my ( $pkg, $file ) = caller(0);
86              
87 0   0       $self->{name} ||= $file;
88 0           $self->{redirect_port} = 2222;
89 0   0       $self->{memory} ||= 512; # default, in MB
90 0   0       $self->{cpu} ||= 1; # default
91              
92 0           return $self;
93             }
94              
95             =head2 name($name)
96              
97             The name of the test. A VM called $name will be created for each test. If the VM already exists, Rex will try to reuse it.
98              
99             =cut
100              
101             sub name {
102 0     0 1   my ( $self, $name ) = @_;
103 0           $self->{name} = $name;
104             }
105              
106             =head2 memory($amount)
107              
108             The amount of memory the VM should use, in Megabytes.
109              
110             =cut
111              
112             sub memory {
113 0     0 1   my ( $self, $memory ) = @_;
114 0           $self->{memory} = $memory;
115             }
116              
117             =head2 cpus($number)
118              
119             The number of CPUs the VM should use.
120              
121             =cut
122              
123             sub cpus {
124 0     0 1   my ( $self, $cpus ) = @_;
125 0           $self->{cpus} = $cpus;
126             }
127              
128             =head2 vm_auth(%auth)
129              
130             Authentication options for the VM. It accepts the same parameters as Cauth()>.
131              
132             =cut
133              
134             sub vm_auth {
135 0     0 1   my ( $self, %auth ) = @_;
136 0           $self->{auth} = \%auth;
137             }
138              
139             =head2 base_vm($vm)
140              
141             The URL to a base image to be used for the test VM.
142              
143             =cut
144              
145             sub base_vm {
146 0     0 1   my ( $self, $vm ) = @_;
147 0           $self->{vm} = $vm;
148             }
149              
150             sub test(&) {
151 0     0 0   my $code = shift;
152 0           my $test = __PACKAGE__->new;
153 0           $code->($test);
154             }
155              
156             =head2 redirect_port($port)
157              
158             Redirect local $port to the VM's SSH port (default: 2222).
159              
160             =cut
161              
162             sub redirect_port {
163 0     0 1   my ( $self, $port ) = @_;
164 0           $self->{redirect_port} = $port;
165             }
166              
167             =head2 run_task($task)
168              
169             The task to run on the test VM. You can run multiple tasks by passing an array reference.
170              
171             =cut
172              
173             sub run_task {
174 0     0 1   my ( $self, $task ) = @_;
175              
176             # allow multiple calls to run_task() without setting up new box
177 0 0         if ( $self->{box} ) {
178 0           $self->{box}->provision_vm($task);
179 0           return;
180             }
181              
182 0           my $box;
183             box {
184 0     0     $box = shift;
185 0           $box->name( $self->{name} );
186 0           $box->url( $self->{vm} );
187 0           $box->memory( $self->{memory} );
188 0           $box->cpus( $self->{cpus} );
189              
190 0           $box->network(
191             1 => {
192             type => "nat",
193             }
194             );
195              
196 0           $box->forward_port( ssh => [ $self->{redirect_port}, 22 ] );
197              
198 0           $box->auth( %{ $self->{auth} } );
  0            
199              
200 0 0         if ( ref $task eq 'ARRAY' ) {
201 0           $box->setup(@$task);
202             }
203             else {
204 0           $box->setup($task);
205             }
206 0           };
207              
208 0           $self->{box} = $box;
209              
210             # connect to the machine
211             Rex::connect(
212             server => $box->ip,
213 0           %{ $self->{auth} },
  0            
214             );
215             }
216              
217             sub ok() {
218 0     0 0   my ( $self, $test, $msg ) = @_;
219 0           my $tb = Rex::Test::Base->builder;
220 0           $tb->ok( $test, $msg );
221             }
222              
223             sub like {
224 0     0 0   my ( $self, $thing, $want, $name ) = @_;
225 0           my $tb = Rex::Test::Base->builder;
226 0           $tb->like( $thing, $want, $name );
227             }
228              
229             sub diag {
230 0     0 0   my ( $self, $msg ) = @_;
231 0           my $tb = Rex::Test::Base->builder;
232 0           $tb->diag($msg);
233             }
234              
235             sub finish {
236 0     0 0   my $tb = Rex::Test::Base->builder;
237 0           $tb->done_testing();
238 0 0         $tb->is_passing()
239             ? print "PASS\n"
240             : print "FAIL\n";
241 0 0         if ( !$tb->is_passing() ) {
242 0           Rex::Test::push_exit("FAIL");
243             }
244 0           $tb->reset();
245              
246 0           Rex::pop_connection();
247             }
248              
249             =head1 TEST METHODS
250              
251             =head2 has_content($file, $regexp)
252              
253             Test if the content of $file matches against $regexp.
254              
255             =head2 has_dir($path)
256              
257             Test if $path is present and is a directory.
258              
259             =head2 has_file($file)
260              
261             Test if $file is present.
262              
263             =head2 has_package($package, $version)
264              
265             Test if $package is installed, optionally at $version.
266              
267             =head2 has_service_running($service)
268              
269             Test if $service is running.
270              
271             =head2 has_service_stopped($service)
272              
273             Test if $service is stopped.
274              
275             =head2 has_stat($file, $stat)
276              
277             Test if $file has properties described in hash reference $stat. List of supported checks:
278              
279             =over 4
280              
281             =item group
282              
283             =item owner
284              
285             =back
286              
287             =cut
288              
289             our $AUTOLOAD;
290              
291             sub AUTOLOAD {
292 0 0   0     my $self = shift or return;
293 0           ( my $method = $AUTOLOAD ) =~ s{.*::}{};
294              
295 0 0         if ( $method eq "DESTROY" ) {
296 0           return;
297             }
298              
299 0           my $real_method = $method;
300 0           my $is_not = 0;
301 0 0         if ( $real_method =~ m/^has_not_/ ) {
302 0           $real_method =~ s/^has_not_/has_/;
303 0           $is_not = 1;
304             }
305              
306 0           my $pkg = __PACKAGE__ . "::$real_method";
307 0           eval "use $pkg";
308 0 0         if ($@) {
309 0           confess "Error loading $pkg. No such test method.";
310             }
311              
312 0           my $p = $pkg->new;
313 0 0         if ($is_not) {
314 0           $p->run_not_test(@_);
315             }
316             else {
317 0           $p->run_test(@_);
318             }
319             }
320              
321             1;