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__