Elaborando una Ejecución Remota

El siguiente programa remotetest.pl copia para cada máquina la distribucion y ejecuta las pruebas en la máquina remota. Forma parte de la distribución GRID::Machine disponible en CPAN.

$ cat -n /usr/local/bin/remotetest.pl
  1  #!/usr/bin/perl -w
  2
  3  eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
  4      if 0; # not running under some shell
  5  use strict;
  6  use GRID::Machine;
  7
  .  ....................................................................
 28
 29  my $dist = shift or die "Usage:\n$0 distribution.tar.gz machine1 machine2 ... \n";
 30
 31  die "No distribution $dist found\n" unless -r $dist;
 32
 33    die "Distribution does not follow standard name convention\n"
 34  unless $dist =~ m{([\w.-]+)\.tar\.gz$};
 35  my $dir = $1;
 36
 37  die "Usage:\n$0 distribution.tar.gz machine1 machine2 ... \n" unless @ARGV;
 38  for my $host (@ARGV) {
 39
 40    my $m = eval {
 41      GRID::Machine->new(host => $host)
 42    };
 43
 44    warn "Cant' create GRID::Machine connection with $host\n", next unless UNIVERSAL::isa($m, 'GRID::Machine');
 45
 46    my $r = $m->eval(q{
 47        our $tmpdir = File::Temp::tempdir;
 48        chdir($tmpdir) or die "Can't change to dir <$tmpdir>\n";
 49      }
 50    );
 51
 52    warn($r),next unless $r->ok;
 53
 54    my $preamble = $host.".preamble.pl";
 55    if (-r $preamble) {
 56      local $/ = undef;
 57
 58      my $code = slurp_file($preamble);
 59      $r = $m->eval($code);
 60      warn("Error in $host preamble: $r"),next unless $r->ok;
 61    }
 62
 63    $m->put([$dist]) or die "Can't copy distribution in $host\n";
 64
 65    $r = $m->eval(q{
 66        my $dist = shift;
 67
 68        eval('use Archive::Tar');
 69        if (Archive::Tar->can('new')) {
 70          # Archive::Tar is installed, use it
 71          my $tar = Archive::Tar->new;
 72          $tar->read($dist,1) or die "Archive::Tar error: Can't read distribution $dist\n";
 73          $tar->extract() or die "Archive::Tar error: Can't extract distribution $dist\n";
 74        }
 75        else {
 76          system('gunzip', $dist) or die "Can't gunzip $dist\n";
 77          my $tar = $dist =~ s/\.gz$//;
 78          system('tar', '-xf', $tar) or die "Can't untar $tar\n";
 79        }
 80      },
 81      $dist # arg for eval
 82    );
 83
 84    warn($r), next unless $r->ok;
 85
 86    $m->chdir($dir)->ok or do {
 87      warn "$host: Can't change to directory $dir\n";
 88      next;
 89    };
 90
 91    print "************$host************\n";
 92    next unless $m->run('perl Makefile.PL');
 93    next unless $m->run('make');
 94    next unless $m->run('make test');
 95
 96    # Clean files
 97    $m->eval( q{
 98      our $tmpdir;
 99      chdir "$tmpdir/..";
100      system ('rm -fR $dir');
101    });
102  }