view release on metacpan or  search on metacpan

script/perlall  view on Meta::CPAN

      elsif ($v[2] eq 'paused') {
	if ($max and @running > $max) {
	  my $r = shift @running;
	  $c->_system1(qw(sudo virsh suspend), $r);
	  push @{$c->stash->{vm}}, [$m,'suspend'];
	}
	$c->_system1(qw(sudo virsh resume), $m);
	sleep 0.1;
	unshift @running, $m;
	return 1;
      }
      elsif ($v[2] eq 'shut') {
	if ($max and @running > $max) {
	  my $r = shift @running;
	  $c->_system1(qw(sudo virsh suspend), $r);
	  push @{$c->stash->{vm}}, [$m,'shutdown'];
	}
	$c->_system1(qw(sudo virsh start), $m);
	sleep 25;
	unshift @running, $m;
	return 1;
      }
      else {
	$c->_fail("vm $m in invalid state $v[2]");
	return;
      }
    }
  }
  $c->debug("vm $m not found");
  return 1;
}

sub _vm_prevstatus {
  my $c = shift;
  my $m = shift or die "_vm_prevstatus missing vm name";
  while (@{$c->stash->{vm}}) {
    my $a = shift @{$c->stash->{vm}};
    return $a->[1] if $a->[0] eq $m;
  }
}

sub _vm_delstatus {
  my $c = shift;
  my $m = shift or die "_vm_delstatus missing vm name";
  my @v = grep {$_->[0] ne $m} @{$c->stash->{vm}};
  $c->stash->{vm} = \@v;
}

=item B<testvm> [OPTIONS] [user@]hostname...

Does C<perlall maketest> in parallel on remote machines.
C<testvm> is only usable within a perl core builddir/srcdir
or in a module rootdir.
It shells out to ssh account(s), copies the files in MANIFEST
to the machine, runs C<perlall maketest> there and copies the
logfiles back.

Specific Options:

    --all|a    - all hosts defined in config C<testvm>
    --up       - only upload (files from local MANIFEST)
    --cmd|c=<remotecmd> any valid perlall command, like
               build, init, makeinstall, smoke. Default: maketest
    --option|o="" remaining remote perlall cmd options and args
    --max|j 4  - how many machines in parallel.
    --fork     - test in parallel and do not wait for the results,
                 just gather logfiles
    --prefix|p=Perl - remote basedir if different to local basedir

Config settings:

    testvm="[user@]hostnames..."
    testvm_prefix=Perl - relative remote basepath of your modules
          i.e. local basename = B-Generate => remote: vmhost:Perl/B-Generate
    testvm_max=4       - balancing, default for -j
    testvm_ctl=virsh   - type of vm ctl: virsh, xen-shell, vmrun, VBoXManage

VM Balancing:

    If the remote hosts are VM's on this machine, you can control how many
    VM's should run in parallel, and how they are started and stopped.

    Currently only C<virsh> is supported to resume a paused vm and start
    a stopped vm. C<--max> is yet ignored.

    If C<testvm_ctl> is not set, no balancing - start+shutdown - will be done,
    such as on physical hosts or enough VM power.
    See F<.perlall>

=cut


sub testvm
  :Help('Test on remote accounts via ssh/rsync (vm or host)')
{
  my $c = shift;
  # testvm has a different option set and allows options after the command
  my $gopts = _opts($c->options);
  $c->addopts( "all|a", "up", "prefix|p=s", "cmd|c=s", "option|o=s",
	       "max|j=n", "fork!" );
  my ($base);
  my @testvm = split / /,$c->config->{testvm_all};
  my @machines = $c->options->{all} ? @testvm : @{$c->argv};
  return "missing args" unless @machines;
  $c->options->{max} = $c->config->{testvm_max} unless $c->options->{max};

  # XXX Expand glob-style machines
  # Idea: - check /etc/hosts so testvm can be empty?
  #       But then we have to check the network for possible machines,
  #       or we want to do all hosts in /etc/hosts?
  #       - check hosts in .ssh/known_hosts
  # XXX check if pwd in core or in a module
  my $opts = _opts($c->options);
  $opts =~ s/$_//  for split/ /,$gopts;
  $gopts = " ".$gopts if $gopts;
  _print(1,"perlall$gopts testvm ".$opts,@machines)
    if $c->options->{verbose};
  $c->_lognew('');
  my $cmd = $c->options->{cmd} || "maketest";
  my $opt = $c->options->{option} ? (' '.$c->options->{option}) : ' -q';
  my $man = 'MANIFEST';