r2572 - in packages: . libevent-rpc-perl libevent-rpc-perl/branches libevent-rpc-perl/branches/upstream libevent-rpc-perl/branches/upstream/current libevent-rpc-perl/branches/upstream/current/examples libevent-rpc-perl/branches/upstream/current/examples/ssl libevent-rpc-perl/branches/upstream/current/lib libevent-rpc-perl/branches/upstream/current/lib/Event libevent-rpc-perl/branches/upstream/current/lib/Event/RPC libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop libevent-rpc-perl/branches/upstream/current/t libevent-rpc-perl/branches/upstream/current/t/ssl

gregor herrmann gregoa-guest at costa.debian.org
Sat Apr 15 18:15:24 UTC 2006


Author: gregoa-guest
Date: 2006-04-15 18:15:22 +0000 (Sat, 15 Apr 2006)
New Revision: 2572

Added:
   packages/libevent-rpc-perl/
   packages/libevent-rpc-perl/branches/
   packages/libevent-rpc-perl/branches/upstream/
   packages/libevent-rpc-perl/branches/upstream/current/
   packages/libevent-rpc-perl/branches/upstream/current/Changes
   packages/libevent-rpc-perl/branches/upstream/current/MANIFEST
   packages/libevent-rpc-perl/branches/upstream/current/META.yml
   packages/libevent-rpc-perl/branches/upstream/current/Makefile.PL
   packages/libevent-rpc-perl/branches/upstream/current/README
   packages/libevent-rpc-perl/branches/upstream/current/examples/
   packages/libevent-rpc-perl/branches/upstream/current/examples/Test_class.pm
   packages/libevent-rpc-perl/branches/upstream/current/examples/client.pl
   packages/libevent-rpc-perl/branches/upstream/current/examples/server.pl
   packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/
   packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.crt
   packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.csr
   packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.key
   packages/libevent-rpc-perl/branches/upstream/current/lib/
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/AuthPasswdHash.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Client.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Connection.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/LogConnection.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Logger.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Event.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Glib.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Message.pm
   packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Server.pm
   packages/libevent-rpc-perl/branches/upstream/current/t/
   packages/libevent-rpc-perl/branches/upstream/current/t/01.use.t
   packages/libevent-rpc-perl/branches/upstream/current/t/02.cnct.t
   packages/libevent-rpc-perl/branches/upstream/current/t/03.cnct-auth.t
   packages/libevent-rpc-perl/branches/upstream/current/t/04.cnct-auth-ssl.t
   packages/libevent-rpc-perl/branches/upstream/current/t/05.func.t
   packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test.pm
   packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test_Server.pm
   packages/libevent-rpc-perl/branches/upstream/current/t/ssl/
   packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.crt
   packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.csr
   packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.key
   packages/libevent-rpc-perl/tags/
Log:
[svn-inject] Installing original source of libevent-rpc-perl

Added: packages/libevent-rpc-perl/branches/upstream/current/Changes
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/Changes	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/Changes	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,137 @@
+$Id: Changes,v 1.13 2006/03/27 19:55:16 joern Exp $
+
+Revision history and release notes for Event::RPC:
+
+0.89 Mon Mar 27, 2006, joern
+    Features:
+    - New class_map attribute for Event::RPC::Client to be
+      able to use classes locally which are imported from the
+      server as well, by giving the server classes a different
+      name on the client.
+    - Turn execptions of unregistered object access into
+      warnings, which makes client / server communication
+      more robust and debugging easier.
+
+    Bugfixes:
+    - Fixed crashing when a method declared as an object
+      returner returned undef, which should be absolutely
+      legal.
+    - Fixed client side exceptions if server connection is
+      unexpectedly interrupted during a remote method call.
+    - Exceptions are now stringified before send to the
+      client, otherwise Storable may complain on exception
+      objects which can't be freezed e.g. due to embedded
+      code refs.
+
+0.88 Sat Dec 24, 2005, joern
+    Bugfixes:
+    - Use Storable::nfreeze() to pack network messages, so
+      Event::RPC works with mixed endian architectures
+      as well. Patch by Rolf Grossmann <rg AT PROGTECH.net>.
+
+0.87 Sun Dec 18, 2005, joern
+    Features:
+    - Delegation of authentication resp. user/password check
+      to an external module via Event::RPC::Server attribute
+      "auth_module". Old passwd hash based model is implemented
+      in Event::RPC::AuthPasswdHash.
+    - Fixed a typo in Event::RPC::Looger manpage. Thanks to
+      Sean <soso AT kol.co.nz> for the report.
+    - Cleaned up examples/: server.pl and client.pl now both
+      accept -h option for binding/connecting to a specific
+      host, not just localhost.
+    - Makefile.PL tuning: add detected optional modules to
+      PREREQ_PM to get their version numbers added to CPAN
+      Testers reports.
+
+    Bugfixes:
+    - ChangeLog entry 0.86 was wrong regarding the SSL stuff.
+
+0.86 Sat Dec 17, 2005, joern
+    Features:
+    - added Event::RPC::Server->get_active_connection
+    - documented Event::RPC::Connection->get_client_oids
+    - added Event::RPC::Connection->get_client_object
+
+    Bugfixes:
+    - Added missing documentation for Event::RPC::Client's
+      error_cb attribute, which was just mentioned in
+      the SYNPOSIS.
+    - Fixed an incompatability with IO::Socket::SSL 0.97,
+      which doesn't return different sysread() states for
+      error and eof anymore which confused Event::RPC.
+
+0.85 Sun Aug 28, 2005, joern
+    Bugfixes:
+    - Make server more bullet proof: handle log connections
+      even if no logger is set, but a log listener was started.
+    - Event::RPC::Server->new didn't recognize the
+      'connection_hook' parameter.
+    - Try making the testsuite more stable with Win32.
+
+0.84 Mon Jul 25, 2005, joern
+    Bugfixes:
+    - Buffering for big incoming RPC requests (> 64KB) didn't
+      work properly
+
+0.83 Fri Apr 15, 2005, joern
+    Features:
+    - Made more parts of the API public by documenting them.
+    - New server option "connection_hook" for accessing
+      Event::RPC::Connection objects during connecting and
+      disconnecting.
+    - New server option "auto_reload_modules" to control the
+      server's auto reloading facility, which was activated
+      by default up to now.
+    - New server option "host" to bind the listener to a
+      specific address. Default is to bind to all addresses.
+    - Increased connect performance by reducing the number
+      of messages exchanged between client and server.
+    - Client may request a subset of exported server classes.
+      Default is still to import all classes exported by the
+      server.
+    - Client checks Event::RPC version and used protocol version
+      on connect and warns different software versions but dies
+      on incompatible protocol versions. Naturally it's
+      recommended to use the same Event::RPC version on server
+      and client.
+    - Methods for getting client and server (after connecting)
+      software and protocol version numbers.
+
+    Bugfixes:
+    - Missed ReuseAddr on listener sockets.
+    - Made testsuite more robust
+    - Network logging clients could block the server by
+      sending data to it.
+    - Renamed client option 'server' to 'host', which is more
+      adequate. 'server' is still allowed but deprecated and
+      using it triggers a warning.
+
+0.82 Sun Apr 10, 2005, joern
+    Notes:
+    - First public release. API is fairly stable.
+
+    Features:
+    - User/password based authentication added.
+    - Full documentation added.
+    - Test suite added which covers all connection
+      types and the most important features.
+
+0.81 Sun Mar 13, 2005, joern
+    Notes:
+    - Still an internal release, incomplete documentation, no
+      test suite.
+
+    Features:
+    - Support for SSL encryption added using IO::Socket::SSL.
+    - Event loop abstraction. Event::RPC now works with Event
+      and Glib and can be easily extended for other event loop
+      frameworks. Thanks to Rocco Caputo for the suggestion.
+
+0.80 Sun Mar 13, 2005, joern
+    Notes:
+    - A non public release. Only announced on the perl-loop mailing
+      list for the namespace request and to get comments. Module
+      is fully working but API isn't documented yet very well.
+      Security stuff (SSL encryption, some password authentication)
+      is missing also a complete test suite.

Added: packages/libevent-rpc-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/MANIFEST	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/MANIFEST	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,32 @@
+Changes
+MANIFEST
+Makefile.PL
+META.yml
+README
+lib/Event/RPC.pm
+lib/Event/RPC/AuthPasswdHash.pm
+lib/Event/RPC/Client.pm
+lib/Event/RPC/Logger.pm
+lib/Event/RPC/Loop.pm
+lib/Event/RPC/Loop/Event.pm
+lib/Event/RPC/Loop/Glib.pm
+lib/Event/RPC/Message.pm
+lib/Event/RPC/Server.pm
+lib/Event/RPC/Connection.pm
+lib/Event/RPC/LogConnection.pm
+t/01.use.t
+t/02.cnct.t
+t/03.cnct-auth.t
+t/04.cnct-auth-ssl.t
+t/05.func.t
+t/Event_RPC_Test.pm
+t/Event_RPC_Test_Server.pm
+t/ssl/server.crt
+t/ssl/server.csr
+t/ssl/server.key
+examples/server.pl
+examples/client.pl
+examples/Test_class.pm
+examples/ssl/server.key
+examples/ssl/server.csr
+examples/ssl/server.crt

Added: packages/libevent-rpc-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/META.yml	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/META.yml	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,17 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Event-RPC
+version:      0.89
+version_from: lib/Event/RPC.pm
+installdirs:  site
+requires:
+    Event:                         0
+    Glib:                          0
+    IO::Socket::INET:              0
+    IO::Socket::SSL:               0
+    Net::SSLeay:                   0
+    Storable:                      0
+    Test::More:                    0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30

Added: packages/libevent-rpc-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/Makefile.PL	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/Makefile.PL	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,56 @@
+# $Id: Makefile.PL,v 1.3 2005/12/18 13:47:35 joern Exp $
+
+use strict;
+use ExtUtils::MakeMaker;
+
+my $loop_modules = 0;
+my $has_event    = 0;
+my $has_glib     = 0;
+
+eval { require Event; $has_event = 1 } && ++$loop_modules;
+eval { require Glib;  $has_glib  = 1 } && ++$loop_modules;
+
+if ( !$loop_modules ) {
+    print "\n";
+    print "*******************************************************\n";
+    print "WARNING: You need Event or Glib for Event::RPC to work!\n";
+    print "*******************************************************\n";
+    print "\n";
+}
+
+my $has_ssl;
+eval { require IO::Socket::SSL; $has_ssl = 1 } || do {
+    print "\n";
+    print "NOTE: Event::RPC is capable of SSL encrypted connections,\n";
+    print "      but your Perl is missing the IO::Socket::SSL module.\n";
+    print "      Event::RPC works perfectly without the module, but you\n";
+    print "      can't use SSL connections until IO::Socket::SSL is\n";
+    print "      installed.\n";
+    print "\n";
+};
+
+#-- Add found modules to PREREQ_PM, so CPAN Testers add
+#-- version numbers of these modules to the reports, which
+#-- are very important in case of failing tests.
+my @add_prereq;
+push @add_prereq, 'Event', 0           if $has_event;
+push @add_prereq, 'Glib', 0            if $has_glib;
+push @add_prereq, 'IO::Socket::SSL', 0 if $has_ssl;
+push @add_prereq, 'Net::SSLeay', 0     if $has_ssl;
+
+WriteMakefile(
+    'NAME'	   => 'Event::RPC',
+    'VERSION_FROM' => 'lib/Event/RPC.pm',
+    'PREREQ_PM'    => {
+    	'Test::More'       => 0,
+        'Storable'         => 0,
+        'IO::Socket::INET' => 0,
+        @add_prereq,
+    },
+    'dist' => {
+        COMPRESS => "gzip",
+        SUFFIX   => "gz",
+	PREOP    => q[pod2text lib/Event/RPC.pm > README],
+	POSTOP	 => q[mkdir -p dist && mv Event-RPC-*tar.gz dist/],
+    },
+);

Added: packages/libevent-rpc-perl/branches/upstream/current/README
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/README	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/README	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,165 @@
+NAME
+    Event::RPC - Event based transparent Client/Server RPC framework
+
+SYNOPSIS
+      #-- Server Code
+      use Event::RPC::Server;
+      use My::TestModule;
+      my $server = Event::RPC::Server->new (
+          port    => 5555,
+          classes => { "My::TestModule" => { ... } },
+      );
+      $server->start;
+
+      ----------------------------------------------------------
+  
+      #-- Client Code
+      use Event::RPC::Client;
+      my $client = Event::RPC::Client->new (
+          server   => "localhost",
+          port     => 5555,
+      );
+      $client->connect;
+
+      #-- Call methods of My::TestModule on the server
+      my $obj = My::TestModule->new ( foo => "bar" );
+      my $foo = $obj->get_foo;
+
+ABSTRACT
+    Event::RPC supports you in developing Event based networking
+    client/server applications with transparent object/method access from
+    the client to the server. Network communication is optionally encrypted
+    using IO::Socket::SSL. Several event loop managers are supported due to
+    an extensible API. Currently Event and Glib are implemented.
+
+DESCRIPTION
+    Event::RPC consists of a server and a client library. The server exports
+    a list of classes and methods, which are allowed to be called over the
+    network. More specific it acts as a proxy for objects created on the
+    server side (on demand of the connected clients) which handles client
+    side methods calls with transport of method arguments and return values.
+
+    The object proxy handles refcounting and destruction of objects created
+    by clients properly. Objects as method parameters and return values are
+    handled as well (although with some limitations, see below).
+
+    For the client the whole thing is totally transparent - once connected
+    to the server it doesn't know whether it calls methods on local or
+    remote objects.
+
+    Also the methods on the server newer know whether they are called
+    locally or from a connected client. Your application logic is not
+    affected by Event::RPC at all, at least if it has a rudimentary clean OO
+    design.
+
+    For details on implementing servers and clients please refer to the man
+    pages of Event::RPC::Server and Event::RPC::Client.
+
+REQUIREMENTS
+    Event::RPC needs either one of the following modules on the server
+    (they're not necessary on the client):
+
+      Event
+      Glib
+
+    They're needed for event handling resp. mainloop implementation. If you
+    like to use SSL encryption you need to install
+
+      IO::Socket::SSL
+
+    As well Event::RPC makes heavy use of the
+
+      Storable
+
+    module, which is part of the Perl standard library. It's important that
+    both client and server use exactly the same version of the Storable
+    module! Otherwise Event::RPC client/server communication will fail
+    badly.
+
+INSTALLATION
+    You get the latest installation tarballs and online documentation at
+    this location:
+
+      http://www.exit1.org/Event-RPC/
+
+    If your system meets the requirements mentioned above, installation is
+    just:
+
+      perl Makefile.PL
+      make test
+      make install
+
+EXAMPLES
+    The tarball includes an examples/ directory which contains two programs:
+
+      server.pl
+      client.pl
+
+    Just execute them with --help to get the usage. They do some very simple
+    communication but are good to test your setup, in particular in a mixed
+    environment.
+
+LIMITATIONS
+    Although the classes and objects on the server are accessed
+    transparently by the client there are some limitations should be aware
+    of. With a clean object oriented design these should be no problem in
+    real applications:
+
+  Direct object data manipulation is forbidden
+    All objects reside on the server and they keep there! The client just
+    has specially wrapped proxy objects, which trigger the necessary magic
+    to access the object's methods on the server. Complete objects are never
+    transferred from the server to the client, so something like this does
+    not work:
+
+      $object->{data} = "changed data";
+
+    (assuming $object is a hash ref on the server).
+
+    Only method calls are transferred to the server, so even for "simple"
+    data manipulation a method call is necessary:
+
+      $object->set_data ("changed data");
+
+    As well for reading an object attribute. Accessing a hash key will fail:
+
+      my $data = $object->{data};
+
+    Instead call a method which returns the 'data' member:
+
+      my $data = $object->get_data;
+
+  Methods may exchange objects, but not in a too complex structure
+    Event::RPC handles methods which return objects. The only requirement is
+    that they are declared as a Object returner on the server (refer to
+    Event::RPC::Server for details), but not if the object is hided inside a
+    deep complex data structure.
+
+    An array or hash ref of objects is Ok, but not more. This would require
+    to much expensive runtime data inspection.
+
+    Object receiving parameters are more restrictive, since even hiding them
+    inside one array or hash ref is not allowed. They must be passed as a
+    direkt argument of the method subroutine.
+
+AUTHORS
+      Jörn Reder <joern at zyn dot de>
+
+COPYRIGHT AND LICENSE
+    Copyright 2002-2006 by Jörn Reder.
+
+    This library is free software; you can redistribute it and/or modify it
+    under the terms of the GNU Library General Public License as published
+    by the Free Software Foundation; either version 2.1 of the License, or
+    (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful, but
+    WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library
+    General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307
+    USA.
+

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/Test_class.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/Test_class.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/Test_class.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,50 @@
+# $Id: Test_class.pm,v 1.2 2005/12/18 13:10:14 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2005 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Test_class;
+
+use strict;
+
+sub get_data			{ shift->{data}				}
+sub set_data			{ shift->{data}			= $_[1]	}
+
+sub new {
+	my $class = shift;
+	my %par = @_;
+	my ($data) = $par{'data'};
+
+	my $self = bless {
+		data	=> $data,
+	}, $class;
+	
+	return $self;
+}
+
+sub hello {
+	my $self = shift;
+	
+	return "Hello again. My data is: '".$self->get_data."'";
+}
+
+sub quit {
+	my $self = shift;
+	
+	my $rpc_server = Event::RPC::Server->instance;
+	
+	$rpc_server->get_loop->add_timer (
+		after	=> 3,
+		cb	=> sub { $rpc_server->stop },
+	);
+	
+	return "Server stops in 3 seconds";
+}
+
+1;
+

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/client.pl
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/client.pl	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/client.pl	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,108 @@
+#!/usr/bin/perl -w
+
+# $Id: client.pl,v 1.4 2005/12/18 14:01:13 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2005 Jörn 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;
+
+}


Property changes on: packages/libevent-rpc-perl/branches/upstream/current/examples/client.pl
___________________________________________________________________
Name: svn:executable
   + 

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/server.pl
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/server.pl	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/server.pl	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -w
+
+# $Id: server.pl,v 1.3 2005/12/18 14:01:13 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2005 Jörn 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 strict;
+use lib qw( lib ../lib examples .);
+use Event::RPC::Server;
+use Event::RPC::Logger;
+use Getopt::Std;
+
+my $USAGE = <<__EOU;
+
+Usage: server.pl [-l log-level] [-s] [-a user:pass] [-L loop-module] 
+
+Description:
+  Event::RPC server demonstration program. Execute this from
+  the distribution's base or examples/ directory. Then execute
+  examples/client.pl on another console.
+
+Options:
+  -l log-level       Logging level. Default: 4
+  -s                 Use SSL encryption
+  -a user:pass       Require authorization
+  -h host            Bind to this host interface. Default: localhost
+  -L loop-module     Event loop module to use.
+                     Default: Event::RPC::Loop::Event
+
+__EOU
+
+sub HELP_MESSAGE {
+	my ($fh) = @_;
+	$fh ||= \*STDOUT;
+	print $fh $USAGE;
+	exit;
+}
+
+main: {
+    my %opts;
+    my $opts_ok = getopts('h:L:l:a:s',\%opts);
+   
+    HELP_MESSAGE() unless $opts_ok;
+
+    my %ssl_args;
+    if ( $opts{s} ) {
+      %ssl_args = (
+        ssl => 1,
+	ssl_key_file  => 'ssl/server.key',
+	ssl_cert_file => 'ssl/server.crt',
+	ssl_passwd_cb => sub { 'eventrpc' },
+      );
+      if ( not -f 'ssl/server.key' ) {
+        chdir ("examples");
+	if ( not -f 'ssl/server.key' ) {
+	  print "please execute from toplevel or examples/ directory\n";
+	  exit 1;
+	}
+      }
+    }
+
+    my %auth_args;
+    if ( $opts{a} ) {
+      my ($user, $pass) = split(":", $opts{a}); 
+      $pass = Event::RPC->crypt($user, $pass);
+      %auth_args = (
+	auth_required    => 1,
+	auth_passwd_href => { $user => $pass },
+      );
+    }
+
+    #-- Create a logger object
+    my $logger = Event::RPC::Logger->new (
+	    min_level => ($opts{l}||4),
+	    fh_lref   => [ \*STDOUT ],
+    );
+
+    #-- Create a loop object
+    my $loop;
+    my $loop_module = $opts{L};
+    if ( $loop_module ) {
+	    eval "use $loop_module";
+	    die $@ if $@;
+	    $loop = $loop_module->new();
+    }
+    
+    #-- Host parameter
+    my $host = $opts{h} || "localhost";
+    
+    #-- Create a Server instance and declare the
+    #-- exported interface
+    my $server = Event::RPC::Server->new (
+      name                => "test daemon",
+      host		  => $host,
+      port                => 5555,
+      logger              => $logger,
+      loop                => $loop,
+      start_log_listener  => 1,
+      auto_reload_modules => 1,
+      %auth_args,
+      %ssl_args,
+      classes => {
+	'Test_class' => {
+	  new       => '_constructor',
+	  set_data  => 1,
+	  get_data  => 1,
+	  hello     => 1,
+	  quit	    => 1,
+	},
+      },
+    );
+
+    #-- Start the server resp. the Event loop.
+    $server->start;
+}
+
+


Property changes on: packages/libevent-rpc-perl/branches/upstream/current/examples/server.pl
___________________________________________________________________
Name: svn:executable
   + 

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.crt
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.crt	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.crt	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICozCCAgwCCQC7s/EOvPkeSTANBgkqhkiG9w0BAQQFADCBlTELMAkGA1UEBhMC
+REUxETAPBgNVBAgTCElyZ2VuZHdvMQ4wDAYDVQQHEwVLb2VsbjESMBAGA1UEChMJ
+ZXhpdDEub3JnMR0wGwYDVQQLExRTb2Z0d2FyZSBEZXZlbG9wbWVudDETMBEGA1UE
+AxQKSvZybiBSZWRlcjEbMBkGCSqGSIb3DQEJARYMam9lcm5AenluLmRlMB4XDTA1
+MDMxMzE3NDg1NloXDTE1MDEyMDE3NDg1NlowgZUxCzAJBgNVBAYTAkRFMREwDwYD
+VQQIEwhJcmdlbmR3bzEOMAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9y
+ZzEdMBsGA1UECxMUU29mdHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4g
+UmVkZXIxGzAZBgkqhkiG9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0B
+AQEFAAOBjQAwgYkCgYEApKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRh
+CCNfUufY8Jslmn/4hZI4wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35
+uWoMw343kZA4G6eLqjWVy8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8C
+AwEAATANBgkqhkiG9w0BAQQFAAOBgQAaahVlE9jXt0GO+Zk9ZDUmyiLQ31lhRbvr
+/fFqLYB3WS0xGnKKaj3IQFREkke7an4rhUaZLGstAhF3bXcN//t9bgZKQfnRPsM2
+bQHEVWAtwjebv0Rn0uR53gZBxoCHZyGwCL0Tj0Gvynpou4Y8UDGnfc1E/r+HOTCO
+yvVrQL359w==
+-----END CERTIFICATE-----

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.csr
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.csr	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.csr	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,12 @@
+-----BEGIN CERTIFICATE REQUEST-----
+MIIB1jCCAT8CAQAwgZUxCzAJBgNVBAYTAkRFMREwDwYDVQQIEwhJcmdlbmR3bzEO
+MAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9yZzEdMBsGA1UECxMUU29m
+dHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4gUmVkZXIxGzAZBgkqhkiG
+9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA
+pKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRhCCNfUufY8Jslmn/4hZI4
+wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35uWoMw343kZA4G6eLqjWV
+y8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8CAwEAAaAAMA0GCSqGSIb3
+DQEBBAUAA4GBAJmfq2IqvN+m9IIRzNTHBjEaOeYIEFVKcqWIiui/hvw8M7Yi0op2
+ifOjRKSfYTsgNAst1Ilwg6wgblSngg6f9GpGtWAYr1xQpoWS8PDaqjx1sLE40qi2
+aNrCtrSCLxzLh9o0qeUydcrjvIK6sWe6lGRntjNoj2VCqlBm0EFQ7vNF
+-----END CERTIFICATE REQUEST-----

Added: packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.key
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.key	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/examples/ssl/server.key	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,18 @@
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-EDE3-CBC,CEB8A2E7F9C59066
+
+mUDYr4fgc2lba+qobTYxcq/8ZpRS1cdoiCe1QQeSQ2Bywrsgx8H40hqkBsKOYBPa
+ZFC+EEQTfhGOswTD5YsgqfTyWc7w0qlXDlPCVgV28r96gKzpP6oEDoclriWsToDF
+ZOsANyGcdl4D4VyY+oOf9crUFqIC4C/IfUJ++pZCUlGy8k/J0qHl/kCEP1bPg92q
+tKrG/gcDtrqnVHYB22MruAXHSAo4JOO7A6ZmrRGH4XY5SKGZPF/T7kwLLzEXbPq2
+MDrcPg3xWcCvODswrptdmK73PyF5oWkA7NXAofecu51jW1Y9G48p1lQi0mAgP3qP
+LDxCFQUU52G9UAxmfd8pZBSntRIsaIQV+6ffM8TemObgf1VkisCGDUCnEgvj2zDN
+AaieLhR4MKIQuYZSTLfCI5mKZK0vCFP5t19wK6Clt7p9bq1aUu8HkqEZ5yrNmf04
+acKvUkDbVCPL1pkAsyNAEQ4Zs3f3VxkuRrtf7gqzEEFK1TQoH7JmaALqGftgkPYJ
+eEYX8Om/Gr8NxTftSNbnoaFUyeoBOQ1iZY2g4qqE0rZlc7lfXiXAV3ajtgPcreZa
++uU4g8DF7zfQ7F8FK7w2ryLJFdlgk7SzEjv1VzCQTQ2MjBOCs0gJ3SPF6wx6lfyH
+9HqYRu2OwPJlaTzVrdhwKesROuBr1+rJym18uvzObSgkbTrFQuuYcR0dNbs+AuqQ
+dkhOC6bzpOdZNWVnVQ7klbsj8iUSMs4QnSI0+DpSls5VOMJiAXqPCAy4YJ0GAcGv
+EDF12ONiToyGb0Jolo+WOXyDebHR19TxokTcC5Ri7305mtRAP7g1fQ==
+-----END RSA PRIVATE KEY-----

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/AuthPasswdHash.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/AuthPasswdHash.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/AuthPasswdHash.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,26 @@
+package Event::RPC::AuthPasswdHash;
+
+use strict;
+use Carp;
+
+sub get_passwd_href             { shift->{passwd_href}                  }
+sub set_passwd_href             { shift->{passwd_href}          = $_[1] }
+
+sub new {
+    my $class = shift;
+    my ($passwd_href) = @_;
+
+    my $self = bless {
+        passwd_href => $passwd_href,
+    };
+    
+    return $self;
+}
+
+sub check_credentials {
+    my $self = shift;
+    my ($user, $pass) = @_;
+    return $pass eq $self->get_passwd_href->{$user};
+}
+
+1;

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Client.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Client.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Client.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,682 @@
+# $Id: Client.pm,v 1.11 2006/03/27 19:52:45 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Client;
+
+use Event::RPC;
+use Event::RPC::Message;
+
+use Carp;
+use strict;
+use IO::Socket::INET;
+
+sub get_client_version          { $Event::RPC::VERSION                  }
+sub get_client_protocol         { $Event::RPC::PROTOCOL                 }
+
+sub get_host                    { shift->{host}                         }
+sub get_port                    { shift->{port}                         }
+sub get_sock                    { shift->{sock}                         }
+sub get_classes                 { shift->{classes}                      }
+sub get_class_map               { shift->{class_map}                    }
+sub get_loaded_classes          { shift->{loaded_classes}               }
+sub get_error_cb                { shift->{error_cb}                     }
+sub get_ssl                     { shift->{ssl}                          }
+sub get_auth_user               { shift->{auth_user}                    }
+sub get_auth_pass               { shift->{auth_pass}                    }
+sub get_connected               { shift->{connected}                    }
+sub get_server                  { shift->{server}                       }
+sub get_server_version          { shift->{server_version}               }
+sub get_server_protocol         { shift->{server_protocol}              }
+
+sub set_host                    { shift->{host}                 = $_[1] }
+sub set_port                    { shift->{port}                 = $_[1] }
+sub set_sock                    { shift->{sock}                 = $_[1] }
+sub set_classes                 { shift->{classes}              = $_[1] }
+sub set_class_map               { shift->{class_map}            = $_[1] }
+sub set_loaded_classes          { shift->{loaded_classes}       = $_[1] }
+sub set_error_cb                { shift->{error_cb}             = $_[1] }
+sub set_ssl                     { shift->{ssl}                  = $_[1] }
+sub set_auth_user               { shift->{auth_user}            = $_[1] }
+sub set_auth_pass               { shift->{auth_pass}            = $_[1] }
+sub set_connected               { shift->{connected}            = $_[1] }
+sub set_server                  { shift->{server}               = $_[1] }
+sub set_server_version          { shift->{server_version}       = $_[1] }
+sub set_server_protocol         { shift->{server_protocol}      = $_[1] }
+
+sub new {
+    my $class = shift;
+    my %par   = @_;
+    my  ($server, $host, $port, $classes, $class_map, $error_cb) =
+    @par{'server','host','port','classes','class_map','error_cb'};
+    my  ($ssl, $auth_user, $auth_pass) =
+    @par{'ssl','auth_user','auth_pass'};
+
+    $server ||= '';
+    $host   ||= '';
+
+    if ( $server ne '' and $host eq '' ) {
+        warn "Option 'server' is deprecated. Use 'host' instead.";
+        $host = $server;
+    }
+
+    my $self = bless {
+        host           => $server,
+        server         => $host,
+        port           => $port,
+        classes        => $classes,
+        class_map      => $class_map,
+        ssl            => $ssl,
+        auth_user      => $auth_user,
+        auth_pass      => $auth_pass,
+        error_cb       => $error_cb,
+        loaded_classes => {},
+        connected      => 0,
+    }, $class;
+
+    return $self;
+}
+
+sub connect {
+    my $self = shift;
+
+    croak "Client is already connected" if $self->get_connected;
+
+    my $ssl    = $self->get_ssl;
+    my $server = $self->get_server;
+    my $port   = $self->get_port;
+
+    if ($ssl) {
+        eval { require IO::Socket::SSL };
+        croak "SSL requested, but IO::Socket::SSL not installed" if $@;
+    }
+
+    my $sock;
+    if ($ssl) {
+        $sock = IO::Socket::SSL->new(
+            Proto    => 'tcp',
+            PeerPort => $port,
+            PeerAddr => $server,
+            Type     => SOCK_STREAM
+            )
+            or croak
+            "Can't open SSL connection to $server:$port: $IO::Socket::SSL::ERROR";
+    }
+    else {
+        $sock = IO::Socket::INET->new(
+            Proto    => 'tcp',
+            PeerPort => $port,
+            PeerAddr => $server,
+            Type     => SOCK_STREAM
+            )
+            or croak "Can't open connection to $server:$port - $!";
+    }
+
+    $sock->autoflush(1);
+
+    $self->set_sock($sock);
+
+    $self->check_version;
+
+    my $auth_user = $self->get_auth_user;
+    my $auth_pass = $self->get_auth_pass;
+
+    if ($auth_user) {
+        my $rc = $self->send_request(
+            {   cmd  => 'auth',
+                user => $auth_user,
+                pass => $auth_pass,
+            }
+        );
+        if ( not $rc->{ok} ) {
+            $self->disconnect;
+            croak $rc->{msg};
+        }
+    }
+
+    if ( not $self->get_classes ) {
+        $self->load_all_classes;
+    }
+    else {
+        $self->load_classes;
+    }
+
+    $self->set_connected(1);
+
+    1;
+}
+
+sub log_connect {
+    my $class = shift;
+    my %par   = @_;
+    my ( $server, $port ) = @par{ 'server', 'port' };
+
+    my $sock = IO::Socket::INET->new(
+        Proto    => 'tcp',
+        PeerPort => $port,
+        PeerAddr => $server,
+        Type     => SOCK_STREAM
+        )
+        or croak "Can't open connection to $server:$port - $!";
+
+    return $sock;
+}
+
+sub disconnect {
+    my $self = shift;
+
+    close( $self->get_sock ) if $self->get_sock;
+    $self->set_connected(0);
+
+    1;
+}
+
+sub DESTROY {
+    shift->disconnect;
+}
+
+sub error {
+    my $self = shift;
+    my ($message) = @_;
+
+    my $error_cb = $self->get_error_cb;
+
+    if ($error_cb) {
+        &$error_cb( $self, $message );
+    }
+    else {
+        die "Unhandled error in client/server communication: $message";
+    }
+
+    1;
+}
+
+sub check_version {
+    my $self = shift;
+
+    my $rc = $self->send_request( { cmd => 'version', } );
+
+    $self->set_server_version( $rc->{version} );
+    $self->set_server_protocol( $rc->{protocol} );
+
+    if ( $rc->{version} ne $self->get_client_version ) {
+        warn "Event::RPC warning: server version $rc->{version} != "
+            . "client version "
+            . $self->get_client_version;
+    }
+
+    if ( $rc->{protocol} < $self->get_client_protocol ) {
+        die "FATAL: Server protocol version $rc->{protocol} < "
+            . "client protocol version "
+            . $self->get_client_protocol;
+    }
+
+    1;
+}
+
+sub load_all_classes {
+    my $self = shift;
+
+    my $rc = $self->send_request( { cmd => 'class_info_all', } );
+
+    my $class_info_all = $rc->{class_info_all};
+
+    foreach my $class ( keys %{$class_info_all} ) {
+        $self->load_class( $class, $class_info_all->{$class} );
+    }
+
+    1;
+}
+
+sub load_classes {
+    my $self = shift;
+
+    my $classes = $self->get_classes;
+    my %classes;
+    @classes{ @{$classes} } = (1) x @{$classes};
+
+    my $rc = $self->send_request( { cmd => 'classes_list', } );
+
+    foreach my $class ( @{ $rc->{classes} } ) {
+        next if not $classes{$class};
+        $classes{$class} = 0;
+
+        my $rc = $self->send_request(
+            {   cmd   => 'class_info',
+                class => $class,
+            }
+        );
+
+        $self->load_class( $class, $rc->{methods} );
+    }
+
+    foreach my $class ( @{$classes} ) {
+        warn "WARNING: Class '$class' not exported by server"
+            if $classes{$class};
+    }
+
+    1;
+}
+
+sub load_class {
+    my $self = shift;
+    my ( $class, $methods ) = @_;
+
+    my $loaded_classes = $self->get_loaded_classes;
+    return 1 if $loaded_classes->{$class};
+    $loaded_classes->{$class} = 1;
+
+    my $local_method;
+    my $class_map   = $self->get_class_map;
+    my $local_class = $class_map->{$class} || $class;
+
+    # create local destructor for this class
+    {
+        no strict 'refs';
+        my $local_method = $local_class . '::' . "DESTROY";
+        *$local_method = sub {
+            return if not $self->get_connected;
+            my $oid_ref = shift;
+            $self->send_request({
+                cmd => "client_destroy",
+                oid => ${$oid_ref},
+            });
+        };
+    }
+
+    # create local methods for this class
+    foreach my $method ( keys %{$methods} ) {
+        $local_method = $local_class . '::' . $method;
+
+        my $method_type = $methods->{$method};
+
+        if ( $method_type eq '_constructor' ) {
+            # this is a constructor for this class
+            my $request_method = $class . '::' . $method;
+            no strict 'refs';
+            *$local_method = sub {
+                shift;
+                my $rc = $self->send_request({
+                    cmd    => 'new',
+                    method => $request_method,
+                    params => \@_,
+                });
+                my $oid = $rc->{oid};
+                return bless \$oid, $local_class;
+            };
+        }
+        elsif ( $method_type eq '1' ) {
+            # this is a simple method
+            my $request_method = $method;
+            no strict 'refs';
+            *$local_method = sub {
+                my $oid_ref = shift;
+                my $rc = $self->send_request({
+                    cmd    => 'exec',
+                    oid    => ${$oid_ref},
+                    method => $request_method,
+                    params => \@_,
+                });
+                return unless $rc;
+                $rc = $rc->{rc};
+                return @{$rc} if wantarray;
+                return $rc->[0];
+            };
+        }
+        else {
+            # this is a object returner
+            my $request_method = $method;
+            no strict 'refs';
+            *$local_method = sub {
+                my $oid_ref = shift;
+                my $rc      = $self->send_request({
+                    cmd    => 'exec',
+                    oid    => ${$oid_ref},
+                    method => $request_method,
+                    params => \@_,
+                });
+                return unless $rc;
+                $rc = $rc->{rc};
+
+                foreach my $val ( @{$rc} ) {
+                    if ( ref $val eq 'ARRAY' ) {
+                        foreach my $list_elem ( @{$val} ) {
+                            my ($class) = split( "=", "$list_elem", 2 );
+                            $self->load_class($class)
+                                unless $loaded_classes->{$class};
+                            my $list_elem_copy = $list_elem;
+                            $list_elem = \$list_elem_copy;
+                            bless $list_elem,
+                                ( $class_map->{$class} || $class );
+                        }
+                    }
+                    elsif ( ref $val eq 'HASH' ) {
+                        foreach my $hash_elem ( values %{$val} ) {
+                            my ($class) = split( "=", "$hash_elem", 2 );
+                            $self->load_class($class)
+                                unless $loaded_classes->{$class};
+                            my $hash_elem_copy = $hash_elem;
+                            $hash_elem = \$hash_elem_copy;
+                            bless $hash_elem,
+                                ( $class_map->{$class} || $class );
+                        }
+                    }
+                    elsif ( defined $val ) {
+                        my ($class) = split( "=", "$val", 2 );
+                        $self->load_class($class)
+                            unless $loaded_classes->{$class};
+                        my $val_copy = $val;
+                        $val = \$val_copy;
+                        bless $val, ( $class_map->{$class} || $class );
+                    }
+                }
+                return @{$rc} if wantarray;
+                return $rc->[0];
+            };
+        }
+    }
+
+    return $local_class;
+}
+
+sub send_request {
+    my $self = shift;
+    my ($request) = @_;
+
+    my $message = Event::RPC::Message->new( $self->get_sock );
+
+    $message->write_blocked($request);
+
+    my $rc = eval { $message->read_blocked };
+
+    if ($@) {
+        $self->error($@);
+        return;
+    }
+
+    if ( not $rc->{ok} ) {
+        $rc->{msg} .= "\n" if not $rc->{msg} =~ /\n$/;
+        croak ("$rc->{msg} -- called via Event::RPC::Client");
+    }
+
+    return $rc;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Client - Client API to connect to Event::RPC Servers
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Client;
+
+  my $rpc_client = Event::RPC::Client->new (
+    #-- Required arguments
+    host => "localhost",
+    port => 5555,
+    
+    #-- Optional arguments
+    classes   => [ "Event::RPC::Test" ],
+    class_map => { "Event::RPC::Test" => "My::Event::RPC::Test" },
+
+    ssl       => 1,
+
+    auth_user => "fred",
+    auth_pass => Event::RPC->crypt("fred",$password),
+
+    error_cb => sub {
+      my ($client, $error) = @_;
+      print "An RPC error occured: $error\n";
+      $client->disconnect;
+      exit;
+    },
+  );
+
+  $rpc_client->connect;
+  
+  #-- And now use classes and methods the server
+  #-- allows to access via RPC, here My::TestModule
+  #-- from the Event::RPC::Server manpage SYNPOSIS.
+  my $obj = My::TestModule->new( data => "foobar" );
+  print "obj says hello: ".$obj->hello."\n";
+  $obj->set_data("new foobar");
+  print "updated data: ".$obj->get_data."\n";
+
+  $rpc_client->disconnect;
+
+=head1 DESCRIPTION
+
+Use this module to write clients accessing objects and methods
+exported by a Event::RPC driven server.
+
+Just connect to the server over the network, optionally with
+SSL and user authentication, and then simply use the exported classes
+and methods like having them locally in the client.
+
+General information about the architecture of Event::RPC driven
+applications is collected in the Event::RPC manpage.
+
+The following documentation describes the client connection
+options in detail.
+
+=head1 CONFIGURATION OPTIONS
+
+You need to specify at least the server hostname and TCP port
+to connect a Event::RPC server instance. If the server requires
+a SSL connection or user authentication you need to supply
+the corresponding options as well, otherwise connecting will
+fail.
+
+All options described here may be passed to the new() constructor of
+Event::RPC::Client. As well you may set or modify them using set_OPTION style
+mutators, but not after connect() was called!
+All options may be read using get_OPTION style accessors.
+
+=head2 REQUIRED OPTIONS
+
+These are necessary to connect the server:
+
+=over 4
+
+=item B<server>
+
+This is the hostname of the server running Event::RPC::Server.
+Use a IP address or DNS name here.
+
+=item B<port>
+
+This is the TCP port the server is listening to.
+
+=back
+
+=head2 CLASS IMPORT OPTION
+
+=over 4
+
+=item B<classes>
+
+This is reference to a list of classes which should be imported
+into the client. You get a warning if you request a class which
+is not exported by the server.
+
+By default all server classes are imported. Use this feature if
+your server exports a huge list of classes, but your client
+doesn't need all of them. This saves memory in the client and
+connect performance increases.
+
+=item B<class_map>
+
+Optionally you can map the class names from the server to a
+different name on the local client using the B<class_map> hash.
+
+This is necessary if you like to use the same classes locally
+and remotely. Imported classes from the server are by default
+registered under the same name on the client, so this conflicts
+with local classes named identically.
+
+On the client you access the remote classes under the name
+assigned in the class map. For example with this map
+
+  class_map => { "Event::ExecFlow::Job" => "_srv::Event::ExecFlow::Job" }
+
+you need to write this on the client, if you like to create
+an object remotely on the server:
+
+  my $server_job = _srv::Event::ExecFlow::Job->new ( ... );
+
+and this to create an object on the client:
+
+  my $client_job = Event::ExecFlow::Job->new ( ... );
+
+The server knows nothing of the renaming on client side, so you
+still write this on the server to create objects there:
+
+  my $job = Event::ExecFlow::Job->new ( ... );
+
+=back
+
+=head2 SSL OPTION
+
+If the server accepts only SSL connections you need to enable
+ssl here in the client as well:
+
+=over 4
+
+=item B<ssl>
+
+Set this option to 1 to encrypt the network connection using SSL.
+
+=back
+
+=head2 AUTHENTICATION OPTIONS
+
+If the server requires user authentication you need to set
+the following options:
+
+=over 4
+
+=item B<auth_user>
+
+A valid username.
+
+=item B<auth_pass>
+
+The corresponding password, encrypted using Perl's crypt() function,
+using the username as the salt.
+
+Event::RPC has a convenience function for generating such a crypted
+password, although it's currently just a wrapper around Perl's
+builtin crypt() function, but probably this changes someday, so better
+use this method:
+
+  $crypted_pass = Event::RPC->crypt($user, $pass);
+
+=back
+
+If the passed credentials are invalid the Event::RPC::Client->connect()
+method throws a correspondent exception.
+
+=head2 ERROR HANDLING
+
+Any exceptions thrown on the server during execution of a remote
+method will result in a corresponding exception on the client. So
+you can use normal exception handling with eval {} when executing
+remote methods.
+
+But besides this the network connection between your client and
+the server may break at any time. This raises an exception as well,
+but you can override this behaviour with the following attribute:
+
+=over 4
+
+=item B<error_cb>
+
+This subroutine is called if any error occurs in the network
+communication between the client and the server. The actual
+Event::RPC::Client object and an error string are passed
+as arguments.
+
+This is B<no> generic exception handler for exceptions thrown from the
+executed methods on the server! If you like to catch such
+exceptions you need to put an eval {} around your method calls,
+as you would do for local method calls.
+
+If you don't specify an B<error_cb> an exception is thrown instead.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $rpc_client->B<connect>
+
+This establishes the configured connection to the server. An exception
+is thrown if something goes wrong, e.g. server not available, credentials
+are invalid or something like this.
+
+=item $rpc_client->B<disconnect>
+
+Closes the connection to the server. You may omit explicit disconnecting
+since it's done automatically once the Event::RPC::Client object gets
+destroyed.
+
+=back
+
+=head1 READY ONLY ATTRIBUTES
+
+=over 4
+
+=item $rpc_client->B<get_server_version>
+
+Returns the Event::RPC version number of the server after connecting.
+
+=item $rpc_client->B<get_server_protocol>
+
+Returns the Event::RPC protocol number of the server after connecting.
+
+=item $rpc_client->B<get_client_version>
+
+Returns the Event::RPC version number of the client.
+
+=item $rpc_client->B<get_client_protocol>
+
+Returns the Event::RPC protocol number of the client.
+
+=back
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut
+

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Connection.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Connection.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Connection.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,640 @@
+package Event::RPC::Connection;
+
+use strict;
+use Carp;
+
+my $CONNECTION_ID;
+
+sub get_cid			{ shift->{cid}				}
+sub get_sock			{ shift->{sock}				}
+sub get_server			{ shift->{server}			}
+
+sub get_classes			{ shift->{server}->{classes}		}
+sub get_loaded_classes		{ shift->{server}->{loaded_classes}	}
+sub get_objects			{ shift->{server}->{objects}		}
+sub get_client_oids		{ shift->{client_oids}		        }
+
+sub get_watcher			{ shift->{watcher}			}
+sub get_message			{ shift->{message}			}
+sub get_is_authenticated	{ shift->{is_authenticated}		}
+sub get_auth_user		{ shift->{auth_user}			}
+
+sub set_watcher			{ shift->{watcher}		= $_[1]	}
+sub set_message			{ shift->{message}		= $_[1]	}
+sub set_is_authenticated	{ shift->{is_authenticated}	= $_[1]	}
+sub set_auth_user		{ shift->{auth_user}		= $_[1]	}
+
+sub new {
+	my $class = shift;
+	my ($server, $sock) = @_;
+
+	my $cid = ++$CONNECTION_ID;
+	
+	my $self = bless {
+		cid     		=> $cid,
+		sock    		=> $sock,
+		server  		=> $server,
+		is_authenticated	=> (!$server->get_auth_required),
+		auth_user		=> "",
+		watcher 		=> undef,
+		message 		=> undef,
+		client_oids		=> {},
+	}, $class;
+
+	if ( $sock ) {
+		$self->log (2,
+			"Got new RPC connection. Connection ID is $cid"
+		);
+		$self->{watcher} = $self->get_server->get_loop->add_io_watcher (
+			fh   => $sock,
+			poll => 'r',
+			cb   => sub { $self->input; 1 },
+			desc => "rpc client cid=$cid",
+		);
+	}
+
+	my $connection_hook = $server->get_connection_hook;
+	&$connection_hook($self, "connect") if $connection_hook;
+
+	return $self;
+}
+
+sub disconnect {
+	my $self = shift;
+
+	$self->get_server->get_loop->del_io_watcher($self->get_watcher);
+	$self->set_watcher(undef);
+	close $self->get_sock;
+
+	my $server = $self->get_server;
+
+	$server->set_clients_connected ( $self->get_server->get_clients_connected - 1 );
+
+	foreach my $oid ( keys %{$self->get_client_oids} ) {
+		$server->deregister_object($oid);
+	}
+
+	$self->log(2, "Client disconnected");
+
+	my $connection_hook = $server->get_connection_hook;
+	&$connection_hook($self, "disconnect") if $connection_hook;
+
+	1;
+}
+
+sub get_client_object {
+        my $self = shift;
+        my ($oid) = @_;
+        
+        croak "No object registered with oid '$oid'"
+            unless $self->get_client_objects->{$oid};
+
+        return $self->get_client_objects->{$oid};
+}
+
+sub log {
+	my $self = shift;
+
+	my ($level, $msg);
+	if ( @_ == 2 ) {
+		($level, $msg) = @_;
+	} else {
+		($msg) = @_;
+		$level = 1;
+	}
+
+	$msg = "cid=".$self->get_cid.": $msg";
+	
+	return $self->get_server->log ($level, $msg);
+}
+
+sub input {
+	my $self = shift;
+	my ($e) = @_;
+
+	my $server  = $self->get_server;
+	my $message = $self->get_message;
+
+	if ( not $message ) {
+		$message = Event::RPC::Message->new ($self->get_sock);
+		$self->set_message($message);
+	}
+
+	my $request = eval { $message->read } || '';
+	my $error = $@;
+
+	return if $request eq '' && $error eq '';
+
+	$self->set_message(undef);
+
+	return $self->disconnect
+		if $request eq "DISCONNECT\n" or
+		   $error =~ /DISCONNECTED/;
+
+        $server->set_active_connection($self);
+
+	my ($cmd, $rc);
+	$cmd = $request->{cmd} if not $error;
+	
+	$self->log(4, "RPC command: $cmd");
+	
+	if ( $error ) {
+		$self->log ("Unexpected error on incoming RPC call: $@");
+		$rc = {
+			ok  => 0,
+			msg => "Unexpected error on incoming RPC call: $@",
+		};
+
+	} elsif ( $cmd eq 'version' ) {
+		$rc = {
+			ok       => 1,
+			version  => $Event::RPC::VERSION,
+			protocol => $Event::RPC::PROTOCOL,
+		};
+
+	} elsif ( $cmd eq 'auth' ) {
+		$rc = $self->authorize_user ($request);
+
+	} elsif ( $server->get_auth_required && !$self->get_is_authenticated ) {
+		$rc = {
+			ok  => 0,
+			msg => "Authorization required",			
+		};
+
+	} elsif ( $cmd eq 'new' ) {
+		$rc = $self->create_new_object ($request);
+
+	} elsif ( $cmd eq 'exec' ) {
+		$rc = $self->execute_object_method ($request);
+
+	} elsif ( $cmd eq 'classes_list' ) {
+		$rc = $self->get_classes_list ($request);
+
+	} elsif ( $cmd eq 'class_info' ) {
+		$rc = $self->get_class_info ($request);
+
+	} elsif ( $cmd eq 'class_info_all' ) {
+		$rc = $self->get_class_info_all ($request);
+
+	} elsif ( $cmd eq 'client_destroy' ) {
+		$rc = $self->object_destroyed_on_client ($request);
+
+	} else {
+		$self->log ("Unknown request command '$cmd'");
+		$rc = {
+			ok  => 0,
+			msg => "Unknown request command '$cmd'",
+		};
+	}
+
+        $server->set_active_connection(undef);
+
+	$message->write($rc) and return;
+
+	my $watcher;
+	$watcher = $self->get_server->get_loop->add_io_watcher (
+		fh	=> $self->get_sock,
+		poll	=> 'w',
+		cb	=> sub {
+		    $self->get_server->get_loop->del_io_watcher($watcher)
+		    	if $message->write;
+		    1;
+		},
+	);
+
+	1;
+}
+
+sub authorize_user {
+	my $self = shift;
+	my ($request) = @_;
+	
+	my $user = $request->{user};
+	my $pass = $request->{pass};
+	
+        my $auth_module = $self->get_server->get_auth_module;
+        
+        return {
+            ok  => 1,
+            msg => "Not authorization required",
+        } unless $auth_module;
+        
+        my $ok = $auth_module->check_credentials ($user, $pass);
+        
+	if ( $ok ) {
+		$self->set_auth_user($user);
+		$self->set_is_authenticated(1);
+		$self->log("User '$user' successfully authorized");
+		return {
+			ok  => 1,
+			msg => "Credentials Ok",
+		};
+	} else {
+		$self->log("Illegal credentials for user '$user'");
+		return {
+			ok  => 0,
+			msg => "Illegal credentials",
+		};
+	}
+}
+
+sub create_new_object {
+	my $self = shift;
+	my ($request) = @_;
+
+	# Let's create a new object
+	my $class_method = $request->{method};
+	my $class = $class_method;
+	$class =~ s/::[^:]+$//;
+	$class_method =~ s/^.*:://;
+
+	# check if access to this class/method is allowed
+	if ( not defined $self->get_classes->{$class}->{$class_method} or
+	     $self->get_classes->{$class}->{$class_method} ne '_constructor' ) {
+		$self->log ("Illegal constructor access to $class->$class_method");
+		return {
+			ok  => 0,
+			msg => "Illegal constructor access to $class->$class_method"
+		};
+
+	}
+	
+	# load the class if not done yet
+	$self->load_class($class);
+
+	# resolve object params
+	$self->resolve_object_params ($request->{params});
+
+	# ok, the class is there, let's execute the method
+	my $object = eval {
+		$class->$class_method (@{$request->{params}})
+	};
+
+	# report error
+	if ( $@ ) {
+		$self->log ("Error: can't create object ".
+			    "($class->$class_method): $@");
+		return {
+			ok  => 0,
+			msg => $@,
+		};
+	}
+
+	# register object
+	$self->get_server->register_object ($object, $class);
+	$self->get_client_oids->{"$object"} = 1;
+
+	# log and return
+	$self->log (5,
+		"Created new object $class->$class_method with oid '$object'",
+	);
+
+	return {
+		ok  => 1,
+		oid => "$object",
+	};
+}
+
+sub load_class {
+	my $self = shift;
+	my ($class) = @_;
+	
+	my $mtime;
+	my $load_class_info = $self->get_loaded_classes->{$class};
+
+	if ( not $load_class_info or
+	     ( $self->get_server->get_auto_reload_modules &&
+	       ( $mtime = (stat($load_class_info->{filename}))[9])
+		  > $load_class_info->{mtime} ) ) {
+	
+		if ( not $load_class_info->{filename} ) {
+			my $filename;
+			my $rel_filename = $class;
+			$rel_filename =~ s!::!/!g;
+			$rel_filename .= ".pm";
+
+			foreach my $dir ( @INC ) {
+				$filename = "$dir/$rel_filename", last
+					if -f "$dir/$rel_filename";
+			}
+
+			croak "File for class '$class' not found"
+				if not $filename;
+			
+			$load_class_info->{filename} = $filename;
+			$load_class_info->{mtime} = 0;
+		}
+	
+		$mtime ||= 0;
+
+		$self->log (3, "Class '$class' ($load_class_info->{filename}) changed on disk. Reloading...")
+			if $mtime > $load_class_info->{mtime};
+
+		do $load_class_info->{filename};
+
+		if ( $@ ) {
+			$self->log ("Can't load class '$class': $@");
+			$load_class_info->{mtime} = 0;
+
+			return {
+				ok  => 0,
+				msg => "Can't load class $class: $@",
+			};
+
+		} else {
+			$self->log (3, "Class '$class' successfully loaded");
+			$load_class_info->{mtime} = time;
+		}
+	}
+	
+	$self->log (5, "filename=".$load_class_info->{filename}.
+		    ", mtime=".$load_class_info->{mtime} );
+
+	$self->get_loaded_classes->{$class} ||= $load_class_info;
+
+	1;
+}
+
+sub execute_object_method {
+	my $self = shift;
+	my ($request) = @_;
+
+	# Method call of an existent object
+	my $oid = $request->{oid};
+	my $object_entry = $self->get_objects->{$oid};
+	my $method = $request->{method};
+
+	if ( not defined $object_entry ) {
+		# object does not exists
+		$self->log ("Illegal access to unknown object with oid=$oid");
+		return {
+			ok  => 0,
+			msg => "Illegal access to unknown object with oid=$oid"
+		};
+
+	}
+	
+	my $class = $object_entry->{class};
+	if ( not defined $self->get_classes->{$class} or
+	     not defined $self->get_classes->{$class}->{$method} ) {
+		# illegal access to this method
+		$self->log ("Illegal access to $class->$method");
+		return {
+			ok  => 0,
+			msg => "Illegal access to $class->$method"
+		};
+
+	}
+	
+	# (re)load the class if not done yet
+	$self->load_class($class);
+
+	# resolve object params
+	$self->resolve_object_params ($request->{params});
+
+	# ok, try executing the method
+	my @rc = eval {
+		$object_entry->{object}->$method (@{$request->{params}})
+	};
+
+	# report error
+	if ( $@ ) {
+		$self->log ("Error: can't call '$method' of object ".
+			    "with oid=$oid: $@");
+		return {
+			ok  => 0,
+			msg => "$@",
+		};
+	}
+	
+	# log
+	$self->log (4, "Called method '$method' of object ".
+		       "with oid=$oid");
+
+	# check if objects are returned by this method
+	# and register them in our internal object table
+	# (if not already done yet)
+	my $key;
+	foreach my $rc ( @rc ) {
+		if ( ref ($rc) and ref ($rc) !~ /ARRAY|HASH|SCALAR/ ) {
+			# returns a single object
+			$self->log (4, "Method returns object: $rc");
+			$key = "$rc";
+			$self->get_client_oids->{$key} = 1;
+			$self->get_server->register_object($rc, ref $rc);
+			$rc = $key;
+
+		} elsif ( ref $rc eq 'ARRAY' ) {
+			# possibly returns a list of objects
+			# make a copy, otherwise the original object references
+			# will be overwritten
+			my @val = @{$rc};
+			$rc = \@val;
+			foreach my $val ( @val ) {
+				if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) {
+					$self->log (4, "Method returns object lref: $val");
+					$key = "$val";
+					$self->get_client_oids->{$key} = 1;
+					$self->get_server->register_object($val, ref $val);
+					$val = $key;
+				}
+			}
+		} elsif ( ref $rc eq 'HASH' ) {
+			# possibly returns a hash of objects
+			# make a copy, otherwise the original object references
+			# will be overwritten
+			my %val = %{$rc};
+			$rc = \%val;
+			foreach my $val ( values %val ) {
+				if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) {
+					$self->log (4, "Method returns object href: $val");
+					$key = "$val";
+					$self->get_client_oids->{$key} = 1;
+					$self->get_server->register_object($val, ref $val);
+					$val = $key;
+				}
+			}
+		}
+	}
+
+	# return rc
+	return {
+		ok => 1,
+		rc => \@rc,
+	};
+}
+
+sub object_destroyed_on_client {
+	my $self = shift;
+	my ($request) = @_;
+
+	$self->log(5, "Object with oid=$request->{oid} destroyed on client");
+
+	delete $self->get_client_oids->{$request->{oid}};
+	$self->get_server->deregister_object($request->{oid});
+
+	return {
+		ok => 1
+	};
+}
+
+sub get_classes_list {
+	my $self = shift;
+	my ($request) = @_;
+
+	my @classes = keys %{$self->get_classes};
+	
+	return {
+		ok      => 1,
+		classes => \@classes,
+	}
+}
+
+sub get_class_info {
+	my $self = shift;
+	my ($request) = @_;
+
+	my $class = $request->{class};
+	
+	if ( not defined $self->get_classes->{$class} ) {
+		$self->log ("Unknown class '$class'");
+		return {
+			ok  => 0,
+			msg => "Unknown class '$class'"
+		};
+	}
+	
+	$self->log (4, "Class info for '$class' requested");
+
+	return {
+		ok           => 1,
+		methods      => $self->get_classes->{$class},
+	};
+}
+
+sub get_class_info_all {
+	my $self = shift;
+	my ($request) = @_;
+
+	return {
+		ok             => 1,
+		class_info_all => $self->get_classes,
+	}
+}
+
+sub resolve_object_params {
+	my $self = shift;
+	my ($params) = @_;
+	
+	my $key;
+	foreach my $par ( @{$params} ) {
+		if ( defined $self->get_classes->{ref($par)} ) {
+			$key = ${$par};
+			$key = "$key";
+			croak "unknown object with key '$key'"
+				if not defined $self->get_objects->{$key};
+			$par = $self->get_objects->{$key}->{object};
+		}
+	}
+	
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Connection - Represents a RPC connection
+
+=head1 SYNOPSIS
+
+Note: you never create instances of this class in your own code,
+it's only used internally by Event::RPC::Server. But you may request
+connection objects using the B<connection_hook> of Event::RPC::Server
+and then having some read access on them.
+
+  my $connection = Event::RPC::Server::Connection->new (
+      $rpc_server, $client_socket
+  );
+
+As well you can get the currently active connection from your
+Event::RPC::Server object:
+
+  my $server     = Event::RPC::Server->instance;
+  my $connection = $server->get_active_connection;
+
+=head1 DESCRIPTION
+
+Objects of this class represents a connection from an Event::RPC::Client
+to an Event::RPC::Server instance. They live inside the server and
+the whole Client/Server protocol is implemented here.
+
+=head1 READ ONLY ATTRIBUTES
+
+The following attributes may be read using the corresponding
+get_ATTRIBUTE accessors:
+
+=over 4
+
+=item B<cid>
+
+The connection ID of this connection. A number which is unique
+for this server instance.
+
+=item B<server>
+
+The Event::RPC::Server instance this connection belongs to.
+
+=item B<is_authenticated>
+
+This boolean value reflects whether the connection is authenticated
+resp. whether the client passed correct credentials.
+
+=item B<auth_user>
+
+This is the name of the user who was authenticated successfully for
+this connection.
+
+=item B<client_oids>
+
+This is a hash reference of object id's which are in use by the client of
+this connection. Keys are the object ids, value is always 1.
+You can get the corresponding objects by using the
+
+  $connection->get_client_object($oid)
+
+method.
+
+Don't change anything in this hash, in particular don't delete or add
+entries. Event::RPC does all the necessary garbage collection transparently,
+no need to mess with that.
+
+=back
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut
+

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/LogConnection.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/LogConnection.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/LogConnection.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,112 @@
+package Event::RPC::LogConnection;
+
+use Carp;
+use Socket;
+
+my $LOG_CONNECTION_ID;
+
+sub get_cid			{ shift->{cid}				}
+sub get_sock			{ shift->{sock}				}
+sub get_server			{ shift->{server}			}
+
+sub get_watcher			{ shift->{watcher}			}
+sub set_watcher			{ shift->{watcher}		= $_[1]	}
+
+sub new {
+	my $class = shift;
+	my ($server, $sock) = @_;
+
+	my $cid = ++$LOG_CONNECTION_ID;
+	
+	my $self = bless {
+		cid     => $cid,
+		sock    => $sock,
+		server  => $server,
+		watcher => undef,
+	}, $class;
+
+	$self->{watcher} = $server->get_loop->add_io_watcher(
+		fh   => $sock,
+		poll => 'r',
+		cb   => sub { $self->input; 1 },
+		desc => "log reader $cid",
+	);
+
+	$self->get_server->log (2,
+		"Got new logger connection. Connection ID is $cid"
+	);
+
+	return $self;
+}
+
+sub disconnect {
+	my $self = shift;
+
+	my $sock = $self->get_sock;
+	$self->get_server->get_logger->remove_fh($sock)
+		if $self->get_server->get_logger;
+	$self->get_server->get_loop->del_io_watcher($self->get_watcher);
+	$self->set_watcher(undef);
+	close $sock;
+
+	$self->get_server->set_log_clients_connected ( $self->get_server->get_log_clients_connected - 1 );
+	delete $self->get_server->get_logging_clients->{$self->get_cid};
+	$self->get_server->log(2, "Log client disconnected");
+
+	1;
+}
+
+sub input {
+	my $self = shift;
+
+	my $buffer;
+
+	$self->disconnect
+		if not sysread($self->get_sock, $buffer, 4096);
+	
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::LogConnection - Represents a logging connection
+
+=head1 SYNOPSIS
+
+  # Internal module. No documented public interface.
+
+=head1 DESCRIPTION
+
+Objects of this class are created by Event::RPC server if a
+client connects to the logging port of the server. It's an
+internal module and has no public interface.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut
+

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Logger.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Logger.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Logger.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,220 @@
+# $Id: Logger.pm,v 1.4 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Logger;
+
+use strict;
+use FileHandle;
+
+sub get_filename		{ shift->{filename}			}
+sub get_filename_fh		{ shift->{filename_fh}			}
+
+sub get_fh_lref			{ shift->{fh_lref}			}
+sub get_min_level		{ shift->{min_level}			}
+
+sub set_fh_lref			{ shift->{fh_lref}		= $_[1]	}
+sub set_min_level		{ shift->{min_level}		= $_[1]	}
+
+
+sub new {
+	my $class = shift;
+	my %par = @_;
+	my  ($filename, $fh_lref, $min_level) =
+	@par{'filename','fh_lref','min_level'};
+
+	my $filename_fh;
+	if ( $filename ) {
+		$filename_fh = FileHandle->new;
+		open ($filename_fh, ">>$filename")
+			or die "can't write log $filename";
+		$filename_fh->autoflush(1);
+	}
+
+	if ( $fh_lref ) {
+		foreach my $fh ( @{$fh_lref} ) {
+			my $old_fh = select $fh;
+			$| = 1;
+			select $old_fh;
+		}
+	} else {
+		$fh_lref = [];
+	}
+
+	my $self = bless {
+		filename	=> $filename,
+		filename_fh	=> $filename_fh,
+		fh_lref		=> $fh_lref,
+		min_level	=> $min_level,
+	}, $class;
+	
+	return $self;
+}
+
+sub DESTROY {
+	my $self = shift;
+	
+	my $filename_fh = $self->get_filename_fh;
+	close $filename_fh if $filename_fh;
+
+	1;
+}
+
+sub log {
+	my $self = shift;
+	my ($level, $msg);
+	if ( @_ == 2 ) {
+		$level = $_[0];
+		$msg   = $_[1];
+	} else {
+		$level = 1;
+		$msg = $_[0];
+	}
+
+	return if $level > $self->get_min_level;
+	
+	$msg .= "\n" if $msg !~ /\n$/;
+
+	my $str = localtime(time)." [$level] $msg";
+
+	for my $fh ( @{$self->get_fh_lref} ) {
+		print $fh $str if $fh;
+	}
+
+	my $fh = $self->get_filename_fh;
+	print $fh $str if $fh;
+
+	1;
+}
+
+sub add_fh {
+	my $self = shift;
+	my ($fh) = @_;
+
+	push @{$self->get_fh_lref}, $fh;
+
+	1;
+}
+
+sub remove_fh {
+	my $self = shift;
+	my ($fh) = @_;
+
+	my $fh_lref = $self->get_fh_lref;
+
+	my $i;
+	for ( $i=0; $i<@{$fh_lref}; ++$i ) {
+		last if $fh_lref->[$i] eq $fh;
+	}
+
+	return if $i == @{$fh_lref};
+	splice @{$fh_lref}, $i, 1;
+	
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Logger - Logging facility for Event::RPC
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Server;
+  use Event::RPC::Logger;
+  
+  my $server = Event::RPC::Server->new (
+      ...
+      logger => Event::RPC::Logger->new(
+          filename  => "/var/log/myserver.log",
+	  fh_lref   => [ $fh, $sock ],
+	  min_level => 2,
+      ),
+      ...
+  );
+
+  $server->start;
+
+=head1 DESCRIPTION
+
+This modules implements a simple logging facility for the
+Event::RPC framework. Log messages may be written to a
+specific file and/or a bunch of filehandles, which may be
+sockets as well.
+
+=head1 CONFIGURATION OPTIONS
+
+This is a list of options you can pass to the new() constructor:
+
+=over 4
+
+=item B<filename>
+
+All log messages are appended to this file.
+
+=item B<fh_lref>
+
+All log messages are printed into this list of filehandles.
+
+=item B<min_level>
+
+This is the minimum log level. Output of messages with a lower level
+is suppressed. This option may be altered using set_min_level() even
+in a running server.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $logger->B<log> ( [$level, ] $msg )
+
+The log() method does the actual logging. Called with one argument
+the messages gets the default level of 1. With two argumens the first
+is the level for the message.
+
+=item $logger->B<add_fh> ( $fh )
+
+This adds a filehandle to the internal list of filhandles all log
+messages are written to.
+
+=item $logger->B<remove_fh> ( $fh )
+
+Removes a filehandle.
+
+=back
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Event.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Event.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Event.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,134 @@
+# $Id: Event.pm,v 1.2 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Loop::Event;
+
+use base qw( Event::RPC::Loop );
+
+use strict;
+use Event;
+
+sub add_io_watcher {
+	my $self = shift;
+	my %par = @_;
+	my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'};
+
+	return Event->io (
+		fd        => $fh,
+		poll      => $poll,
+		cb        => $cb,
+		desc      => $desc,
+		reentrant => 0,
+	);
+}
+
+sub del_io_watcher {
+	my $self = shift;
+	my ($watcher) = @_;
+
+	$watcher->cancel;
+
+	1;
+}
+
+sub add_timer {
+	my $self = shift;
+	my %par = @_;
+	my  ($interval, $after, $cb, $desc) =
+	@par{'interval','after','cb','desc'};
+
+	die "interval and after can't be used together"
+		if $interval && $after;
+
+	return Event->timer (
+		interval	=> $interval,
+		after		=> $after,
+		cb		=> $cb,
+		desc		=> $desc,
+	);
+}
+
+sub del_timer {
+	my $self = shift;
+	my ($timer) = @_;
+	
+	$timer->cancel;
+	
+	1;
+}
+
+sub enter {
+	my $self = shift;
+
+	Event::loop();
+
+	1;
+}
+
+sub leave {
+	my $self = shift;
+
+	Event::unloop_all("ok");
+
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Loop::Event - Event mainloop for Event::RPC
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Server;
+  use Event::RPC::Loop::Event;
+  
+  my $server = Event::RPC::Server->new (
+      ...
+      loop => Event::RPC::Loop::Event->new(),
+      ...
+  );
+
+  $server->start;
+
+=head1 DESCRIPTION
+
+This modules implements a mainloop using the Event module
+for the Event::RPC::Server module. It implements the interface
+of Event::RPC::Loop. Please refer to the manpage of
+Event::RPC::Loop for details.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Glib.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Glib.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop/Glib.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,150 @@
+# $Id: Glib.pm,v 1.2 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Loop::Glib;
+
+use base qw( Event::RPC::Loop );
+
+use strict;
+use Glib;
+
+sub get_glib_main_loop		{ shift->{glib_main_loop}		}
+sub set_glib_main_loop		{ shift->{glib_main_loop}	= $_[1]	}
+
+sub add_io_watcher {
+	my $self = shift;
+	my %par = @_;
+	my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'};
+
+	my $cond = $poll eq 'r' ?
+		['G_IO_IN', 'G_IO_HUP']:
+		['G_IO_OUT','G_IO_HUP'];
+	
+	return Glib::IO->add_watch ($fh->fileno, $cond, sub { &$cb(); 1 } );
+}
+
+sub del_io_watcher {
+	my $self = shift;
+	my ($watcher) = @_;
+
+	Glib::Source->remove ($watcher);
+
+	1;
+}
+
+sub add_timer {
+	my $self = shift;
+	my %par = @_;
+	my  ($interval, $after, $cb, $desc) =
+	@par{'interval','after','cb','desc'};
+
+	die "interval and after can't be used together"
+		if $interval && $after;
+
+	if ( $interval ) {
+		return Glib::Timeout->add (
+			$interval * 1000,
+			sub { &$cb(); 1 }
+		);
+	} else {
+		return Glib::Timeout->add (
+			$after * 1000,
+			sub { &$cb(); 0 }
+		);
+	}
+
+	1;
+}
+
+sub del_timer {
+	my $self = shift;
+	my ($timer) = @_;
+	
+	Glib::Source->remove($timer);
+	
+	1;
+}
+
+sub enter {
+	my $self = shift;
+	
+	Glib->install_exception_handler(sub {
+		print "Event::RPC::Loop::Glib caught an exception: $@\n";
+		1;
+	});
+	
+	my $main_loop = Glib::MainLoop->new;
+	$self->set_glib_main_loop($main_loop);
+	
+	$main_loop->run;
+
+	1;
+}
+
+sub leave {
+	my $self = shift;
+	
+	$self->get_glib_main_loop->quit;
+
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Loop::Glib - Glib mainloop for Event::RPC
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Server;
+  use Event::RPC::Loop::Glib;
+  
+  my $server = Event::RPC::Server->new (
+      ...
+      loop => Event::RPC::Loop::Glib->new(),
+      ...
+  );
+
+  $server->start;
+
+=head1 DESCRIPTION
+
+This modules implements a mainloop using Glib for the
+Event::RPC::Server module. It implements the interface
+of Event::RPC::Loop. Please refer to the manpage of
+Event::RPC::Loop for details.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Loop.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,176 @@
+# $Id: Loop.pm,v 1.2 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Loop;
+
+sub new {
+	my $class = shift;
+	return bless {}, $class;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Loop - Mainloop Abstraction layer for Event::RPC
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Server;
+  use Event::RPC::Loop::Glib;
+  
+  my $server = Event::RPC::Server->new (
+      ...
+      loop => Event::RPC::Loop::Glib->new(),
+      ...
+  );
+
+  $server->start;
+
+=head1 DESCRIPTION
+
+This modules defines the interface of Event::RPC's mainloop
+abstraction layer. It's a virtual class all mainloop modules
+should inherit from.
+
+=head1 INTERFACE
+
+The following methods need to be implemented:
+
+=over 4
+
+=item $loop->B<enter> ()
+
+Enter resp. start a mainloop.
+
+=item $loop->B<leave> ()
+
+Leave the mainloop, which was started with the enter() method.
+
+=item $watcher = $loop->B<add_io_watcher> ( %options )
+
+Add an I/O watcher. Options are passed as a hash of
+key/value pairs. The following options are known:
+
+=over 4
+
+=item B<fh>
+
+The filehandle to be watched.
+
+=item B<cb>
+
+This callback is called, without any parameters, if
+an event occured on the filehandle above.
+
+=item B<desc>
+
+A description of the watcher. Not necessarily implemented
+by all modules, so it may be ignored.
+
+=item B<poll>
+
+Either 'r', if your program reads from the filehandle, or 'w'
+if it writes to it.
+
+=back
+
+A watcher object is returned. What this exactly is depends
+on the implementation, so you can't do anything useful with
+it besides passing it back to del_io_watcher().
+
+=item $loop->B<del_io_watcher> ( $watcher )
+
+Deletes an I/O watcher which was added with $loop->add_io_watcher().
+
+=item $timer = $loop->B<add_timer> ( %options )
+
+This sets a timer, a subroutine called after a specific
+timeout or on a regularly basis with a fixed time interval.
+
+Options are passed as a hash of
+key/value pairs. The following options are known:
+
+=over 4
+
+=item B<interval>
+
+A time interval in seconds, may be fractional.
+
+=item B<after>
+
+Callback is called once after this amount of seconds,
+may be fractional.
+
+=item B<cb>
+
+The callback.
+
+=item B<desc>
+
+A description of the timer. Not necessarily implemented
+by all modules, so it may be ignored.
+
+=back
+
+A timer object is returned. What this exactly is depends
+on the implementation, so you can't do anything useful with
+it besides passing it back to del_io_timer().
+
+=item $loop->B<del_timer> ( $timer )
+
+Deletes a timer which was added with $loop->add_timer().
+
+=back
+
+=head1 DIRECT USAGE IN YOUR SERVER
+
+You may use the methods of Event::RPC::Loop by yourself
+if you like. This way your program keeps independent of
+the actual mainloop module in use, if the simplified
+interface of Event::RPC::Loop is sufficient for you.
+
+In your server program you access the actual mainloop 
+object this way:
+
+  my $loop = Event::RPC::Server->instance->get_loop;
+
+Naturally nothing speaks against making your program
+to work only with a specific mainloop implementation,
+if you need its features. In that case you may use
+the corresponding API directly (e.g. of Event or Glib),
+no need to access it through Event::RPC::Loop.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Message.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Message.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Message.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,194 @@
+# $Id: Message.pm,v 1.5 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Message;
+
+use Carp;
+use strict;
+use Storable;
+
+my $DEBUG = 0;
+
+sub get_sock			{ shift->{sock}				}
+
+sub get_buffer			{ shift->{buffer}			}
+sub get_length			{ shift->{length}			}
+sub get_written			{ shift->{written}			}
+
+sub set_buffer			{ shift->{buffer}		= $_[1]	}
+sub set_length			{ shift->{length}		= $_[1]	}
+sub set_written			{ shift->{written}		= $_[1]	}
+
+sub new {
+	my $class = shift;
+	my ($sock) = @_;
+
+	$sock->blocking(1);
+	
+	my $self = bless {
+		sock	=> $sock,
+		buffer	=> undef,
+		length	=> 0,
+		written => 0,
+	}, $class;
+
+	return $self;
+}
+
+sub read {
+	my $self = shift;
+
+	if ( not defined $self->{buffer} ) {
+		my $length_packed;
+		$DEBUG && print "DEBUG: going to read header...\n";
+		my $rc = sysread ($self->get_sock, $length_packed, 4);
+		$DEBUG && print "DEBUG: header read rc=$rc\n";
+		die "DISCONNECTED" if !(defined $rc) || $rc == 0;
+		$self->{length} = unpack("N", $length_packed);
+		$DEBUG && print "DEBUG: packet size=$self->{length}\n";
+		die "Incoming message too big"
+			if $self->{length} > 4194304;
+	}
+
+	my $buffer_length = length($self->{buffer}||'');
+
+	$DEBUG && print "DEBUG: going to read packet... (buffer_length=$buffer_length)\n";
+
+	my $rc = sysread (
+		$self->get_sock,
+		$self->{buffer},
+		$self->{length} - $buffer_length,
+		$buffer_length
+	);
+
+	$DEBUG && print "DEBUG: packet read rc=$rc\n";
+
+	return if not defined $rc;
+	die "DISCONNECTED" if $rc == 0;
+
+	$buffer_length = length($self->{buffer});
+
+	$DEBUG && print "DEBUG: more to read... ($self->{length} != $buffer_length)\n"
+		if $self->{length} != $buffer_length;
+
+	return if $self->{length} != $buffer_length;
+
+	$DEBUG && print "DEBUG: read finished, length=$buffer_length\n";
+
+	my $data = Storable::thaw($self->{buffer});
+
+	$self->{buffer} = undef;
+	$self->{length} = 0;
+
+	return $data;
+}
+
+sub read_blocked {
+	my $self = shift;
+	
+	my $rc;
+	$rc = $self->read while not defined $rc;
+	
+	return $rc;
+}
+
+sub write {
+	my $self = shift;
+	my ($data) = @_;
+
+	$DEBUG && print "DEBUG: going to write...\n";
+
+	if ( not defined $self->{buffer} ) {
+		my $packed = Storable::nfreeze ($data);
+		$self->{buffer} = pack("N", length($packed)).$packed;
+		$self->{length} = length($self->{buffer});
+		$self->{written} = 0;
+	}
+
+	my $rc = syswrite (
+		$self->get_sock,
+		$self->{buffer},
+		$self->{length}-$self->{written},
+		$self->{written},
+	);
+
+	$DEBUG && print "DEBUG: written rc=$rc\n";
+
+	return if not defined $rc;
+
+	$self->{written} += $rc;
+	
+	if ( $self->{written} == $self->{length} ) {
+		$DEBUG && print "DEBUG: write finished\n";
+		$self->{buffer} = undef;
+		$self->{length} = 0;
+		return 1;
+	}
+
+	$DEBUG && print "DEBUG: more to be written...\n";
+
+	return;
+}
+
+sub write_blocked {
+	my $self = shift;
+	my ($data) = @_;
+	
+	$self->write($data) and return;
+	
+	my $finished = 0;
+	$finished = $self->write while not $finished;
+	
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Message - Implementation of Event::RPC network protocol
+
+=head1 SYNOPSIS
+
+  # Internal module. No documented public interface.
+
+=head1 DESCRIPTION
+
+This module implements the network protocol of Event::RPC.
+Objects of this class are created internally by Event::RPC::Server
+and Event::RPC::Client and performs message passing over the
+network.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Server.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Server.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC/Server.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,838 @@
+# $Id: Server.pm,v 1.9 2006/02/27 14:33:37 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2006 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event::RPC::Server;
+
+use Event::RPC;
+use Event::RPC::Message;
+use Event::RPC::Connection;
+use Event::RPC::LogConnection;
+
+use Carp;
+use strict;
+use IO::Socket::INET;
+use Sys::Hostname;
+
+sub get_host			{ shift->{host}				}
+sub get_port			{ shift->{port}				}
+sub get_name			{ shift->{name}				}
+sub get_loop			{ shift->{loop}				}
+sub get_classes			{ shift->{classes}			}
+sub get_loaded_classes		{ shift->{loaded_classes}		}
+sub get_clients_connected	{ shift->{clients_connected}		}
+sub get_log_clients_connected	{ shift->{log_clients_connected}	}
+sub get_logging_clients		{ shift->{logging_clients}		}
+sub get_logger			{ shift->{logger}			}
+sub get_start_log_listener	{ shift->{start_log_listener}		}
+sub get_objects			{ shift->{objects}			}
+sub get_rpc_socket		{ shift->{rpc_socket}			}
+sub get_ssl			{ shift->{ssl}				}
+sub get_ssl_key_file		{ shift->{ssl_key_file}			}
+sub get_ssl_cert_file		{ shift->{ssl_cert_file}		}
+sub get_ssl_passwd_cb		{ shift->{ssl_passwd_cb}		}
+sub get_auth_required		{ shift->{auth_required}		}
+sub get_auth_passwd_href	{ shift->{auth_passwd_href}		}
+sub get_auth_module             { shift->{auth_module}                  }
+sub get_listeners_started	{ shift->{listeners_started}		}
+sub get_connection_hook		{ shift->{connection_hook}		}
+sub get_auto_reload_modules	{ shift->{auto_reload_modules}		}
+sub get_active_connection       { shift->{active_connection}            }
+
+sub set_host			{ shift->{host}			= $_[1]	}
+sub set_port			{ shift->{port}			= $_[1]	}
+sub set_name			{ shift->{name}			= $_[1]	}
+sub set_loop			{ shift->{loop}			= $_[1]	}
+sub set_classes			{ shift->{classes}		= $_[1]	}
+sub set_loaded_classes		{ shift->{loaded_classes}	= $_[1]	}
+sub set_clients_connected	{ shift->{clients_connected}	= $_[1]	}
+sub set_log_clients_connected	{ shift->{log_clients_connected}= $_[1]	}
+sub set_logging_clients		{ shift->{logging_clients}	= $_[1]	}
+sub set_logger			{ shift->{logger}		= $_[1]	}
+sub set_start_log_listener	{ shift->{start_log_listener}	= $_[1]	}
+sub set_objects			{ shift->{objects}		= $_[1]	}
+sub set_rpc_socket		{ shift->{rpc_socket}		= $_[1]	}
+sub set_ssl			{ shift->{ssl}			= $_[1]	}
+sub set_ssl_key_file		{ shift->{ssl_key_file}		= $_[1]	}
+sub set_ssl_cert_file		{ shift->{ssl_cert_file}	= $_[1]	}
+sub set_ssl_passwd_cb		{ shift->{ssl_passwd_cb}	= $_[1]	}
+sub set_auth_required		{ shift->{auth_required}	= $_[1]	}
+sub set_auth_passwd_href	{ shift->{auth_passwd_href}	= $_[1]	}
+sub set_auth_module             { shift->{auth_module}          = $_[1] }
+sub set_listeners_started	{ shift->{listeners_started}	= $_[1]	}
+sub set_connection_hook		{ shift->{connection_hook}	= $_[1]	}
+sub set_auto_reload_modules	{ shift->{auto_reload_modules}	= $_[1]	}
+sub set_active_connection       { shift->{active_connection}    = $_[1] }
+
+my $INSTANCE;
+sub instance { $INSTANCE }
+
+sub new {
+	my $class = shift;
+	my %par = @_;
+	my  ($host, $port, $classes, $name, $logger, $start_log_listener) =
+	@par{'host','port','classes','name','logger','start_log_listener'};
+	my  ($ssl, $ssl_key_file, $ssl_cert_file, $ssl_passwd_cb) =
+	@par{'ssl','ssl_key_file','ssl_cert_file','ssl_passwd_cb'};
+	my  ($auth_required, $auth_passwd_href, $auth_module, $loop) =
+	@par{'auth_required','auth_passwd_href','auth_module','loop'};
+	my  ($connection_hook, $auto_reload_modules) =
+	@par{'connection_hook','auto_reload_modules'};
+
+	$name ||= "Event-RPC-Server";
+	
+	if ( not $loop ) {
+		eval {
+		    require Event::RPC::Loop::Event;
+		    $loop = Event::RPC::Loop::Event->new;
+		};
+		if ( $@ ) {
+		    eval {
+			require Event::RPC::Loop::Glib;
+			$loop = Event::RPC::Loop::Glib->new;
+		    };
+		    if ( $@ ) {
+		    	die "It seems neither Event nor Glib are installed";
+		    }
+		}
+	}
+
+	my $self = bless {
+		host			=> $host,
+		port			=> $port,
+		name			=> $name,
+		classes			=> $classes,
+		logger			=> $logger,
+		start_log_listener	=> $start_log_listener,
+		loop			=> $loop,
+
+		ssl			=> $ssl,
+		ssl_key_file		=> $ssl_key_file,
+		ssl_cert_file		=> $ssl_cert_file,
+		ssl_passwd_cb		=> $ssl_passwd_cb,
+
+		auth_required		=> $auth_required,
+		auth_passwd_href	=> $auth_passwd_href,
+                auth_module             => $auth_module,
+
+		auto_reload_modules	=> $auto_reload_modules,
+		connection_hook		=> $connection_hook,
+
+		rpc_socket		=> undef,
+		loaded_classes		=> {},
+		objects			=> {},
+		logging_clients		=> {},
+		clients_connected	=> 0,
+		listeners_started	=> 0,
+		log_clients_connected	=> 0,
+                active_connection       => undef,
+	}, $class;
+
+	$INSTANCE = $self;
+
+	$self->log ($self->get_name." started");
+
+	return $self;
+}
+
+sub DESTROY {
+	my $self = shift;
+	
+	my $rpc_socket = $self->get_rpc_socket;
+	close ($rpc_socket) if $rpc_socket;
+	
+	1;
+}
+
+sub setup_listeners {
+	my $self = shift;
+
+	#-- Listener options
+	my $host      = $self->get_host;
+	my $port      = $self->get_port;
+	my @LocalHost = $host ? ( LocalHost => $host ) : ();
+	$host ||= "*";
+
+	#-- get event loop manager
+	my $loop = $self->get_loop;
+	
+	#-- setup rpc listener
+	my $rpc_socket;
+	if ( $self->get_ssl ) {
+		eval { require IO::Socket::SSL };
+		croak "SSL requested, but IO::Socket::SSL not installed" if $@;
+		croak "ssl_key_file not set"  unless $self->get_ssl_key_file;
+		croak "ssl_cert_file not set" unless $self->get_ssl_cert_file;
+
+		$rpc_socket = IO::Socket::SSL->new (
+			Listen    	=> SOMAXCONN,
+			@LocalHost,
+			LocalPort 	=> $port,
+			Proto     	=> 'tcp',
+			ReuseAddr       => 1,
+			SSL_verify_mode => 0x00,
+			SSL_key_file	=> $self->get_ssl_key_file,
+			SSL_cert_file	=> $self->get_ssl_cert_file,
+			SSL_passwd_cb	=> $self->get_ssl_passwd_cb,
+		) or die "can't start SSL RPC listener: $IO::Socket::SSL::ERROR";
+	} else {
+		$rpc_socket = IO::Socket::INET->new (
+			Listen    => SOMAXCONN,
+			@LocalHost,
+			LocalPort => $port,
+			Proto     => 'tcp',
+			ReuseAddr => 1,
+		) or die "can't start RPC listener: $!";
+	}
+
+	$self->set_rpc_socket($rpc_socket);
+
+	$loop->add_io_watcher (
+		fh	=> $rpc_socket,
+		poll	=> 'r',
+		cb	=> sub { $self->accept_new_client($rpc_socket); 1 },
+		desc	=> "rpc listener port $port",
+	);
+
+	if ( $self->get_ssl ) {
+		$self->log ("Started SSL RPC listener on port $host:$port");
+	} else {
+		$self->log ("Started RPC listener on $host:$port");
+	}
+
+	# setup log listener
+	if ( $self->get_start_log_listener ) {
+		my $log_socket = IO::Socket::INET->new (
+			Listen    => SOMAXCONN,
+			LocalPort => $port + 1,
+			@LocalHost,
+			Proto     => 'tcp',
+			ReuseAddr => 1,
+		) or die "can't start log listener: $!";
+
+		$loop->add_io_watcher (
+			fh	=> $log_socket,
+			poll	=> 'r',
+			cb	=> sub { $self->accept_new_log_client($log_socket); 1 },
+			desc	=> "log listener port ".($port+1),
+		);
+
+		$self->log ("Started log listener on $host:".($port+1));
+	}
+
+	$self->set_listeners_started(1);
+
+	1;
+}
+
+sub setup_auth_module {
+        my $self = shift;
+        
+        #-- Exit if no auth is required or setup already
+        return if not $self->get_auth_required;
+        return if     $self->get_auth_module;
+        
+        #-- Default to Event::RPC::AuthPasswdHash
+        require Event::RPC::AuthPasswdHash;
+
+        #-- Setup an instance
+        my $passwd_href = $self->get_auth_passwd_href;
+        my $auth_module = Event::RPC::AuthPasswdHash->new ($passwd_href);
+        $self->set_auth_module($auth_module);
+        
+        1;
+}
+
+sub start {
+	my $self = shift;
+
+	$self->setup_listeners
+		unless $self->get_listeners_started;
+
+        $self->setup_auth_module;
+
+	my $loop = $self->get_loop;
+
+	$self->log ("Enter main loop using ".ref($loop));
+
+	$loop->enter;
+
+	$self->log ("Server stopped");
+
+	1;
+}
+
+sub stop {
+	my $self = shift;
+
+	$self->get_loop->leave;
+	
+	1;
+}
+
+sub accept_new_client {
+	my $self = shift;
+	my ($rpc_socket) = @_;
+
+	my $client_socket = $rpc_socket->accept or return;
+
+	Event::RPC::Connection->new ($self, $client_socket);
+
+	$self->set_clients_connected ( 1 + $self->get_clients_connected );
+
+	1;
+}
+
+sub accept_new_log_client {
+	my $self = shift;
+	my ($log_socket) = @_;
+	
+	my $client_socket = $log_socket->accept or return;
+
+	my $log_client =
+		Event::RPC::LogConnection->new($self, $client_socket);
+
+	$self->set_log_clients_connected ( 1 + $self->get_log_clients_connected );
+	$self->get_logging_clients->{$log_client->get_cid} = $log_client;
+	$self->get_logger->add_fh($client_socket)
+		if $self->get_logger;
+
+	$self->log(2, "New log client connected");
+
+	1;
+}
+
+sub load_class {
+	my $self = shift;
+	my ($class) = @_;
+
+	Event::RPC::Connection->new ($self)->load_class($class);
+
+	return $class;
+}
+
+sub log {
+	my $self = shift;
+	my $logger = $self->get_logger;
+	return unless $logger;
+	$logger->log(@_);
+	1;
+}
+
+sub remove_object {
+	my $self = shift;
+	my ($object) = @_;
+	
+	my $objects = $self->get_objects;
+
+        if ( not $objects->{"$object"} ) {
+    	    warn "Object $object not registered";
+            return;
+        }
+
+	delete $objects->{"$object"};
+	
+	$self->log(5, "Object '$object' removed");
+
+	1;
+}
+
+sub register_object {
+	my $self = shift;
+	my ($object, $class) = @_;
+	
+	my $objects = $self->get_objects;
+
+	my $refcount;
+	if ( $objects->{"$object"} ) {
+		$refcount = ++$objects->{"$object"}->{refcount};
+	} else {
+		$refcount = 1;
+		$objects->{"$object"} = {
+			object   => $object,
+			class    => $class,
+			refcount => 1,
+		};
+	}
+	
+	$self->log(5, "Object '$object' registered. Refcount=$refcount");
+	
+	1;
+}
+
+sub deregister_object {
+	my $self = shift;
+	my ($object) = @_;
+	
+	my $objects = $self->get_objects;
+
+        if ( not $objects->{"$object"} ) {
+    	    warn "Object $object not registered";
+            return;
+        }
+
+	my $refcount = --$objects->{"$object"}->{refcount};
+
+	$self->log(5, "Object '$object' deregistered. Refcount=$refcount");
+
+	$self->remove_object($object) if $refcount == 0;
+		
+	1;
+}
+
+sub print_object_register {
+	my $self = shift;
+	
+	print "-"x70,"\n";
+
+	my $objects = $self->get_objects;
+	foreach my $oid ( sort keys %{$objects} ) {
+		print "$oid\t$objects->{$oid}->{refcount}\n";
+	}
+	
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Event::RPC::Server - Simple API for event driven RPC servers
+
+=head1 SYNOPSIS
+
+  use Event::RPC::Server;
+  use My::TestModule;
+
+  my $server = Event::RPC::Server->new (
+      #-- Required arguments
+      port               => 8888,
+      classes            => {
+        "My::TestModule" => {
+	  new      => "_constructor",
+	  get_data => 1,
+	  set_data => 1,
+	  clone    => "_object",
+	},
+      },
+
+      #-- Optional arguments
+      name                => "Test server",
+      logger              => Event::RPC::Logger->new(),
+      start_log_listener  => 1,
+
+      ssl                 => 1
+      ssl_key_file        => "server.key",
+      ssl_cert_file       => "server.crt",
+      ssl_passwd_cb       => sub { "topsecret" },
+
+      auth_required       => 1,
+      auth_passwd_href    => { $user => Event::RPC->crypt($user,$pass) },
+      auth_module         => Your::Own::Auth::Module->new(...),
+
+      loop                => Event::RPC::Loop::Event->new(),
+      
+      host                => "localhost",
+      auto_reload_modules => 1,
+      connection_hook     => sub { ... },
+  );
+
+  $server->start;
+
+  # and later from inside your server implementation
+  Event::RPC::Server->instance->stop;
+
+=head1 DESCRIPTION
+
+Use this module to add a simple to use RPC mechanism to your event
+driven server application.
+
+Just create an instance of the Event::RPC::Server class with a
+bunch of required settings. Then enter the main event loop through
+it, or take control over the main loop on your own if you like
+(refer to the MAINLOOP chapter for details).
+
+General information about the architecture of Event::RPC driven
+applications is collected in the Event::RPC manpage.
+
+=head1 CONFIGURATION OPTIONS
+
+All options described here may be passed to the new() constructor of
+Event::RPC::Server. As well you may set or modify them using set_OPTION style
+mutators, but not after start() or setup_listeners() was called!
+All options may be read using get_OPTION style accessors.
+
+=head2 REQUIRED OPTIONS
+
+If you just pass the required options listed beyond you have
+a RPC server which listens to a network port and allows everyone
+connecting to it to access a well defined list of classes and methods
+resp. using the correspondent server objects.
+
+There is no authentication or encryption active in this minimal
+configuration, so aware that this may be a big security risk!
+Adding security is easy, refer to the chapters about SSL and
+authentication.
+
+These are the required options:
+
+=over 4
+
+=item B<port>
+
+TCP port number of the RPC listener.
+
+=item B<classes>
+
+This is a hash ref with the following structure:
+
+  classes => {
+    "Class1" => {
+      new             => "_constructor",
+      simple_method   => 1,
+      object_returner => "_object",
+    },
+    "Class2" => { ... },
+    ...
+  },
+
+Each class which should be accessable for clients needs to
+be listed here at the first level, assigned a hash of methods
+allowed to be called. Event::RPC disuinguishes three types
+of methods by classifying their return value:
+
+=over 4
+
+=item B<Constructors>
+
+A constructor method creates a new object of the corresponding class
+and returns it. You need to assign the string "_constructor" to
+the method entry to mark a method as a constructor.
+
+=item B<Simple methods>
+
+What's simple about these methods is their return value: it's
+a scalar, array, hash or even any complex reference structure
+(Ok, not simple anymore ;), but in particular it returns B<NO> objects,
+because this needs to handled specially (see below).
+
+Declare simple methods by assigning 1 in the method declaration.
+
+=item B<Object returners>
+
+Methods which return objects need to be declared by assigning
+"_object" to the method name here. They're not bound to return
+just one scalar object reference and may return an array or list
+reference with a bunch of objects as well.
+
+=back
+
+=back
+
+=head2 SSL OPTIONS
+
+The client/server protocol of Event::RPC is not encrypted by default,
+so everyone listening on your network can read or even manipulate
+data. To prevent this efficiently you can enable SSL encryption.
+Event::RPC uses the IO::Socket::SSL Perl module for this.
+
+First you need to generate a server key and certificate for your server
+using the openssl command which is part of the OpenSSL distribution,
+e.g. by issueing these commands (please refer to the manpage of openssl
+for details - this is a very rough example, which works in general, but
+probably you want to tweak some parameters):
+
+  % openssl genrsa -des3 -out server.key 1024
+  % openssl req -new -key server.key -out server.csr
+  % openssl x509 -req -days 3600 -in server.csr \
+            -signkey server.key -out server.crt
+
+After executing these commands you have the following files
+
+  server.crt
+  server.key
+  server.csr
+
+Event::RPC needs the first two of them to operate with SSL encryption.
+
+To enable SSL encryption you need to pass the following options
+to the constructor:
+
+=over 4
+
+=item B<ssl>
+
+The ssl option needs to be set to 1.
+
+=item B<ssl_key_file>
+
+This is the filename of the server.key you generated with
+the openssl command.
+
+=item B<ssl_cert_file>
+
+This is the filename of the server.crt file you generated with
+the openssl command.
+
+=item B<ssl_passwd_cb>
+
+Your server key is encrypted with a password you entered during the
+key creation process described above. This callback must return
+it. Depending on how critical your application is you probably must
+request the password from the user during server startup or place it
+into a more or less secured file. For testing purposes you
+can specify a simple anonymous sub here, which just returns the
+password, e.g.
+
+  ssl_passwd_cb => sub { return "topsecret" }
+
+But note: having the password in plaintext in your program code is
+insecure!
+
+=back
+
+=head2 AUTHENTICATION OPTIONS
+
+SSL encryption is fine, now it's really hard for an attacker to
+listen or modify your network communication. But without any further
+configuration any user on your network is able to connect to your
+server. To prevent this users resp. connections to your server
+needs to be authenticated somehow.
+
+Since version 0.87 Event::RPC has an API to delegate authentication
+tasks to a module, which can be implemented outside Event::RPC.
+To be compatible with prior releases it ships the module
+Event::RPC::AuthPasswdHash which implements the old behaviour
+transparently.
+
+This default implementation is a simple user/password based model. For now
+this controls just the right to connect to your server, so knowing
+one valid user/password pair is enough to access all exported methods
+of your server. Probably a more differentiated model will be added later
+which allows granting access to a subset of exported methods only
+for each user who is allowed to connect.
+
+The following options control the authentication:
+
+=over 4
+
+=item B<auth_required>
+
+Set this to 1 to enable authentication and nobody can connect your server
+until he passes a valid user/password pair.
+
+=item B<auth_passwd_href>
+
+If you like to use the builtin Event::RPC::AuthPasswdHash module
+simply set this attribute. If you decide to use B<auth_module>
+(explained beyound) it's not necessary.
+
+B<auth_passwd_href> is a hash of valid user/password pairs. The password
+stored here needs to be encrypted using Perl's crypt() function, using
+the username as the salt.
+
+Event::RPC has a convenience function for generating such a crypted
+password, although it's currently just a 1:1 wrapper around Perl's
+builtin crypt() function, but probably this changes someday, so better
+use this method:
+
+  $crypted_pass = Event::RPC->crypt($user, $pass);
+
+This is a simple example of setting up a proper B<auth_passwd_href> with
+two users:
+
+  auth_passwd_href => {
+    fred => Event::RPC->crypt("fred", $freds_password),
+    nick => Event::RPC->crypt("nick", $nicks_password),
+  },
+
+=item B<auth_module>
+
+If you like to implement a more complex authentication method yourself
+you may set the B<auth_module> attribute to an instance of your class.
+For now your implementation just needs to have this method:
+
+  $auth_module->check_credentials($user, $pass)
+
+Aware that $pass is encrypted as explained above, so your original
+password needs to by crypted using Event::RPC->crypt as well, at
+least for the comparison itself.
+
+=back
+
+B<Note:> you can use the authentication module without SSL but aware that
+an attacker listening to the network connection will be able to grab
+the encrypted password token and authenticate himself with it to the
+server (replay attack). Probably a more sophisticated challenge/response
+mechanism will be added to Event::RPC to prevent this. But you definitely
+should use SSL encryption in a critical environment anyway, which renders
+grabbing the password from the net impossible.
+
+=head2 LOGGING OPTIONS
+
+Event::RPC has some logging abilities, primarily for debugging purposes.
+It uses a B<logger> for this, which is an object implementing the
+Event::RPC::Logger interface. The documentation of Event::RPC::Logger
+describes this interface and Event::RPC's logging facilities in general.
+
+=over 4
+
+=item B<logger>
+
+To enable logging just pass such an Event::RPC::Logger object to the
+constructor.
+
+=item B<start_log_listener>
+
+Additionally Event::RPC can start a log listener on the server's port
+number incremented by 1. All clients connected to this port (e.g. by
+using telnet) get the server's log output.
+
+Note: currently the logging port supports neither SSL nor authentication,
+so be careful enabling the log listener in critical environments.
+
+=back
+
+=head2 MAINLOOP OPTIONS
+
+Event::RPC derived it's name from the fact that it follows the event
+driven paradigm. There are several toolkits for Perl which allow
+event driven software development. Event::RPC has an abstraction layer
+for this and thus should be able to work with any toolkit.
+
+=over 4
+
+=item B<loop>
+
+This option takes an object of the loop abstraction layer you
+want to use. Currently the following modules are implemented:
+
+  Event::RPC::Loop::Event     Use the Event module
+  Event::RPC::Loop::Glib      Use the Glib module
+
+If B<loop> isn't set, Event::RPC::Server tries all supported modules
+in a row and aborts the program, if no module was found.
+
+More modules will be added in the future. If you want to implement one
+just take a look at the code in the modules above: it's really
+easy and I appreciate your patch. The interface is roughly described
+in the documentation of Event::RPC::Loop.
+
+=back
+
+If you use the Event::RPC->start() method as described in the SYNOPSIS
+Event::RPC will enter the correspondent main loop for you. If you want
+to have full control over the main loop, use this method to setup
+all necessary Event::RPC listeners:
+
+  $rpc_server->setup_listeners();
+
+and manage the main loop stuff on your own.
+
+=head2 MISCELLANEOUS OPTIONS
+
+=over 4
+
+=item B<host>
+
+By default the network listeners are bound to all interfaces
+in the system. Use the host option to bind to a specific
+interface, e.g. "localhost" if you efficently want to prevent
+network clients from accessing your server.
+
+=item B<auto_reload_modules>
+
+If this option is set Event::RPC::Server will check on each
+method call if the corresponding module changed on disk and
+reloads it automatically. Of course this has an effect on
+performance, but it's very useful during development. You
+probably shouldn't enable this in production environments.
+
+=item B<connection_hook>
+
+This callback is called on each connection / disconnection
+with two arguments: the Event::RPC::Connection object and
+a string containing either "connect" or "disconnect" depending
+what's currently happening with this connection.
+
+=head1 METHODS
+
+The following methods are publically available:
+
+=over 4
+
+=item Event::RPC::Server->B<instance>
+
+This returns the latest created Event::RPC::Server
+instance (usually you have only one instance in one program).
+
+=item $rpc_server->B<start>
+
+Start the mainloop of your Event::RPC::Server.
+
+=item $rpc_server->B<stop>
+
+Stops the mainloop which usually means, that the server exits,
+as long you don't do more sophisticated mainloop stuff by your own.
+
+=item $rpc_server->B<setup_listeners>
+
+This method initializes all networking listeners needed for
+Event::RPC::Server to work, using the configured loop module.
+Use this method if you don't use the start() method but manage
+the mainloop on your own.
+
+=item $rpc_server->B<log> ( [$level,] $msg )
+
+Convenience method for logging. It simply passes the arguments
+to the configured logger's log() method.
+
+=item $rpc_server->B<get_clients_connected>
+
+Returns the number of currently connected Event::RPC clients.
+
+=item $rpc_server->B<get_log_clients_connected>
+
+Returns the number of currently connected logging clients.
+
+=item $rpc_server->B<get_active_connection>
+
+This returns the currently active Event::RPC::Connection object
+representing the connection resp. the client which currently 
+requests method invocation. This is undef if no client call
+is active.
+
+=back
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/lib/Event/RPC.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,177 @@
+package Event::RPC;
+
+$VERSION  = "0.89";
+$PROTOCOL = "1.00";
+
+sub crypt {
+	my $class = shift;
+	my ($user, $pass) = @_;
+	return crypt($pass, $user);
+}
+
+__END__
+
+=head1 NAME
+
+Event::RPC - Event based transparent Client/Server RPC framework
+
+=head1 SYNOPSIS
+
+  #-- Server Code
+  use Event::RPC::Server;
+  use My::TestModule;
+  my $server = Event::RPC::Server->new (
+      port    => 5555,
+      classes => { "My::TestModule" => { ... } },
+  );
+  $server->start;
+
+  ----------------------------------------------------------
+  
+  #-- Client Code
+  use Event::RPC::Client;
+  my $client = Event::RPC::Client->new (
+      server   => "localhost",
+      port     => 5555,
+  );
+  $client->connect;
+
+  #-- Call methods of My::TestModule on the server
+  my $obj = My::TestModule->new ( foo => "bar" );
+  my $foo = $obj->get_foo;
+
+=head1 ABSTRACT
+
+Event::RPC supports you in developing Event based networking client/server applications with transparent object/method access from the client to the server. Network communication is optionally encrypted using IO::Socket::SSL. Several event loop managers are supported due to an extensible API. Currently Event and Glib are implemented.
+
+=head1 DESCRIPTION
+
+Event::RPC consists of a server and a client library. The server exports a list of classes and methods, which are allowed to be called over the network. More specific it acts as a proxy for objects created on the server side (on demand of the connected clients) which handles client side methods calls with transport of method arguments and return values.
+
+The object proxy handles refcounting and destruction of objects created by clients properly. Objects as method parameters and return values are handled as well (although with some limitations, see below).
+
+For the client the whole thing is totally transparent - once connected to the server it doesn't know whether it calls methods on local or remote objects.
+
+Also the methods on the server newer know whether they are called locally
+or from a connected client. Your application logic is not affected by Event::RPC at all, at least if it has a rudimentary clean OO design.
+
+For details on implementing servers and clients please refer to the man pages of Event::RPC::Server and Event::RPC::Client.
+
+=head1 REQUIREMENTS
+
+Event::RPC needs either one of the following modules on the server
+(they're not necessary on the client):
+
+  Event
+  Glib
+
+They're needed for event handling resp. mainloop implementation.
+If you like to use SSL encryption you need to install
+
+  IO::Socket::SSL
+
+As well Event::RPC makes heavy use of the
+
+  Storable
+
+module, which is part of the Perl standard library. It's important
+that both client and server use B<exactly the same version of the Storable
+module>! Otherwise Event::RPC client/server communication will fail badly.
+
+=head1 INSTALLATION
+
+You get the latest installation tarballs and online documentation
+at this location:
+
+  http://www.exit1.org/Event-RPC/
+
+If your system meets the requirements mentioned above, installation
+is just:
+
+  perl Makefile.PL
+  make test
+  make install
+
+=head1 EXAMPLES
+
+The tarball includes an examples/ directory which contains two
+programs:
+
+  server.pl
+  client.pl
+
+Just execute them with --help to get the usage. They do some very
+simple communication but are good to test your setup, in particular
+in a mixed environment.
+
+=head1 LIMITATIONS
+
+Although the classes and objects on the server are accessed
+transparently by the client there are some limitations should
+be aware of. With a clean object oriented design these should
+be no problem in real applications:
+
+=head2 Direct object data manipulation is forbidden
+
+All objects reside on the server and they keep there! The client
+just has specially wrapped proxy objects, which trigger the
+necessary magic to access the object's B<methods> on the server. Complete
+objects are never transferred from the server to the client,
+so something like this does B<not> work:
+
+  $object->{data} = "changed data";
+
+(assuming $object is a hash ref on the server).
+
+Only method calls are transferred to the server, so even for
+"simple" data manipulation a method call is necessary:
+
+  $object->set_data ("changed data");
+
+As well for reading an object attribute. Accessing a hash
+key will fail:
+
+  my $data = $object->{data};
+
+Instead call a method which returns the 'data' member:
+
+  my $data = $object->get_data;
+
+=head2 Methods may exchange objects, but not in a too complex structure
+
+Event::RPC handles methods which return objects. The only
+requirement is that they are declared as a B<Object returner>
+on the server (refer to Event::RPC::Server for details),
+but not if the object is hided inside a deep complex data structure.
+
+An array or hash ref of objects is Ok, but not more. This
+would require to much expensive runtime data inspection.
+
+Object receiving parameters are more restrictive,
+since even hiding them inside one array or hash ref is not allowed.
+They must be passed as a direkt argument of the method subroutine.
+
+=head1 AUTHORS
+
+  Jörn Reder <joern at zyn dot de>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2002-2006 by Jörn Reder.
+
+This library is free software; you can redistribute it and/or modify
+it under the terms of the GNU Library General Public License as
+published by the Free Software Foundation; either version 2.1 of the
+License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307
+USA.
+
+=cut

Added: packages/libevent-rpc-perl/branches/upstream/current/t/01.use.t
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/01.use.t	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/01.use.t	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,6 @@
+use strict;
+use Test::More tests => 2;
+
+use_ok('Event::RPC::Server');
+use_ok('Event::RPC::Client');
+

Added: packages/libevent-rpc-perl/branches/upstream/current/t/02.cnct.t
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/02.cnct.t	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/02.cnct.t	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,48 @@
+use strict;
+use Test::More;
+
+my $depend_modules = 0;
+eval { require Event } && ++$depend_modules;
+eval { require Glib }  && ++$depend_modules;
+
+if ( not $depend_modules ) {
+	plan skip_all => "Neither Event nor Glib installed";
+}
+
+plan tests => 5;
+
+my $PORT = 27811;
+
+# load client class
+use_ok('Event::RPC::Client');
+
+# start server in background, without logging
+require "t/Event_RPC_Test_Server.pm";
+Event_RPC_Test_Server->start_server (
+  p => $PORT,
+  S => 1,
+);
+
+# create client instance
+my $client = Event::RPC::Client->new (
+  host   => "localhost",
+  port   => $PORT,
+);
+
+# connect to server
+$client->connect;
+ok(1, "connected");
+
+# create instance of test class over RPC
+my $object = Event_RPC_Test->new (
+	data => "Some test data. " x 6
+);
+ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC");
+
+# disconnect client (this will also stop the server,
+# because we started it with the -S option)
+ok ($client->disconnect, "client disconnected");
+
+# wait on server to quit
+wait;
+ok (1, "stop server");

Added: packages/libevent-rpc-perl/branches/upstream/current/t/03.cnct-auth.t
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/03.cnct-auth.t	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/03.cnct-auth.t	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,61 @@
+use strict;
+
+use Test::More;
+
+my $depend_modules = 0;
+eval { require Event } && ++$depend_modules;
+eval { require Glib }  && ++$depend_modules;
+
+if ( not $depend_modules ) {
+	plan skip_all => "Neither Event nor Glib installed";
+}
+
+plan tests => 6;
+
+my $PORT = 27811;
+my $AUTH_USER = "foo";
+my $AUTH_PASS = "bar";
+
+# load client class
+use_ok('Event::RPC::Client');
+
+# start server in background, without logging
+require "t/Event_RPC_Test_Server.pm";
+Event_RPC_Test_Server->start_server (
+  p => $PORT,
+  a => "$AUTH_USER:$AUTH_PASS",
+  S => 2,
+);
+
+# create client instance
+my $client = Event::RPC::Client->new (
+  host      => "localhost",
+  port      => $PORT,
+  auth_user => $AUTH_USER,
+  auth_pass => "wrong",
+);
+
+# try to connect with wrong password
+eval { $client->connect };
+ok($@ ne '', "connection failed with wrong pw");
+
+# now set correct password
+$client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS));
+
+# connect to server with correct password
+$client->connect;
+ok(1, "connected");
+
+# create instance of test class over RPC
+my $object = Event_RPC_Test->new (
+	data => "Some test data. " x 6
+);
+ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC");
+
+# disconnect client (this will also stop the server,
+# because we started it with the -D option)
+ok ($client->disconnect, "client disconnected");
+
+# wait on server to quit
+wait;
+ok (1, "server stopped");

Added: packages/libevent-rpc-perl/branches/upstream/current/t/04.cnct-auth-ssl.t
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/04.cnct-auth-ssl.t	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/04.cnct-auth-ssl.t	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,67 @@
+use strict;
+
+use Test::More;
+
+my $depend_modules = 0;
+eval { require Event } && ++$depend_modules;
+eval { require Glib }  && ++$depend_modules;
+
+if ( not $depend_modules ) {
+	plan skip_all => "Neither Event nor Glib installed";
+}
+
+eval { require IO::Socket::SSL };
+if ( $@ ) {
+	plan skip_all => "IO::Socket::SSL required";
+}
+
+plan tests => 6;
+
+my $PORT = 27811;
+my $AUTH_USER = "foo";
+my $AUTH_PASS = "bar";
+
+# load client class
+use_ok('Event::RPC::Client');
+
+# start server in background, without logging
+require "t/Event_RPC_Test_Server.pm";
+Event_RPC_Test_Server->start_server (
+  p => $PORT,
+  a => "$AUTH_USER:$AUTH_PASS",
+  s => 1,
+  S => 1,
+);
+
+# create client instance
+my $client = Event::RPC::Client->new (
+  host      => "localhost",
+  port      => $PORT,
+  auth_user => $AUTH_USER,
+  auth_pass => "wrong pass",
+  ssl       => 1,
+);
+
+# try to connect with wrong password
+eval { $client->connect };
+ok($@ ne '', "connection failed with wrong pw");
+
+# now set correct password
+$client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS));
+
+# connect to server with correct password
+$client->connect;
+ok(1, "connected");
+
+# create instance of test class over RPC
+my $object = Event_RPC_Test->new (
+	data => "Some test data. " x 6
+);
+ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC");
+
+# disconnect client
+ok ($client->disconnect, "client disconnected");
+
+# wait on server to quit
+wait;
+ok (1, "server stopped");

Added: packages/libevent-rpc-perl/branches/upstream/current/t/05.func.t
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/05.func.t	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/05.func.t	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,104 @@
+use strict;
+use Test::More;
+
+my $depend_modules = 0;
+eval { require Event } && ++$depend_modules;
+eval { require Glib }  && ++$depend_modules;
+
+if ( not $depend_modules ) {
+	plan skip_all => "Neither Event nor Glib installed";
+}
+
+plan tests => 16;
+
+my $PORT = 27811;
+
+# load client class
+use_ok('Event::RPC::Client');
+
+# start server in background, without logging
+require "t/Event_RPC_Test_Server.pm";
+Event_RPC_Test_Server->start_server (
+  p => $PORT,
+  S => 1,
+);
+
+# create client instance
+my $client = Event::RPC::Client->new (
+  host     => "localhost",
+  port     => $PORT,
+);
+
+# count created objects
+my $object_cnt = 0;
+
+# connect to server
+$client->connect;
+ok(1, "connected");
+
+# create instance of test class over RPC
+my $data = "Some test data. " x 6;
+my $object = Event_RPC_Test->new (
+	data => $data
+);
+++$object_cnt;
+ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC");
+
+# test data
+ok ($object->get_data eq $data, "data member ok");
+
+# set data
+ok ($object->set_data("foo") eq "foo", "set data");
+
+# check set data
+ok ($object->get_data eq "foo", "get data");
+
+# object transfer
+my $clone;
+++$object_cnt;
+ok ( $clone = $object->clone, "object transfer");
+
+# check clone
+$clone->set_data("bar");
+ok ( $clone->get_data eq 'bar' &&
+     $object->get_data eq 'foo', "clone");
+
+
+# transfer a list of objects
+my ($lref, $href) = $object->multi(10);
+$object_cnt += 10;
+ok ( @$lref       == 10 && $lref->[5]->get_data == 5, "multi object list");
+ok ( keys(%$href) == 10 && $href->{4}->get_data == 4, "multi object hash");
+
+# complex parameter transfer
+my @params = (
+  "scalar", { 1 => "hash" }, [ "a", "list" ],
+);
+
+my @result = $object->echo(@params);
+
+ok ( @result == 3                &&
+     $result[0]      eq 'scalar' &&
+     ref $result[1]  eq 'HASH'   &&
+     $result[1]->{1} eq 'hash'   &&
+     ref $result[2]  eq 'ARRAY'  &&
+     $result[2]->[1] eq 'list'
+     ,
+     "complex parameter transfer"
+);
+
+# get connection cid
+ok ($object->get_cid == 1, "access connection object");
+
+# get client object cnt via connection
+ok ($object->get_object_cnt == $object_cnt, "client object cnt via connection");
+
+# check undef object returner
+ok (!defined $object->get_undef_object, "get undef from an object returner");
+
+# disconnect client
+ok ($client->disconnect, "client disconnected");
+
+# wait on server to quit
+wait;
+ok (1, "server stopped");

Added: packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,98 @@
+# $Id: Event_RPC_Test.pm,v 1.3 2006/02/24 14:28:44 joern Exp $
+
+#-----------------------------------------------------------------------
+# Copyright (C) 2002-2005 Jörn 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.
+#-----------------------------------------------------------------------
+
+package Event_RPC_Test;
+
+use strict;
+
+sub get_data			{ shift->{data}				}
+sub set_data			{ shift->{data}			= $_[1]	}
+
+sub new {
+	my $class = shift;
+	my %par = @_;
+	my ($data) = $par{'data'};
+
+	my $self = bless {
+		data	=> $data,
+	}, $class;
+	
+	return $self;
+}
+
+sub hello {
+	my $self = shift;
+	
+	return "I hold this data: '".$self->get_data."'";
+}
+
+sub quit {
+	my $self = shift;
+	
+	my $rpc_server = Event::RPC::Server->instance;
+	
+	$rpc_server->get_loop->add_timer (
+		after	=> 1,
+		cb	=> sub { $rpc_server->stop },
+	);
+	
+	return "Server stops in one second";
+}
+
+sub clone {
+	my $self = shift;
+	
+	my $clone = (ref $self)->new (
+		data => $self->get_data
+	);
+	
+	return $clone;
+}
+
+sub multi {
+	my $self = shift;
+	my ($num) = @_;
+	
+	my (@list, %hash);
+	while ($num) {
+		push @list, $hash{$num} = (ref $self)->new ( data => $num );
+		--$num;
+	}
+
+	return (\@list, \%hash);
+}
+
+sub echo {
+	my $self = shift;
+	my (@params) = @_;
+	return @params;
+}
+
+sub get_cid {
+        my $self = shift;
+        my $connection = Event::RPC::Server->instance->get_active_connection;
+        my $cid = $connection->get_cid;
+        return $cid;
+}
+
+sub get_object_cnt {
+        my $self = shift;
+        my $connection = Event::RPC::Server->instance->get_active_connection;
+        my $client_oids = $connection->get_client_oids;
+        my $cnt = keys %{$client_oids};
+        return $cnt;
+}
+
+sub get_undef_object {
+        return undef;
+}
+
+1;
+

Added: packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test_Server.pm
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test_Server.pm	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test_Server.pm	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,130 @@
+package Event_RPC_Test_Server;
+
+use strict;
+
+use Event::RPC::Server;
+use Event::RPC::Logger;
+use lib qw(t);
+
+sub start_server {
+    my $class = shift;
+    my %opts = @_;
+
+    #-- fork
+    my $server_pid = fork();
+    die "can't fork" unless defined $server_pid;
+    
+    #-- client tries to make a log connection to
+    #-- verify that the server is up and running
+    #-- (20 times with a usleep of 0.25, so the
+    #--  overall timeout is 10 seconds)
+    if ( $server_pid ) {
+        for ( 1..20 ) {
+	    eval {
+	        Event::RPC::Client->log_connect (
+		    server => "localhost",
+		    port   => $opts{p}+1,
+	        );
+	    };
+	    #-- return to client code if connect succeeded
+	    return if !$@;
+	    #-- bail out if the limit is reached
+	    if ( $_ == 20 ) {
+	        die "Couldn't start server";
+	    }
+	    #-- wait a quarter second...
+	    select(undef, undef, undef, 0.25);
+	}
+    }
+
+    #-- This code is mainly copied from the server.pl
+    #-- example and works with a command line style
+    #-- %opts hash
+    my %ssl_args;
+    if ( $opts{s} ) {
+      %ssl_args = (
+        ssl => 1,
+	ssl_key_file  => 't/ssl/server.key',
+	ssl_cert_file => 't/ssl/server.crt',
+	ssl_passwd_cb => sub { 'eventrpc' },
+      );
+      if ( not -f 't/ssl/server.key' ) {
+	print "please execute from toplevel directory\n";
+      }
+    }
+
+    my %auth_args;
+    if ( $opts{a} ) {
+      my ($user, $pass) = split(":", $opts{a}); 
+      $pass = Event::RPC->crypt($user, $pass);
+      %auth_args = (
+	auth_required    => 1,
+	auth_passwd_href => { $user => $pass },
+      );
+    }
+
+    #-- Create a logger object
+    my $logger = Event::RPC::Logger->new (
+	    min_level => (defined $opts{l} ? $opts{l} : 4),
+	    fh_lref   => [ \*STDOUT ],
+    );
+
+    #-- Create a loop object
+    my $loop;
+    my $loop_module = $opts{L};
+    if ( $loop_module ) {
+	    eval "use $loop_module";
+	    die $@ if $@;
+	    $loop = $loop_module->new();
+    }
+    
+    my $port = $opts{p} || 5555;
+    
+    my $disconnect_cnt = $opts{S};
+    
+    #-- Create a Server instance and declare the
+    #-- exported interface
+    my $server;
+    $server = Event::RPC::Server->new (
+      name               => "test daemon",
+      port               => $port,
+#      logger             => $logger,
+      loop               => $loop,
+      start_log_listener => 1,
+      %auth_args,
+      %ssl_args,
+      classes => {
+	'Event_RPC_Test'   => {
+	  new         	   => '_constructor',
+	  set_data    	   => 1,
+	  get_data    	   => 1,
+	  hello       	   => 1,
+	  quit	      	   => 1,
+	  clone	      	   => '_object',
+	  multi		   => '_object',
+	  echo		   => 1,
+          get_cid          => 1,
+          get_object_cnt   => 1,
+          get_undef_object => '_object',
+	},
+      },
+      connection_hook   => sub {
+      	  my ($conn, $event) = @_;
+	  return if $event eq 'connect';
+	  --$disconnect_cnt;
+	  $server->stop
+	      if $disconnect_cnt <= 0 &&
+	         $server->get_clients_connected == 0;
+	  1;
+      },
+    );
+
+    #-- Start the server resp. the Event loop.
+    $server->start;
+    
+    #-- Exit the program
+    exit;
+}
+
+1;
+


Property changes on: packages/libevent-rpc-perl/branches/upstream/current/t/Event_RPC_Test_Server.pm
___________________________________________________________________
Name: svn:executable
   + 

Added: packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.crt
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.crt	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.crt	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICozCCAgwCCQC7s/EOvPkeSTANBgkqhkiG9w0BAQQFADCBlTELMAkGA1UEBhMC
+REUxETAPBgNVBAgTCElyZ2VuZHdvMQ4wDAYDVQQHEwVLb2VsbjESMBAGA1UEChMJ
+ZXhpdDEub3JnMR0wGwYDVQQLExRTb2Z0d2FyZSBEZXZlbG9wbWVudDETMBEGA1UE
+AxQKSvZybiBSZWRlcjEbMBkGCSqGSIb3DQEJARYMam9lcm5AenluLmRlMB4XDTA1
+MDMxMzE3NDg1NloXDTE1MDEyMDE3NDg1NlowgZUxCzAJBgNVBAYTAkRFMREwDwYD
+VQQIEwhJcmdlbmR3bzEOMAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9y
+ZzEdMBsGA1UECxMUU29mdHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4g
+UmVkZXIxGzAZBgkqhkiG9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0B
+AQEFAAOBjQAwgYkCgYEApKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRh
+CCNfUufY8Jslmn/4hZI4wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35
+uWoMw343kZA4G6eLqjWVy8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8C
+AwEAATANBgkqhkiG9w0BAQQFAAOBgQAaahVlE9jXt0GO+Zk9ZDUmyiLQ31lhRbvr
+/fFqLYB3WS0xGnKKaj3IQFREkke7an4rhUaZLGstAhF3bXcN//t9bgZKQfnRPsM2
+bQHEVWAtwjebv0Rn0uR53gZBxoCHZyGwCL0Tj0Gvynpou4Y8UDGnfc1E/r+HOTCO
+yvVrQL359w==
+-----END CERTIFICATE-----

Added: packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.csr
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.csr	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.csr	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,12 @@
+-----BEGIN CERTIFICATE REQUEST-----
+MIIB1jCCAT8CAQAwgZUxCzAJBgNVBAYTAkRFMREwDwYDVQQIEwhJcmdlbmR3bzEO
+MAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9yZzEdMBsGA1UECxMUU29m
+dHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4gUmVkZXIxGzAZBgkqhkiG
+9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA
+pKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRhCCNfUufY8Jslmn/4hZI4
+wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35uWoMw343kZA4G6eLqjWV
+y8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8CAwEAAaAAMA0GCSqGSIb3
+DQEBBAUAA4GBAJmfq2IqvN+m9IIRzNTHBjEaOeYIEFVKcqWIiui/hvw8M7Yi0op2
+ifOjRKSfYTsgNAst1Ilwg6wgblSngg6f9GpGtWAYr1xQpoWS8PDaqjx1sLE40qi2
+aNrCtrSCLxzLh9o0qeUydcrjvIK6sWe6lGRntjNoj2VCqlBm0EFQ7vNF
+-----END CERTIFICATE REQUEST-----

Added: packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.key
===================================================================
--- packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.key	2006-04-13 22:37:18 UTC (rev 2571)
+++ packages/libevent-rpc-perl/branches/upstream/current/t/ssl/server.key	2006-04-15 18:15:22 UTC (rev 2572)
@@ -0,0 +1,18 @@
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-EDE3-CBC,CEB8A2E7F9C59066
+
+mUDYr4fgc2lba+qobTYxcq/8ZpRS1cdoiCe1QQeSQ2Bywrsgx8H40hqkBsKOYBPa
+ZFC+EEQTfhGOswTD5YsgqfTyWc7w0qlXDlPCVgV28r96gKzpP6oEDoclriWsToDF
+ZOsANyGcdl4D4VyY+oOf9crUFqIC4C/IfUJ++pZCUlGy8k/J0qHl/kCEP1bPg92q
+tKrG/gcDtrqnVHYB22MruAXHSAo4JOO7A6ZmrRGH4XY5SKGZPF/T7kwLLzEXbPq2
+MDrcPg3xWcCvODswrptdmK73PyF5oWkA7NXAofecu51jW1Y9G48p1lQi0mAgP3qP
+LDxCFQUU52G9UAxmfd8pZBSntRIsaIQV+6ffM8TemObgf1VkisCGDUCnEgvj2zDN
+AaieLhR4MKIQuYZSTLfCI5mKZK0vCFP5t19wK6Clt7p9bq1aUu8HkqEZ5yrNmf04
+acKvUkDbVCPL1pkAsyNAEQ4Zs3f3VxkuRrtf7gqzEEFK1TQoH7JmaALqGftgkPYJ
+eEYX8Om/Gr8NxTftSNbnoaFUyeoBOQ1iZY2g4qqE0rZlc7lfXiXAV3ajtgPcreZa
++uU4g8DF7zfQ7F8FK7w2ryLJFdlgk7SzEjv1VzCQTQ2MjBOCs0gJ3SPF6wx6lfyH
+9HqYRu2OwPJlaTzVrdhwKesROuBr1+rJym18uvzObSgkbTrFQuuYcR0dNbs+AuqQ
+dkhOC6bzpOdZNWVnVQ7klbsj8iUSMs4QnSI0+DpSls5VOMJiAXqPCAy4YJ0GAcGv
+EDF12ONiToyGb0Jolo+WOXyDebHR19TxokTcC5Ri7305mtRAP7g1fQ==
+-----END RSA PRIVATE KEY-----




More information about the Pkg-perl-cvs-commits mailing list