package RPCStd;
use Msgstd;
use strict;
use Carp;
@RPCStd::ISA = qw(Msgstd);
use FreezeThaw qw(freeze thaw);
#-----------------------------------------------------------------
# Server side
sub new_server {
my ($pkg, $my_host, $my_port) = @_;
return $pkg->SUPER::new_server($my_host, $my_port, sub {$pkg->_login(@_)});
}
sub _login {
my ($pkg, $my_host, $my_port) = @_;
main::login_proc($my_host);
return \&_incoming_msg;
}
sub _incoming_msg {
my ($conn, $msg, $err) = @_;
return if ($err); # Need better error handling.
if ($msg =~ /^$/) {
undef $msg;
}
return unless defined($msg);
my ($dir, $id, @args) = thaw ($msg);
my ($result, @results);
if ($dir eq '>') {
my $gimme = shift @args;
my $sub_name = shift @args;
my ($left, $right) = split(/::/,$sub_name);
$sub_name = $right;
# Incoming msg. (outgoing msg from client, that is)
eval {
no strict 'refs'; # Because we call the subroutine using
# a symbolic reference
if ($gimme eq 'a') { # Want an array back
@results = &{main::cmd_broker} ($conn, $sub_name, @args);
} else {
$result = &{main::cmd_broker} ($conn, $sub_name, @args);
}
};
if ($@) {
$msg = bless \$@, "RPCStd::Error";
$msg = freeze('<', $id, $msg);
} elsif ($gimme eq 'a') {
$msg = freeze('<', $id, @results);
} else {
$msg = freeze('<', $id, $result);
}
$conn->send_later($msg);
} else {
# Response to our message
$conn->{rcvd}->{$id} = \@args;
}
}
#-----------------------------------------------------------------
# Client side
sub connect {
my ($pkg, $host, $port) = @_;
my $conn = $pkg->SUPER::connect($host,$port, \&_incoming_msg);
return $conn;
}
my $send_err = 0;
sub handle_send_err {
$send_err = $!;
}
my $g_msg_id = 0;
sub rpc {
my $conn = shift;
my $subname = shift;
$subname = (caller() . '::' . $subname) unless $subname =~ /:/;
my $gimme = wantarray ? 'a' : 's'; # Array or scalar
my $msg_id = ++$g_msg_id;
my $serialized_msg = freeze ('>', $msg_id, $gimme, $subname, @_);
# Send and Receive
$conn->send_later ($serialized_msg);
if ($send_err) {
die "RPCStd Error: $!\n";
}
do {
Msgstd->event_loop(1); # Dispatch other messages until we get a response
} until (exists $conn->{rcvd}->{$msg_id} || $send_err);
# Dequeue message
my $rl_retargs = delete $conn->{rcvd}->{$msg_id}; # ref to list
if (ref($rl_retargs->[0]) eq 'RPCStd::Error') {
die ${$rl_retargs->[0]};
}
wantarray ? @$rl_retargs : $rl_retargs->[0];
}
1;