File Coverage

blib/lib/RPC/Simple/Agent.pm

Criterion	Covered	Total	%
statement	51	62	82.2
branch	3	6	50.0
condition			n/a
subroutine	10	11	90.9
pod	6	7	85.7
total	70	86	81.4

package RPC::Simple::Agent;

use strict;
use vars qw($VERSION);

use RPC::Simple::Factory ;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

( $VERSION ) = '$Revision: 1.7 $ ' =~ /\$Revision:\s+([^\s]+)/;

# Preloaded methods go here.

# connection is opened, ask for a remote object
sub new
  {
    my $type = shift ;
    my $factoryObj = shift ;       # factory
    my $clientRef = shift;
    my $index  = shift ;
    my $remoteClass = shift ; # may be undef

    my $self={} ;
    $self->{'idx'} = $index ;

    $self->{requestId} = 0 ;

    $self->{'factory'} = $factoryObj ;
    $self->{remoteHostName} = $factoryObj->getRemoteHostName() ;

    unless (defined $remoteClass)
      {
        $remoteClass = ref($clientRef) ;
        $remoteClass =~ s/(\w+)$/Real$1/ ;
      }

    print "Creating $type for $remoteClass\n";

    $self->{'clientObj'}= $clientRef ;

    # store call-back info
    $self->{callback}{$self->{requestId}} = sub{ $self->remoteCreated(@_)} ;
    my $id = $self->{requestId}++ ;

    $factoryObj->writeSockBuffer($index, 'new', $id , [ @_ ], $remoteClass ) ;

    $self->{remoteClass} = $remoteClass ;
    bless $self, $type ;
  }

sub destroy
  {
    my $self = shift ;
    print "RPC::Simple::Agent destroyed\n";
    $self->{factory}->destroyRemoteObject($self->{'idx'});

    # We need to undef the factory and clientObj references
    # because they create a circular reference and we can not
    # destroy the factory or the clientObj
    undef $self->{factory};
    undef $self->{clientObj};
  }

sub delegate
  {
    # delegate to remote
    my $self = shift ;
    my $method = shift ;
    my $id ;

    if (ref($_[0]) eq 'CODE')
      {
        # callback required
        $self->{callback}{$self->{requestId}} = shift ; # store call-back info
        $id = $self->{requestId}++ ;
      }

    $self->{'factory'}->writeSockBuffer($self->{'idx'},$method, $id,[ @_]) ;
  }

sub remoteCreated
  {
    my $self = shift ;
    my $result = shift ;
    my $failStr = shift ;

    if ($result)
      {
        print "Remote class $self->{remoteClass} created\n";
        return ;
      }

    print "Failed to create remote class $self->{remoteClass}\n",$failStr;
    undef $self->{clientObj} ;
  }

sub callMethod
  {
    my $self = shift ;
    my $method = shift ;
    my $args = shift ;
    $self->{clientObj} -> $method (@$args) ;
  }

sub getRemoteHostName
  {
    my $self = shift ;
    return $self->{'remoteHostName'} ;
  }

sub treatCallBack
  {
    my $self = shift ;
    my $reqId = shift ;
    my $args = shift ;

    my $cbRef = $self->{callback}{$reqId} ;

    &$cbRef(@$args);

    delete $self->{callback}{$reqId} ;
  }


# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__