Throwing Shapes
by Vladi Belperchinov-Shabanski
|
Pages: 1, 2, 3
Point of No Return
Enough background. Here's the PerlRC implementation of the server:
use Storable qw( thaw nfreeze );
use IO::Socket::INET;
# function table, maps caller names to actual server subs
our %FUNC_MAP = (
power => \&power,
range => \&range,
tree => \&tree,
);
# create listen socket
my $sr = IO::Socket::INET->new( Listen => 5,
LocalAddr => 'localhost:9999',
ReuseAddr => 1 );
while(4)
{
# awaiting connection
my $cl = $sr->accept() or next; # accept new connection or loop on error
while( my $req = <$cl> ) # read request data, exit loop on empty request
{
chomp( $req );
my $thaw = thaw( r_unescape( $req ) ); # 'unpack' request data (\n unescape)
my %req = %{ $thaw || {} }; # copy to local hash
my %res; # result data
my $func = $FUNC_MAP{ $req{ 'NAME' } }; # find required function
if( ! $func ) # check if function exists
{
# function name is not found, return error
$res{ 'ERROR' } = "No such function: " . $req{ 'NAME' };
}
else
{
# function exists, proceed with execution
my @args = @{ $req{ 'ARGS' } }; # copy to local arguments hash
if( $req{ 'WANTARRAY' } ) # depending on the required context...
{
my @ret = &$func( @args ); # call function in array context
$res{ 'RET_ARRAY' } = \@ret; # return array
}
else
{
my $ret = &$func( @args ); # call function in scalar context
$res{ 'RET_SCALAR' } = $ret; # return scalar
}
}
my $res = r_escape( nfreeze( \%res ) ); # 'pack' result data (\n escape)
print $cl "$res\n"; # send result data to the client
}
}The client side is also simple:
use Storable qw( thaw nfreeze );
use IO::Socket::INET;
# connect to the server
my $cl = IO::Socket::INET->new( PeerAddr => "localhost:9999" )
or die "connect error\n";
# this is interface sub to calling server
sub r_call
{
my %req; # request data
$req{ 'NAME' } = shift; # function name to call
$req{ 'WANTARRAY' } = wantarray ? 1 : 0; # context hint
$req{ 'ARGS' } = \@_; # arguments
my $req = r_escape( nfreeze( \%req ) ); # 'pack' request data (\n escape)
print $cl "$req\n"; # send to the server
my $res = <$cl>; # get result line
chomp( $res );
my $thaw = thaw( r_unescape( $res ) ); # 'unpack' result (\n unescape)
my %res = %{ $thaw || {} }; # copy result data to local hash
# server error -- break execution!
die "r_call: server error: $res{'ERROR'}\n" if $res{ 'ERROR' };
# finally return result in the required context
return wantarray ? @{ $res{ 'RET_ARRAY' } } : $res{ 'RET_SCALAR' };
}On both sides there are two very simple functions that escape and unescape
newline chars. This is necessary to prevent serialized data that contains
newline chars from breaking the chosen packet terminator. (A newline works
well there because it interacts well with the readline() operation
on the socket.)
sub r_escape
{
my $s = shift;
# replace all newlines, CR and % with CGI-style encoded sequences
$s =~ s/([%\r\n])/sprintf("%%%02X", ord($1))/ge;
return $s;
}
sub r_unescape
{
my $s = shift;
# convert back escapes to the original chars
$s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
return $s;
}Waiting In The Wings
That's the client and server. Now they need to do something useful. Here's some code to run on the server from a client:
=head2 power()
arguments: a number (n) and power (p)
returns: the number powered (n**p)
=cut
sub power
{
my $n = shift;
my $p = shift;
return $n**$p;
}
=head2 range( f, t )
arguments: lower (f) and upper indexes (t)
returns: array with number elements between the lower and upper indexes
( f .. t )
=cut
sub range
{
my $f = shift;
my $t = shift;
return $f .. $t;
}
=head2 tree()
arguments: none
returns: in scalar context: hash reference to data tree
in array context: hash (array) of data tree
usage:
$data = tree(); $data->{ ... }
%data = tree(); $data{ ... }
=cut
sub tree
{
my $ret = {
this => 'is test',
nothing => [ qw( ever goes as planned ) ],
number_is => 42,
};
return wantarray ? %$ret : $ret;
}To make these available to clients, the server must have a map of functions. It's easy:
# function table, maps caller names to actual server subs
our %FUNC_MAP = (
power => \&power,
range => \&range,
tree => \&tree,
);That's all of the setup for the server. Now you can start it.
The client side calls functions in this way:
r_call( 'test', 1, 2, 3, 'opa' ); # this will receive 'not found' error
my $r = r_call( 'power', 2, 8 ); # $r = 256
my @a = r_call( 'range', 12, 18 ); # @a = ( 12, 13, 14, 15, 16, 17, 18 )
my %t = r_call( 'tree' ); # returns data as hash
my $t = r_call( 'tree' ); # returns data as reference
print( "Tree is:\n" . Dumper( \%t ) );
# this will print:
Tree is:
$VAR1 = {
'number_is' => 42,
'nothing' => [
'ever',
'goes',
'as',
'planned'
],
'this' => 'is test'
};
# and will be the same as
print( "Tree is:\n" . Dumper( $t ) );
