r22533 - in /branches/upstream/libevent-rpc-perl/current: ./ lib/Event/ lib/Event/RPC/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon Jun 30 18:06:07 UTC 2008
Author: gregoa
Date: Mon Jun 30 18:06:07 2008
New Revision: 22533
URL: http://svn.debian.org/wsvn/?sc=1&rev=22533
Log:
[svn-upgrade] Integrating new upstream version, libevent-rpc-perl (1.00)
Added:
branches/upstream/libevent-rpc-perl/current/t/06.object2.t
branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test2.pm
Modified:
branches/upstream/libevent-rpc-perl/current/Changes
branches/upstream/libevent-rpc-perl/current/MANIFEST
branches/upstream/libevent-rpc-perl/current/META.yml
branches/upstream/libevent-rpc-perl/current/README
branches/upstream/libevent-rpc-perl/current/lib/Event/RPC.pm
branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Client.pm
branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Connection.pm
branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Server.pm
branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test.pm
branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test_Server.pm
Modified: branches/upstream/libevent-rpc-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/Changes?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/Changes (original)
+++ branches/upstream/libevent-rpc-perl/current/Changes Mon Jun 30 18:06:07 2008
@@ -1,6 +1,15 @@
-$Id: Changes,v 1.14 2006/04/23 08:37:41 joern Exp $
+$Id: Changes,v 1.15 2008/06/21 12:44:49 joern Exp $
Revision history and release notes for Event::RPC:
+
+1.00 Sat Jun 21, 2008, joern
+ Notes:
+ - Time for version 1.00 ;)
+
+ Features:
+ - load_modules option added to Event::RPC::Server.
+ - timeout option added to Event::RPC::Client. Patch
+ by Strzelecki Lukasz <strzelec AT rswsystems.pl>.
0.90 Sun Apr 23, 2006, joern
Notes:
Modified: branches/upstream/libevent-rpc-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/MANIFEST?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/MANIFEST (original)
+++ branches/upstream/libevent-rpc-perl/current/MANIFEST Mon Jun 30 18:06:07 2008
@@ -19,7 +19,9 @@
t/03.cnct-auth.t
t/04.cnct-auth-ssl.t
t/05.func.t
+t/06.object2.t
t/Event_RPC_Test.pm
+t/Event_RPC_Test2.pm
t/Event_RPC_Test_Server.pm
t/ssl/server.crt
t/ssl/server.csr
Modified: branches/upstream/libevent-rpc-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/META.yml?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/META.yml (original)
+++ branches/upstream/libevent-rpc-perl/current/META.yml Mon Jun 30 18:06:07 2008
@@ -1,10 +1,12 @@
-# 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.90
-version_from: lib/Event/RPC.pm
-installdirs: site
-requires:
+--- #YAML:1.0
+name: Event-RPC
+version: 1.00
+abstract: ~
+license: ~
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
Event: 0
Glib: 0
IO::Socket::INET: 0
@@ -12,6 +14,6 @@
Net::SSLeay: 0
Storable: 0
Test::More: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libevent-rpc-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/README?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/README (original)
+++ branches/upstream/libevent-rpc-perl/current/README Mon Jun 30 18:06:07 2008
@@ -12,8 +12,8 @@
$server->start;
----------------------------------------------------------
-
- #-- Client Code
+
+ #-- Client Code
use Event::RPC::Client;
my $client = Event::RPC::Client->new (
server => "localhost",
Modified: branches/upstream/libevent-rpc-perl/current/lib/Event/RPC.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/lib/Event/RPC.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/lib/Event/RPC.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/lib/Event/RPC.pm Mon Jun 30 18:06:07 2008
@@ -1,6 +1,6 @@
package Event::RPC;
-$VERSION = "0.90";
+$VERSION = "1.00";
$PROTOCOL = "1.00";
sub crypt {
Modified: branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Client.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Client.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Client.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Client.pm Mon Jun 30 18:06:07 2008
@@ -1,4 +1,4 @@
-# $Id: Client.pm,v 1.12 2006/04/23 08:37:41 joern Exp $
+# $Id: Client.pm,v 1.14 2008/06/21 12:47:59 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -23,6 +23,7 @@
sub get_host { shift->{host} }
sub get_port { shift->{port} }
sub get_sock { shift->{sock} }
+sub get_timeout { shift->{timeout} }
sub get_classes { shift->{classes} }
sub get_class_map { shift->{class_map} }
sub get_loaded_classes { shift->{loaded_classes} }
@@ -38,6 +39,7 @@
sub set_host { shift->{host} = $_[1] }
sub set_port { shift->{port} = $_[1] }
sub set_sock { shift->{sock} = $_[1] }
+sub set_timeout { shift->{timeout} = $_[1] }
sub set_classes { shift->{classes} = $_[1] }
sub set_class_map { shift->{class_map} = $_[1] }
sub set_loaded_classes { shift->{loaded_classes} = $_[1] }
@@ -53,8 +55,8 @@
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 ($server, $host, $port, $classes, $class_map, $error_cb, $timeout) =
+ @par{'server','host','port','classes','class_map','error_cb','timeout'};
my ($ssl, $auth_user, $auth_pass) =
@par{'ssl','auth_user','auth_pass'};
@@ -70,6 +72,7 @@
host => $server,
server => $host,
port => $port,
+ timeout => $timeout,
classes => $classes,
class_map => $class_map,
ssl => $ssl,
@@ -88,9 +91,10 @@
croak "Client is already connected" if $self->get_connected;
- my $ssl = $self->get_ssl;
- my $server = $self->get_server;
- my $port = $self->get_port;
+ my $ssl = $self->get_ssl;
+ my $server = $self->get_server;
+ my $port = $self->get_port;
+ my $timeout = $self->get_timeout;
if ($ssl) {
eval { require IO::Socket::SSL };
@@ -103,19 +107,20 @@
Proto => 'tcp',
PeerPort => $port,
PeerAddr => $server,
- Type => SOCK_STREAM
- )
- or croak
- "Can't open SSL connection to $server:$port: $IO::Socket::SSL::ERROR";
+ Type => SOCK_STREAM,
+ Timeout => $timeout,
+ )
+ 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 - $!";
+ Type => SOCK_STREAM,
+ Timeout => $timeout,
+ )
+ or croak "Can't open connection to $server:$port - $!";
}
$sock->autoflush(1);
@@ -162,8 +167,8 @@
PeerPort => $port,
PeerAddr => $server,
Type => SOCK_STREAM
- )
- or croak "Can't open connection to $server:$port - $!";
+ )
+ or croak "Can't open connection to $server:$port - $!";
return $sock;
}
@@ -430,6 +435,7 @@
class_map => { "Event::RPC::Test" => "My::Event::RPC::Test" },
ssl => 1,
+ timeout => 10,
auth_user => "fred",
auth_pass => Event::RPC->crypt("fred",$password),
@@ -499,6 +505,17 @@
=back
+=head2 NETWORK OPTIONS
+
+=over 4
+
+=item B<timeout>
+
+Specify a timeout (in seconds), which is applied when connecting
+the server.
+
+=back
+
=head2 CLASS IMPORT OPTION
=over 4
Modified: branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Connection.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Connection.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Connection.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Connection.pm Mon Jun 30 18:06:07 2008
@@ -260,7 +260,7 @@
}
# load the class if not done yet
- $self->load_class($class);
+ $self->load_class($class) if $self->get_server->get_load_modules;
# resolve object params
$self->resolve_object_params ($request->{params});
@@ -387,7 +387,7 @@
}
# (re)load the class if not done yet
- $self->load_class($class);
+ $self->load_class($class) if $self->get_server->get_load_modules;
# resolve object params
$self->resolve_object_params ($request->{params});
Modified: branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Server.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Server.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Server.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/lib/Event/RPC/Server.pm Mon Jun 30 18:06:07 2008
@@ -1,4 +1,4 @@
-# $Id: Server.pm,v 1.10 2006/04/23 08:37:41 joern Exp $
+# $Id: Server.pm,v 1.12 2008/06/21 12:47:59 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
@@ -42,6 +42,7 @@
sub get_auth_module { shift->{auth_module} }
sub get_listeners_started { shift->{listeners_started} }
sub get_connection_hook { shift->{connection_hook} }
+sub get_load_modules { shift->{load_modules} }
sub get_auto_reload_modules { shift->{auto_reload_modules} }
sub get_active_connection { shift->{active_connection} }
@@ -67,6 +68,7 @@
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_load_modules { shift->{load_modules} = $_[1] }
sub set_auto_reload_modules { shift->{auto_reload_modules} = $_[1] }
sub set_active_connection { shift->{active_connection} = $_[1] }
@@ -82,11 +84,16 @@
@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'};
+ my ($connection_hook, $auto_reload_modules, $load_modules) =
+ @par{'connection_hook','auto_reload_modules','load_modules'};
$name ||= "Event-RPC-Server";
+ #-- for backwards compatibility 'load_modules' defaults to 1
+ if ( !exists $par{load_modules} ) {
+ $load_modules = 1;
+ }
+
if ( not $loop ) {
eval {
require Event::RPC::Loop::Event;
@@ -121,6 +128,7 @@
auth_passwd_href => $auth_passwd_href,
auth_module => $auth_module,
+ load_modules => $load_modules,
auto_reload_modules => $auto_reload_modules,
connection_hook => $connection_hook,
@@ -441,6 +449,7 @@
loop => Event::RPC::Loop::Event->new(),
host => "localhost",
+ load_modules => 1,
auto_reload_modules => 1,
connection_hook => sub { ... },
);
@@ -748,6 +757,12 @@
interface, e.g. "localhost" if you efficently want to prevent
network clients from accessing your server.
+=item B<load_modules>
+
+Control whether the class module files should be loaded
+automatically when first accesed by a client. This options
+defaults to true, for backward compatibility reasons.
+
=item B<auto_reload_modules>
If this option is set Event::RPC::Server will check on each
Added: branches/upstream/libevent-rpc-perl/current/t/06.object2.t
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/t/06.object2.t?rev=22533&op=file
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/t/06.object2.t (added)
+++ branches/upstream/libevent-rpc-perl/current/t/06.object2.t Mon Jun 30 18:06:07 2008
@@ -1,0 +1,66 @@
+#!/usr/bin/perl
+
+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 => 9;
+
+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 $data = "Some test data. " x 6;
+my $object = Event_RPC_Test->new (
+ data => $data
+);
+
+# check object
+ok($object->isa("Event_RPC_Test"), "object is Event_RPC_Test");
+
+# get another object from this object
+my $object2 = $object->get_object2;
+ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2");
+
+# check data of object2
+ok($object2->get_data eq 'foo', "object data is 'foo'");
+
+# create another object from this object
+$object2 = $object->new_object2($$);
+ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2");
+
+# check data of object2
+ok($object2->get_data == $$, "object data is $$");
+
+# disconnect client
+ok ($client->disconnect, "client disconnected");
+
+# wait on server to quit
+wait;
+ok (1, "server stopped");
Modified: branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test.pm Mon Jun 30 18:06:07 2008
@@ -1,4 +1,4 @@
-# $Id: Event_RPC_Test.pm,v 1.3 2006/02/24 14:28:44 joern Exp $
+# $Id: Event_RPC_Test.pm,v 1.4 2008/06/21 12:44:13 joern Exp $
#-----------------------------------------------------------------------
# Copyright (C) 2002-2005 Jörn Reder <joern AT zyn.de>.
@@ -10,10 +10,15 @@
package Event_RPC_Test;
+use Event_RPC_Test2;
+
use strict;
sub get_data { shift->{data} }
+sub get_object2 { shift->{object2} }
+
sub set_data { shift->{data} = $_[1] }
+sub set_object2 { shift->{object2} = $_[1] }
sub new {
my $class = shift;
@@ -22,6 +27,7 @@
my $self = bless {
data => $data,
+ object2 => Event_RPC_Test2->new("foo"),
}, $class;
return $self;
@@ -94,5 +100,11 @@
return undef;
}
+sub new_object2 {
+ my $class = shift;
+ my ($data) = @_;
+ return Event_RPC_Test2->new($data);
+}
+
1;
Added: branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test2.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test2.pm?rev=22533&op=file
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test2.pm (added)
+++ branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test2.pm Mon Jun 30 18:06:07 2008
@@ -1,0 +1,18 @@
+package Event_RPC_Test2;
+
+use strict;
+
+sub get_data { shift->{data} }
+sub set_data { shift->{data} = $_[1] }
+
+sub new {
+ my $class = shift;
+ my ($data) = @_;
+
+ return bless {
+ data => $data,
+ }, $class;
+}
+
+1;
+
Modified: branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test_Server.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test_Server.pm?rev=22533&op=diff
==============================================================================
--- branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test_Server.pm (original)
+++ branches/upstream/libevent-rpc-perl/current/t/Event_RPC_Test_Server.pm Mon Jun 30 18:06:07 2008
@@ -2,8 +2,6 @@
use strict;
-use Event::RPC::Server;
-use Event::RPC::Logger;
use lib qw(t);
sub start_server {
@@ -14,11 +12,12 @@
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)
+ #-- Client?
if ( $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)
for ( 1..20 ) {
eval {
Event::RPC::Client->log_connect (
@@ -35,7 +34,15 @@
#-- wait a quarter second...
select(undef, undef, undef, 0.25);
}
+ #-- Client is finished here
+ return;
}
+
+ #-- We're in the server
+ require Event::RPC::Server;
+ require Event::RPC::Logger;
+ require Event_RPC_Test;
+ require Event_RPC_Test2;
#-- This code is mainly copied from the server.pl
#-- example and works with a command line style
@@ -91,22 +98,30 @@
# logger => $logger,
loop => $loop,
start_log_listener => 1,
+ load_modules => 0,
%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',
- },
+ 'Event_RPC_Test' => {
+ new => '_constructor',
+ set_data => 1,
+ get_data => 1,
+ hello => 1,
+ quit => 1,
+ clone => '_object',
+ multi => '_object',
+ get_object2 => '_object',
+ new_object2 => '_object',
+ echo => 1,
+ get_cid => 1,
+ get_object_cnt => 1,
+ get_undef_object => '_object',
+ },
+ 'Event_RPC_Test2' => {
+ new => '_constructor',
+ set_data => 1,
+ get_data => 1,
+ },
},
connection_hook => sub {
my ($conn, $event) = @_;
More information about the Pkg-perl-cvs-commits
mailing list