The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use File::Temp;
use File::Spec;

sub getcwd { return getcwd() }

sub getpid #gm ( filter => 'result')
{
  $$;
}

sub chdir  { 
 my $dir = shift || $ENV{HOME};
 return chdir($dir) 
}

sub unlink  { 
 my @files = @_;

 return unless @files;
 return unlink(@files) 
}

sub mark_as_clean {
  my %arg = @_;
  my $files = $arg{files} || [];
  my $dirs  = $arg{dirs} || [];

  if (@$files) {
    # make them absolute paths
    my @absfiles = map { abs_path($_) } @$files;
    push @{SERVER()->cleanfiles}, @absfiles;
  }
  if (@$dirs) {
    my @absdirs = map { abs_path($_) } @$dirs;
    push @{SERVER()->cleandirs}, @absdirs;
  }
}

sub wrapexec {
  my $exec = shift;

  my $dir = getcwd;
  my $program =<< 'EOPROG'; 
chdir "<<$dir>>" || die "Can't change to dir <<$dir>>\n";
%ENV = (<<$ENV>>);
$| = 1;
my $success = !system("<<$exec>>");
warn "GRID::Machine::Core::wrapexec warning!. Execution of '<<$exec>>' returned Status: '$?'. Success value from system call: '$success'\n" unless $success;
unlink('<<$scriptname>>');
exit(0);
EOPROG

  $exec =~ /^\s*(\S+)/; # mmm.. no options?
  my $execname = $1;
  # Executable can be in any place of the PATH search 
  my $where = `which $execname 2>&1`;

  # skip if program 'which' can't be found otherwise check that $execname exists
  unless ($?) {
    die "Error. Can't find executable for command '$execname'. Where: '$where'\n" unless  $execname && $where =~ /\S/;
  }

  # name without path
  my ($name) = $execname =~ m{([\w.]+)$};
  $name ||= '';

  my $ENV = "'".(join "',\n  '", %ENV)."'";

  # Create a temp perl script with pattern /tmp/gridmachine_driver_${name}XXXXX
  my $filename = "gridmachine_driver_${name}";
  my $tmp = File::Temp->new( TEMPLATE => $filename.'XXXXX', DIR => File::Spec->tmpdir(), UNLINK => 0);
  my $scriptname = $tmp->filename;

  $program =~ s/<<\$dir>>/$dir/g;
  $program =~ s/<<\$ENV>>/$ENV/g;
  $program =~ s/<<\$exec>>/$exec/g;
  $program =~ s/<<\$scriptname>>/$scriptname/g;

  print($tmp $program) or die "Can't create script $scriptname";

  #push @{SERVER->cleanfiles}, $scriptname; # unless shift();
  close($tmp) or die "Can't close file $scriptname";

  return $scriptname;
}

sub umask  { 
 my $umask = shift;
 return umask($umask) if defined($umask);
 return umask();
}

sub mkdir  { 
 my $dir = shift or die "mkdir needs an argument\n";
 my $mask = shift;
 return mkdir($dir) unless defined($mask);
 return mkdir($dir, $mask);
}

sub system {
  my $program = shift;

  my $r = CORE::system($program, @_);
  SERVER->remotelog("system '$program @_' executed \$?= $?, \$\@ = '$@', ! = '$!'");
  $r;
  #return $?
}

sub qqx {
  my $wantarray = shift,
  my $sep = shift;
  my $program = shift;

  local $/ = $sep;
  return `$program` if $wantarray;
  scalar(`$program`);
}


sub slurp {
  my $filename = shift;

  local $/ = undef;

  open(my $f, "<", $filename) or die "Can't find file '$filename'\n";

  return scalar(<$f>);
}

sub glob {
  my $spec = shift;

  return glob($spec);
}

sub tar {
  my $file = shift;
  my $options = shift;

  CORE::system('tar', $options, ,'-f', $file);
  return $?
}

sub uname {
  use POSIX;
  return POSIX::uname();
}

sub version {
  my $module = shift;
  my $out = `$^X -M$module -e 'print $module->VERSION'`;
}

sub installed {
  my $module = shift;

  !CORE::system("$^X -M$module -e 0");
}

sub _stat {
  my $filehandle = shift;
 
  return stat($filehandle) if defined($filehandle);
  return stat();
}

LOCAL {
  for (qw(r w e x z s f d  t T B M A C)) {
    SERVER->sub( "_$_" => qq{
        my \$file = shift;

        return -$_ \$file;
      }
    );
  }
}

__END__