# -*- cperl -*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) use Test::More tests => 5 ; use ExtUtils::testlib ; BEGIN { use_ok ('RPC::Simple')} ; use ExtUtils::testlib ; use strict; use warnings; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): package MyLocal ; # MyLocal inherits from RPC::Simple::AnyLocal and is used # to dispatch all calls in the @RPC_SUB array to the remote # object created with a call to createRemote(). use vars qw($VERSION @ISA @RPC_SUB $tempObj) ; @ISA = qw(RPC::Simple::AnyLocal); # We must define our remote methods here, if we do not then # AnyLocall will not dispatch the method call to the remote # RPC server. @RPC_SUB = qw(close remoteHello remoteAsk); sub new { my $type = shift ; my $self = {} ; print "creating $type\n"; my $remote = shift ; bless $self,$type ; # Essentially call MyRemote->new() on the remote RPC server $self->createRemote($remote,'t::RealMyLocal.pm') ; return $self ; } # this routine is known by the remote class and is actually called by it sub implicitAnswer { my $self = shift ; my $result = shift ; print "implicit answer is $result\n" ; } # this routine is not knwon from the remote class and will be called only # by the call-back mechanism. sub answer { my $self = shift ; my $result = shift ; print "answer is $result\n" ; } package main ; use RPC::Simple::Server ; use RPC::Simple::Factory ; use IO::Socket ; use IO::Select ; my $arg = shift ; my $clientPid ; my $verbose = 0 ; # you may change this value to see RPC traffic # Either spawn/fork and enter the mainLoop or go directly # into the mainLoop if (not defined $arg or $arg eq '-i') { my $pid = &spawn(undef,$verbose) ; # spawn server } elsif ($arg eq '-s') { RPC::Simple::Server::mainLoop (undef,$verbose) ; } ok(1,"server spawned") ; # client part # Create a connection to the RPC Server on localhost, use the # remote_host argument for Factory->new() when connecting to # a remote server. my $factory = new RPC::Simple::Factory(verbose_ref => \$verbose) ; ok($factory, "Factory created") ; # Create the MyLocal object, which will connect to the RPC server # and call new on the remote object. my $local = new MyLocal($factory) ; ok($local,"Local object created" ) ; # Very simple, now we just execute the remoteAsk method on the # remote object. $local->remoteAsk(callback => 'answer'); my $selector = IO::Select->new(); $selector->add($factory->getSocket()); # Wait for a response from the remote call, and use readSock # to execute the callback. my ($toRead, undef, undef) = IO::Select->select($selector, undef, $selector, 10); foreach my $fh (@$toRead) { if($fh == $factory->getSocket()) { $factory->readSock(); } } ok(1); exit;