[xmlblaster-devel] patch to perl/xmlrpc/server.pl

[Jason Martin <jhmartin at toger.us>]

The attached patch to the latest CVS version of 
/opt/cvsroot/xmlBlaster/demo/perl/xmlrpc/server.pl,v makes the
following changes:

* Print out Header / Messages / Qos of update messages.
* Add a retries and delay option to the subscribe/callback tag to reduce
the chance xmlblaster will attempt to ping the callback server
before it is created and thus unsubscribe it.
* Add ReuseAddr => 1 to the Frontier::Daemon invocation to
prevent "Address already in use" errors due to TIME_WAIT's when
the script is killed and restarted quickly.
* Print out an error message if the xmlrpc server does not start
properly.
* Add commenting for the above.

-Jason Martin

-- 
Dumb luck beats sound planning every time. Trust me.
This message is PGP/MIME signed.

Index: server.pl
===================================================================
RCS file: /opt/cvsroot/xmlBlaster/demo/perl/xmlrpc/server.pl,v
retrieving revision 1.5
diff -u -r1.5 server.pl
--- server.pl	21 May 2003 20:20:46 -0000	1.5
+++ server.pl	30 Aug 2004 02:10:46 -0000
 at  at  -3,7 +3,9  at  at 
 # Perl callback server example, xmlBlaster.org
 #  at author David Kelly davidk at navahonetworks.com
 #  at author Russell Chan russ at navahonetworks.com
+use strict;
 
+use MIME::Base64;
 use Frontier::Daemon;
 use Frontier::Client;
 use xmlBlaster::Exception ;
 at  at  -13,7 +15,12  at  at 
 
 
 sub do_update {
-        print "Received update ...\n";
+        print "***\nReceived update ...\n";
+        print "Header:" . $_[1] . "\n";
+        print "Message:" .decode_base64($_[2]->value) . "\n";
+        print "QoS:". $_[3] . "\n***\n";
+
+# Acknowledge receipt of the update
         return "<qos><state>OK</state></qos>";
 }
 
 at  at  -29,8 +36,10  at  at 
 print "Connected to xmlBlaster server on $server_url \n";
 
 # Call the remote server and get our result.
+# Retries and delay set to cover a race between subscribing and
+# xmlBlaster attempting to communicate with the xmlrpc server created below.
 my $sessionId = $server->call('authenticate.login', "dk2", "dk2",
-                "<qos><callback type='XMLRPC'>$local_url</callback>".
+                "<qos><callback type='XMLRPC' retries='2' delay='2000'>$local_url</callback>".
                 "<local>false</local></qos>", "");
 print "\nLogin success with sessionId=$sessionId \n";
 
 at  at  -39,10 +48,15  at  at 
                          "<key oid='' queryType='XPATH'>//service</key>",
                         "<qos><duplicateUpdates>false</duplicateUpdates></qos>");
 
-Frontier::Daemon->new(
+# ReuseAddr is an option to the IO::Socket class of which Frontier::Daemon is a
+# subclass.  It prevents an 'Address already in use' error that occurs when this
+# script is interrupted and restarted quickly.
+my $result = Frontier::Daemon->new(
+	    ReuseAddr => 1,
             LocalPort => 9091,
             methods => {
                         'update'   => \&do_update,
                         'ping'   => \&do_ping
             });
 
+die "Unable to spawn daemon: $!" unless $result;

Attachment: pgpOPa5dkHPne.pgp
Description: PGP signature