1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
#!/usr/bin/perl -w
# $Id: client.pl,v 1.4 2005/12/18 14:01:13 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2005 Jrn Reder <joern AT zyn.de>.
# All Rights Reserved. See file COPYRIGHT for details.
#
# This module is part of Event::RPC, which is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#-----------------------------------------------------------------------
use strict;
use lib 'lib';
use lib qw(../lib);
use Event::RPC::Client;
use Getopt::Std;
my $USAGE = <<__EOU;
Usage: client.pl [-s] [-a user:pass]
Description:
Event::RPC client demonstration program. Execute this from
the distribution's base or examples/ directory after starting
the correspondent examples/server.pl program.
Options:
-s Use SSL encryption
-a user:pass Pass this authorization data to the server
-h host Server hostname. Default: localhost
__EOU
sub HELP_MESSAGE {
my ($fh) = @_;
$fh ||= \*STDOUT;
print $fh $USAGE;
exit;
}
main: {
my %opts;
my $opts_ok = getopts('h:l:a:s',\%opts);
HELP_MESSAGE() unless $opts_ok;
my $ssl = $opts{s} || 0;
my %auth_args;
if ( $opts{a} ) {
my ($user, $pass) = split(":", $opts{a});
$pass = Event::RPC->crypt($user,$pass);
%auth_args = (
auth_user => $user,
auth_pass => $pass,
);
}
#-- Host parameter
my $host = $opts{h} || 'localhost';
#-- This connects to the server, requests the exported
#-- interfaces and establishes correspondent proxy methods
#-- in the correspondent packages.
my $client;
$client = Event::RPC::Client->new (
host => $host,
port => 5555,
ssl => $ssl,
%auth_args,
error_cb => sub {
my ($client, $error) = @_;
print "An RPC error occured: $_[0]";
print "Disconnect and exit.\n";
$client->disconnect if $client;
exit
},
classes => [ "Test_class" ],
);
$client->connect;
print "\nConnected to localhost:5555\n\n";
print "Server version: ".$client->get_server_version,"\n";
print "Server protocol: ".$client->get_server_protocol,"\n\n";
#-- So the call to Event::RPC::Test->new is handled transparently
#-- by Event::RPC::Client
print "** Create object on server\n";
my $object = Test_class->new (
data => "Initial data",
);
print "=> Object created with data: '".$object->get_data."'\n\n";
#-- and methods calls as well...
print "** Say hello to server.\n";
print "=> Server returned: >>".$object->hello,"<<\n";
print "\n** Update object data.\n";
$object->set_data ("Yes, updating works");
print "=> Retrieve data from server: '".$object->get_data."'\n";
print "\n** Disconnecting\n\n";
$client->disconnect;
}
|
