view release on metacpan or  search on metacpan

lib/GRID/Machine/REMOTE.pm  view on Meta::CPAN

              stdout => $stdout, 
              stderr => $stderr, 
              result => $result 
            }, 'GRID::Machine::Process';
    $process{$pid} = $p;
    return $p;
  }

  # child

    # admit a single argument of any kind
    my $ar =  $args{args};
    $ar = [ $ar ] unless reftype($ar) and (reftype($ar) eq 'ARRAY');

    my @r = $subref->(@$ar);

    close(STDERR);
    close(STDOUT);

    use Data::Dumper;
    local $Data::Dumper::Indent = 0;
    local $Data::Dumper::Deparse = 1;
    local $Data::Dumper::Purity = 1;
    local $Data::Dumper::Terse = 0;

    open(my $resfile, ">", $result);
    print $resfile Dumper([\@r, \$@]);
    close($resfile);

  exit(0);
}

sub async {
  my $subname = shift;

  # warning potential error. It must be:
  # 'SERVER()->{stored_procedures}{'.$subname.'}{sub}->(@_)', 
  GRID::Machine::fork( "$subname".'(@_)', args => [ @_ ] );
}

sub waitpid #gm (filter => 'result')
{
  my $process = shift;

  $process = $process->result if ($process->isa('GRID::Machine::Result'));

  SERVER->remotelog(Dumper($process));
  #gprint("Synchronizing with $process->{pid} args = <@_>\n");

  my ($status, $deceased);;
  do {
    $deceased = waitpid($process->{pid}, @_ ? @_ : 0);
    $status = $?;

    #gprint("Synchronized: Pid of the deceased process: $deceased\n");
    #gprint("there are processes still running\n") if (!$deceased);

    #SERVER->remotelog("deceased = $deceased");

    #if (kill 0, -$process->{pid}) { gprint("Not answer to 0 signal from process $process->{pid}\n") }
    #else { gprint("Strange: the process $process->{pid} is still alive\n"); }

  } while (kill 0, $process->{pid});

  # if deceased is 0
  # TODO: study flock, may be this way we can synchronize!!

  delete $process{$deceased} if $deceased > 0;

  local $/ = undef;
  open my $fo, $process->{stdout}; # check exists, die, etc.
    my $stdout = <$fo>;
  close($fo);
  CORE::unlink $process->{stdout};

  #gprint("stderr file is: $process->{stderr}\n");
  open my $fe, $process->{stderr}; # or do { SERVER->remotelog("can't open file <$process->{stderr}> $@") }; # check exists, die, etc.
    my $stderr = <$fe>;
  #gprint("stderr is: $stderr\n");
  close($fe);
  CORE::unlink $process->{stderr};

  open my $fr, $process->{result} or do { SERVER->remotelog("can't open file <$process->{stderr}> $@") }; # check exists, die, etc.
    #sleep 1;
    my $result = <$fr>;
    #gprint("result as read from file $process->{result} is  <$result>\n");;
  close($fr);
  CORE::unlink $process->{result};

  $result .= '$VAR1';
  my $val  = eval "no strict; $result";
  #SERVER->remotelog("Errors: '$@'. Result from the asynchronous call: '@$val'");
  
  return bless {
    stdout  => $stdout, 
    stderr  => $stderr, 
    results => $val->[0], 
    status  => $status,    # as in $?
    waitpid => $deceased,  # returned by waitpid
    descriptor => SERVER()->host().':'.$$.':'.$process->{pid},
    machineID  => SERVER()->logic_id,
    errmsg  => ${$val->[1]},  # as $@
  }, 'GRID::Machine::Process::Result';
}

sub waitall #gm (filter => 'result')
{
  my ($status, $deceased);
  do {
    $deceased = CORE::wait();
    $status = $?;

    return $deceased if ($deceased <= 0);
    #gprint("Synchronized: Pid of the deceased process: $deceased\n");
    #gprint("there are processes still running\n") if (!$deceased);

    #SERVER->remotelog("deceased = $deceased");

    #if (kill 0, -$process->{pid}) { gprint("Not answer to 0 signal from process $process->{pid}\n") }
    #else { gprint("Strange: the process $process->{pid} is still alive\n"); }

  } while (kill 0, $deceased);


  # if deceased is 0
  # TODO: study flock, may be this way we can synchronize!!

  my $process = $process{$deceased};
  delete $process{$deceased};

  return $deceased unless $process;

  local $/ = undef;
  open my $fo, $process->{stdout}; # check exists, die, etc.
    my $stdout = <$fo>;
  close($fo);
  CORE::unlink $process->{stdout};

  #gprint("stderr file is: $process->{stderr}\n");
  open my $fe, $process->{stderr}; # or do { SERVER->remotelog("can't open file <$process->{stderr}> $@") }; # check exists, die, etc.
    my $stderr = <$fe>;
  #gprint("stderr is: $stderr\n");
  close($fe);
  CORE::unlink $process->{stderr};

  open my $fr, $process->{result} or do { SERVER->remotelog("can't open file <$process->{stderr}> $@") }; # check exists, die, etc.
    #sleep 1;
    my $result = <$fr>;
    #gprint("result as read from file $process->{result} is  <$result>\n");;
  close($fr);
  CORE::unlink $process->{result};

  $result .= '$VAR1';
  my $val  = eval "no strict; $result";
  #SERVER->remotelog("Errors: '$@'. Result from the asynchronous call: '@$val'");
  
  return bless {
    stdout  => $stdout, 
    stderr  => $stderr, 
    results => $val->[0], 
    status  => $status,    # as in $?
    waitpid => $deceased,  # returned by waitpid
    descriptor => SERVER()->host().':'.$$.':'.$process->{pid},
    machineID  => SERVER()->logic_id,
    errmsg  => ${$val->[1]},  # as $@
  }, 'GRID::Machine::Process::Result';
}

sub kill { #gm (filter => 'result')
  my $signal = shift;

  CORE::kill $signal, @_;
}

sub poll { #gm (filter => 'result')
  CORE::kill 0, @_;
}


1;