view release on metacpan or  search on metacpan

lib/IPC/PerlSSH.pm  view on Meta::CPAN

   my $self = shift;
   my ( $data ) = @_;

   $self->{writefunc}->( $data );
}

sub read_message
{
   my $self = shift;

   my ( $message, @args );

   while( !defined $message ) {
      my $b;
      $self->{readfunc}->( $b, $READLEN ) or return ( "CLOSED" );
      $self->{readbuff} .= $b;
      ( $message, @args ) = $self->parse_message( $self->{readbuff} );
   }

   return ( $message, @args );
}

=head1 METHODS

=cut

=head2 eval

   @result = $ips->eval( $code, @args )

This method evaluates code in the remote host, passing arguments and returning
the result.

The code should be passed in a string, and is evaluated using a string
C<eval> in the remote host, in list context. If this method is called in
scalar context, then only the first element of the returned list is returned.

If the remote code threw an exception, then this function propagates it as a
plain string. If the remote process exits before responding, this will be
propagated as an exception.

=cut

sub eval
{
   my $self = shift;
   my ( $code, @args ) = @_;

   $self->write_message( "EVAL", $code, @args );

   my ( $ret, @retargs ) = $self->read_message;

   if( $ret eq "RETURNED" ) {
      # If the caller didn't want an array and we received more than one result
      # from the far end; we'll just have to throw it away...
      return wantarray ? @retargs : $retargs[0];
   }
   elsif( $ret eq "DIED" ) {
      my ( $message ) = @retargs;
      if( $message =~ m/^While compiling code:.* at \(eval \d+\) line (\d+)/ ) {
         $message .= " ==> " . (split m/\n/, $code)[$1 - 1] . "\n";
      }
      die "Remote host threw an exception:\n$message";
   }
   elsif( $ret eq "CLOSED" ) {
      die "Remote connection closed\n";
   }
   else {
      die "Unknown return result $ret\n";
   }
}

=head2 store

   $ips->store( $name, $code )

   $ips->store( %funcs )

This method sends code to the remote host to store in named procedure(s) which
can be executed later. The code should be passed in strings.

While the code is not executed, it will still be compiled into CODE references
in the remote host. Any compile errors that occur will be throw as exceptions
by this method.

Multiple functions may be passed in a hash, to reduce the number of network
roundtrips, which may help latency.

=cut

sub store
{
   my $self = shift;
   my %funcs = @_;

   foreach my $name ( keys %funcs ) {
      $self->_has_stored_code( $name ) and croak "Already have a stored function called '$name'";
   }

   $self->write_message( "STORE", %funcs );

   my ( $ret, @retargs ) = $self->read_message;

   if( $ret eq "OK" ) {
      $self->{stored}{$_} = 1 for keys %funcs;
      return;
   }
   elsif( $ret eq "DIED" ) {
      my ( $message ) = @retargs;
      if( $message =~ m/^While compiling code for (\S+):.* at \(eval \d+\) line (\d+)/ ) {
         my $code = $funcs{$1};
         $message .= " ==> " . (split m/\n/, $code)[$2 - 1] . "\n";
      }
      die "Remote host threw an exception:\n$message";
   }
   elsif( $ret eq "CLOSED" ) {
      die "Remote connection closed\n";
   }
   else {
      die "Unknown return result $ret\n";
   }
}

sub _has_stored_code
{
   my $self = shift;
   my ( $name ) = @_;
   return exists $self->{stored}{$name};
}

=head2 bind

   $ips->bind( $name, $code )

This method is identical to the C<store> method, except that the remote
function will be available as a plain function within the local perl
program, as a function of the given name in the caller's package.

=cut

sub bind
{
   my $self = shift;
   my ( $name, $code ) = @_;

   $self->store( $name, $code );

   my $caller = (caller)[0];
   {
      no strict 'refs';
      *{$caller."::$name"} = sub { $self->call( $name, @_ ) };
   }
}

=head2 call

   @result = $ips->call( $name, @args )

This method invokes a remote method that has earlier been defined using the
C<store> or C<bind> methods. The arguments are passed and the result is
returned in the same way as with the C<eval> method.

If an exception occurs during execution, it is propagated and thrown by this
method. If the remote process exits before responding, this will be propagated
as an exception.

=cut

sub call
{
   my $self = shift;
   my ( $name, @args ) = @_;