1 #!/usr/bin/perl -w
2
3 # Perl callback server example, xmlBlaster.org
4 # @author David Kelly <davidk@navahonetworks.com>
5 # @author Russell Chan <russ@navahonetworks.com>
6 # @author Jason Martin <jhmartin@toger.us>
7 use strict;
8
9 use MIME::Base64;
10 use Frontier::Daemon;
11 use Frontier::Client;
12 use xmlBlaster::Exception ;
13 use xmlBlaster::XmlBlaster ;
14 use xmlBlaster::MsgUnit ;
15 use xmlBlaster::EraseReturnQos ;
16
17
18 sub do_update {
19 print "***\nReceived update ...\n";
20 print "Header:" . $_[1] . "\n";
21 print "Message:" .decode_base64($_[2]->value) . "\n";
22 print "QoS:". $_[3] . "\n***\n";
23
24 # Acknowledge receipt of the update
25 return "<qos><state>OK</state></qos>";
26 }
27
28 sub do_ping {
29 print "Received ping ...\n";
30 return "<qos><state>OK</state></qos>";
31 }
32
33 my $local_url="http://127.0.0.1:9091/RPC2";
34 my $server_url=$ARGV[0];
35
36 my $server = Frontier::Client->new(url => $server_url);
37 print "Connected to xmlBlaster server on $server_url \n";
38
39 # Call the remote server and get our result.
40 # Retries and delay set to cover a race between subscribing and
41 # xmlBlaster attempting to communicate with the xmlrpc server created below.
42 my $sessionId = $server->call('authenticate.login', "dk2", "dk2",
43 "<qos><callback type='XMLRPC' retries='2' delay='2000'>$local_url</callback>".
44 "<local>false</local></qos>", "");
45 print "\nLogin success with sessionId=$sessionId \n";
46
47 $server->call('xmlBlaster.subscribe',
48 $sessionId,
49 "<key oid='' queryType='XPATH'>//service</key>",
50 "<qos><duplicateUpdates>false</duplicateUpdates></qos>");
51
52 # ReuseAddr is an option to the IO::Socket class of which Frontier::Daemon is a
53 # subclass. It prevents an 'Address already in use' error that occurs when this
54 # script is interrupted and restarted quickly.
55 my $result = Frontier::Daemon->new(
56 ReuseAddr => 1,
57 LocalPort => 9091,
58 methods => {
59 'update' => \&do_update,
60 'ping' => \&do_ping
61 });
62
63 die "Unable to spawn daemon: $!" unless $result;
syntax highlighted by Code2HTML, v. 0.9.1