Executor.pm 6 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2 3
#
# Copyright (c) 2009 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23
#
24
package TestBed::ParallelRunner::Executor::Exception;
25
use Moose;
26
  has original => ( is => 'rw');
27
no Moose;
28

Kevin Tew's avatar
Kevin Tew committed
29
package TestBed::ParallelRunner::Executor::PrerunError;
30
use Moose;
31
  extends('TestBed::ParallelRunner::Executor::Exception');
32
no Moose;
33 34

package TestBed::ParallelRunner::Executor::SwapinError;
35
use Moose;
36
  extends('TestBed::ParallelRunner::Executor::Exception');
37
no Moose;
38 39

package TestBed::ParallelRunner::Executor::RunError;
40
use Moose;
41
  extends('TestBed::ParallelRunner::Executor::Exception');
42
no Moose;
43 44

package TestBed::ParallelRunner::Executor::SwapoutError;
45
use Moose;
46
  extends('TestBed::ParallelRunner::Executor::Exception');
47
no Moose;
48 49

package TestBed::ParallelRunner::Executor::KillError;
50
use Moose;
51
  extends('TestBed::ParallelRunner::Executor::Exception');
52
no Moose;
53 54 55 56 57

package TestBed::ParallelRunner::Executor;
use TestBed::ParallelRunner::ErrorStrategy;
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
58
use Moose;
59 60 61 62
use Data::Dumper;

has 'e'    => ( isa => 'TestBed::TestSuite::Experiment', is => 'rw');
has 'desc' => ( isa => 'Str', is => 'rw');
Kevin Tew's avatar
Kevin Tew committed
63
has 'ns'   => ( is => 'rw');
64 65 66 67 68
has 'proc' => ( isa => 'CodeRef', is => 'rw');
has 'test_count' => ( isa => 'Any', is => 'rw');
has 'error_strategy' => ( is => 'rw', lazy => 1, default => sub { TestBed::ParallelRunner::ErrorStrategy->new; } );
has 'pre_result_handler' => ( isa => 'CodeRef', is => 'rw');

Kevin Tew's avatar
Kevin Tew committed
69 70 71 72 73 74 75 76 77
sub ns_text {
  my $s = shift;
  my $ns = $s->ns;
  if (ref($ns) eq 'CODE') {
    return $ns->();
  }
  return $ns;
}

78
sub parse_options {
79 80 81 82 83
  my %options = @_;

  if (defined (delete $options{retry})) {
    $options{error_strategy} = TestBed::ParallelRunner::ErrorRetryStrategy->new;
  }
84 85 86 87 88

  if (defined (my $params = delete $options{backoff})) {
    $options{error_strategy} = TestBed::ParallelRunner::BackoffStrategy->build($params);
    
  }
89 90 91 92
  
  if (defined (my $strategy = delete $options{strategy})) {
    $options{error_strategy} = $strategy;
  }
93 94 95 96 97
  
  %options;
}

sub buildt { shift; TestBed::ParallelRunner::Executor->new( parse_options(@_)); }
98

99 100
sub build {
  my ($e, $ns, $sub, $test_count, $desc) = (shift, shift, shift, shift, shift);
101 102 103 104 105 106
  return TestBed::ParallelRunner::Executor->new(
    'e'          => $e,
    'ns'         => $ns,
    'proc'       => $sub,
    'test_count' => $test_count,
    'desc'       => $desc,
107
    parse_options(@_)
108 109 110 111 112 113 114 115 116 117
  );
}

sub handleResult { 
  my ($s) = @_;
  my $prh = $s->pre_result_handler;
  $prh->(@_) if $prh;
  $s->error_strategy->handleResult( @_); 
}

Kevin Tew's avatar
Kevin Tew committed
118
sub prerun{
Kevin Tew's avatar
Kevin Tew committed
119
  my $s = shift;
Kevin Tew's avatar
Kevin Tew committed
120
  if (checkexclude('create')) {
Kevin Tew's avatar
Kevin Tew committed
121 122 123
    return +{'maximum_nodes' => 0};
  }
  my $r = eval { $s->e->create_and_get_metadata($s->ns_text); };
Kevin Tew's avatar
Kevin Tew committed
124
  die TestBed::ParallelRunner::Executor::PrerunError->new( original => $@ ) if $@;
125 126 127
  return $r;
}

Kevin Tew's avatar
Kevin Tew committed
128
sub checkexclude {
Kevin Tew's avatar
Kevin Tew committed
129
  my $stage = shift;
Kevin Tew's avatar
Kevin Tew committed
130
  return grep { $_ eq $stage } @{ $TBConfig::exclude_steps };
Kevin Tew's avatar
Kevin Tew committed
131 132
}

Kevin Tew's avatar
Kevin Tew committed
133 134 135 136 137
sub failReason {
  my $s = shift;
  sprintf("FAILURE %s: %s", $s->e->eid, shift->error_type);
}

138
sub execute {
Kevin Tew's avatar
Kevin Tew committed
139 140
  my $s = shift;
  my $e = $s->e;
Kevin Tew's avatar
Kevin Tew committed
141
  my $eid = $e->eid;
142

Kevin Tew's avatar
Kevin Tew committed
143 144 145
  my $run_exception;
  my $swapout_exception;

Kevin Tew's avatar
Kevin Tew committed
146
  eval { $e->swapin_wait; } unless checkexclude('swapin');
Kevin Tew's avatar
Kevin Tew committed
147
  my $swapin_exception = $@;
Kevin Tew's avatar
Kevin Tew committed
148
  die TestBed::ParallelRunner::Executor::SwapinError->new( original => $swapin_exception ) if $swapin_exception;
149

Kevin Tew's avatar
Kevin Tew committed
150 151 152
  eval { $s->proc->($e); } unless checkexclude('run');
  $run_exception = $@;
  die TestBed::ParallelRunner::Executor::RunError->new( original => $run_exception ) if $run_exception;
153

Kevin Tew's avatar
Kevin Tew committed
154 155 156
  eval { $e->swapout_wait; } unless checkexclude('swapout');
  $swapout_exception = $@;
  die TestBed::ParallelRunner::Executor::SwapoutError->new( original => $swapout_exception ) if $swapout_exception;
157

Kevin Tew's avatar
Kevin Tew committed
158
  eval { $e->end_wait; } unless checkexclude('end');
Kevin Tew's avatar
Kevin Tew committed
159 160
  my $end_exception = $@;
  die TestBed::ParallelRunner::Executor::KillError->new( original => $end_exception ) if $end_exception;
Kevin Tew's avatar
Kevin Tew committed
161

162 163 164
  return 1;
}

Kevin Tew's avatar
Kevin Tew committed
165 166 167 168 169 170 171 172 173 174 175 176 177
sub ensure_end {
  my $s = shift;
  my $e = $s->e;
  my $eid = $e->eid;

  eval { 
    $e->ensure_end; 
  } unless checkexclude('end');

  my $end_exception = $@;
  die TestBed::ParallelRunner::Executor::KillError->new( original => $end_exception ) if $end_exception;
}

178 179 180 181 182 183 184 185 186 187 188 189
=head1 NAME

TestBed::ParallelRunner::Executor

Represents a ParallelRunner Job

=over 4

=item C<< build($e, $ns, $sub, $test_count, $desc) >>

constructs a TestBed::ParallelRunner::Test job

Kevin Tew's avatar
Kevin Tew committed
190 191 192 193 194 195 196 197 198
=item C<< checkexclude($stage_name) >>

checks if $stage_name is in $TBConfig::exclude_steps

=item C<< $prt->ns_text >>

checks if ns_text is a CODE reference, is so execute it otherwise return ns_text

=item C<< $prt->prerun >>
199 200 201 202 203 204 205 206 207 208 209 210

executes the pre_running phase of experiment and determines min and max node counts.

=item C<< $prt->handleResult >>

handles the result using a error strategy

=item C<< $prt->execute >>

swaps in the experiment and runs the specified test
it kills the experiment unconditionaly after the test returns

Kevin Tew's avatar
Kevin Tew committed
211 212 213 214
=item C<< $prt->ensure_end >>

calls end on an experiment allowing for experiment doesn't exist and in transition exceptions

215 216 217 218 219 220 221 222 223
=item C<< $prt->parse_options >>

parses retry =>1, backoff => "\d+:\d+:\d+:\d+", strategy => '....' options
and build the appropriate error_strategy object

=item C<< $prt->buildt >>

builds a naked TestBed::ParallelRunner::Executor for testing purposes

Kevin Tew's avatar
Kevin Tew committed
224 225 226 227
=item C<< $prt->failReason($reason) >>

prints $eid and fail reason

228 229 230 231 232
=back

=cut

1;