< linux网络编程工具>>配套源码

				程序清单17-14：server_rpc.pl
				sub new_server {
				    my ($pkg, $my_host, $my_port) = @_;
				    $pkg->SUPER::new_server($my_host, $my_port, 
				                            sub {$pkg->_login(@_)});
				}
				sub _login {
				    \&_incoming_msg;
				}
				sub _incoming_msg {
				    my ($conn, $msg, $err) = @_;
				    return if ($err);   # Need better error handling.
				    return unless defined($msg);
				    my ($dir, $id, @args) = thaw ($msg);
				    my ($result, @results);
				    if ($dir eq '>') {
				        # New request message
				        my $gimme = shift @args;
				        my $sub_name = shift @args;
				        eval {
				            no strict 'refs';  # 因为使用符号引用来调用这个子程序
				                               # 希望返回一个数组
				            if ($gimme eq 'a') {  # Want an array back
				                @results = &{$sub_name} (@args); 
				            } else {
				                $result = &{$sub_name} (@args);
				            }
				        };
				        if ($@) {
				            $msg = bless \$@, "RPC::Error";
				            $msg = freeze('				        } elsif ($gimme eq 'a') {
				            $msg = freeze('				        } else {
				            $msg = freeze('				        }
				        $conn->send_later($msg);
				    } else {
				        # Response to a message we had sent out earlier
				        $conn->{rcvd}->{$id} = \@args;
				    }
				}