r32968 - in /branches/upstream/libpoe-component-ikc-perl/current: Changes IKC.pm IKC/Channel.pm IKC/Client.pm IKC/Responder.pm IKC/Server.pm META.yml
emhn-guest at users.alioth.debian.org
emhn-guest at users.alioth.debian.org
Fri Apr 10 00:11:32 UTC 2009
Author: emhn-guest
Date: Fri Apr 10 00:11:26 2009
New Revision: 32968
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32968
Log:
[svn-upgrade] Integrating new upstream version, libpoe-component-ikc-perl (0.2003)
Modified:
branches/upstream/libpoe-component-ikc-perl/current/Changes
branches/upstream/libpoe-component-ikc-perl/current/IKC.pm
branches/upstream/libpoe-component-ikc-perl/current/IKC/Channel.pm
branches/upstream/libpoe-component-ikc-perl/current/IKC/Client.pm
branches/upstream/libpoe-component-ikc-perl/current/IKC/Responder.pm
branches/upstream/libpoe-component-ikc-perl/current/IKC/Server.pm
branches/upstream/libpoe-component-ikc-perl/current/META.yml
Modified: branches/upstream/libpoe-component-ikc-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/Changes?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/Changes (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/Changes Fri Apr 10 00:11:26 2009
@@ -1,5 +1,17 @@
Revision history for Perl extension POE::Component::IKC.
+0.2003 03 April 2009
+ - IKC::Channel->spawn returns session ID
+ - Only keep channel IDs in IKC::Responder
+
+ - Several changes to improve shutdown behaviour :
+ - Register channels with the IKC::Responder before they negociate
+ - Shutdown a IKC::Client when its Channel closes, so that IKC
+ shutdown will also shutdown the channels
+ - Give Clients aliases to help debuging
+ - Shutdown IKC::Server when the last channel goes away and
+ there's no wheel
+
0.2002 26 November 2008
- Added call to $kernel->_data_sig_initialize, otherwise child processes
will never exit
Modified: branches/upstream/libpoe-component-ikc-perl/current/IKC.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/IKC.pm?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/IKC.pm (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/IKC.pm Fri Apr 10 00:11:26 2009
@@ -1,9 +1,9 @@
package POE::Component::IKC;
-# $Id: IKC.pm 322 2008-01-16 16:40:45Z fil $
+# $Id: IKC.pm 358 2009-04-03 07:25:38Z fil $
use strict;
use vars qw( $VERSION );
-$VERSION="0.2002";
+$VERSION="0.2003";
# Force CPAN to see this
Modified: branches/upstream/libpoe-component-ikc-perl/current/IKC/Channel.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/IKC/Channel.pm?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/IKC/Channel.pm (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/IKC/Channel.pm Fri Apr 10 00:11:26 2009
@@ -1,7 +1,7 @@
package POE::Component::IKC::Channel;
############################################################
-# $Id: Channel.pm 322 2008-01-16 16:40:45Z fil $
+# $Id: Channel.pm 358 2009-04-03 07:25:38Z fil $
# Based on tests/refserver.perl
# Contributed by Artur Bergman <artur at vogon-solutions.com>
# Revised for 0.06 by Rocco Caputo <troc at netrus.net>
@@ -44,7 +44,7 @@
my %p;
@p{qw(handle name on_connect subscribe rname unix aliases serializers)}
= @_;
- __PACKAGE__->spawn(%p);
+ return __PACKAGE__->spawn(%p);
}
sub spawn
@@ -52,7 +52,7 @@
my $package=shift;
my %params=@_;
- POE::Session->create(
+ return POE::Session->create(
inline_states => {
_start => \&channel_start,
_stop => \&channel_stop,
@@ -76,7 +76,7 @@
'sig_INT' => \&sig_INT
},
args => [\%params]
- );
+ )->ID;
}
#----------------------------------------------------
@@ -175,6 +175,7 @@
}
_set_phase($kernel, $heap, '000');
+ $kernel->call( 'IKC', 'register_channel' );
}
#----------------------------------------------------
@@ -321,7 +322,7 @@
}
}
else {
- warn "Recieved '$line' during phase 001\n";
+ warn "Received '$line' during phase 001\n";
# prod far side into saying something coherrent
$heap->{wheel_client}->put('NOT') unless $line eq 'NOT';
}
@@ -602,7 +603,8 @@
{
my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0];
- DEBUG && warn "$$: Recieved data...\n";
+ DEBUG &&
+ warn "$$: Received data...\n";
# we won't trust the other end to set this properly
$request->{errors_to}={ kernel=>$heap->{remote_ID},
session=>'IKC',
@@ -665,9 +667,11 @@
sub channel_close
{
my ($heap)=$_[HEAP];
- DEBUG &&
- warn "$$: channel_close *****************************************\n";
- $heap->{shutdown}=1;
+ unless( $heap->{shutdown} ) {
+ DEBUG &&
+ warn "$$: channel_close *****************************************\n";
+ $heap->{shutdown}=1;
+ }
_close_channel( $heap );
}
Modified: branches/upstream/libpoe-component-ikc-perl/current/IKC/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/IKC/Client.pm?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/IKC/Client.pm (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/IKC/Client.pm Fri Apr 10 00:11:26 2009
@@ -1,7 +1,7 @@
package POE::Component::IKC::Client;
############################################################
-# $Id: Client.pm 322 2008-01-16 16:40:45Z fil $
+# $Id: Client.pm 358 2009-04-03 07:25:38Z fil $
# Based on refserver.perl
# Contributed by Artur Bergman <artur at vogon-solutions.com>
# Revised for 0.06 by Rocco Caputo <troc at netrus.net>
@@ -75,18 +75,18 @@
}
$parms{serializers}=\@keep;
- POE::Session->create(
+ return POE::Session->create(
package_states => [ $parms{package} =>
- [qw(_start _stop error connected)]],
+ [qw(_start _stop _child error shutdown connected)]],
args => [\%parms]
- );
+ )->ID;
}
sub spawn
{
my($package, %params)=@_;
$params{package}=$package;
- create_ikc_client(%params);
+ return create_ikc_client(%params);
}
sub _package_exists
@@ -129,6 +129,8 @@
$heap->{on_connect}=$parms->{on_connect};
$heap->{on_error}=$parms->{on_error};
$heap->{name}=$parms->{name};
+ $heap->{alias} = "IKC Client $heap->{name}";
+ $kernel->alias_set( $heap->{alias} );
$heap->{subscribe}=$parms->{subscribe};
$heap->{aliases}=$parms->{aliases};
$heap->{serializers}=$parms->{serializers};
@@ -172,8 +174,8 @@
DEBUG and warn "Client connected\n";
- # give the connection to a channel
- create_ikc_channel($handle,
+ # give the connection to a Channel
+ $heap->{channel} = create_ikc_channel($handle,
@{$heap}{qw(name on_connect subscribe
remote_name unix aliases serializers)});
delete @{$heap}{qw(name on_connect subscribe remote_name wheel aliases
@@ -181,9 +183,34 @@
}
+sub shutdown
+{
+ my ($heap, $kernel) = @_[HEAP, KERNEL];
+ DEBUG and
+ warn "$heap Client shutdown";
+ if( $heap->{channel} ) {
+ $kernel->call( delete $heap->{channel} => 'shutdown' );
+ }
+ if( $heap->{alias} ) {
+ $kernel->alias_remove( delete $heap->{alias} );
+ }
+}
+
sub _stop
{
-# warn "$_[HEAP] client _stop\n";
+ DEBUG and warn "$_[HEAP] client _stop\n";
+}
+
+sub _child
+{
+ my( $heap, $reason, $child ) = @_[ HEAP, ARG0, ARG1 ];
+ $child = $child->ID;
+ DEBUG and warn "$heap $reason #$child";
+ return unless defined $heap->{channel};
+ if( $child eq $heap->{channel} and $reason eq 'lose' ) {
+ delete $heap->{channel};
+ $poe_kernel->yield( 'shutdown' );
+ }
}
1;
Modified: branches/upstream/libpoe-component-ikc-perl/current/IKC/Responder.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/IKC/Responder.pm?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/IKC/Responder.pm (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/IKC/Responder.pm Fri Apr 10 00:11:26 2009
@@ -1,7 +1,7 @@
package POE::Component::IKC::Responder;
############################################################
-# $Id: Responder.pm 322 2008-01-16 16:40:45Z fil $
+# $Id: Responder.pm 343 2009-03-20 07:51:40Z fil $
# Based on tests/refserver.perl
# Contributed by Artur Bergman <artur at vogon-solutions.com>
# Revised for 0.06 by Rocco Caputo <troc at netrus.net>
@@ -49,7 +49,8 @@
_start _stop
request post call raw_message post2
remote_error
- register unregister default register_local
+ register unregister register_local register_channel
+ default
publish retract subscribe unsubscribe
published
monitor inform_monitors shutdown
@@ -132,6 +133,16 @@
my($heap, $name) = @_[HEAP, ARG0];
$heap->{self}->default($name);
}
+
+#----------------------------------------------------
+# Register a channel. So we can tell it to shutdown before it finishes
+# negociating
+sub register_channel
+{
+ my($heap, $channel, $rid, $aliases) = @_[HEAP, SENDER, ARG0, ARG1];
+ $heap->{self}->register_channel($channel);
+}
+
##############################################################################
@@ -346,6 +357,7 @@
rsvp=>{},
kernel=>{},
channel=>{},
+ channel_startup=>{},
default=>{},
monitors=>{},
poe_kernel=>$kernel,
@@ -362,11 +374,23 @@
warn "$$: Some one wants us to go away... off we go\n";
# kill our alias
$kernel->alias_remove('IKC');
+
# tell every channel to shutdown
while(my($rid, $c)=each %{$self->{channel}}) {
- DEBUG and warn "$$: Posting shutdown to $rid (id=$c)\n";
+ DEBUG and
+ warn "$$: Posting shutdown to $rid (id=$c)\n";
$kernel->post($c, 'shutdown');
}
+ $self->{channel} = {};
+
+ # even the channels that haven't negociated yet
+ foreach my $c ( keys %{ $self->{channel_startup} } ) {
+ DEBUG and
+ warn "$$: Posting shutdown to channel (id=$c)\n";
+ $kernel->post( $c, 'shutdown' );
+ }
+ $self->{channel_startup} = {};
+
# tell monitors to shutdown
$self->inform_monitors('*', 'shutdown');
# kill pending subscription states
@@ -475,12 +499,16 @@
my($kernel)=@{$self}{qw(poe_kernel)};
+ $channel = $channel->ID;
+ delete $self->{channel_startup}{ $channel };
+
if($self->{channel}{$rid}) {
warn "$$: Remote kernel '$rid' already exists\n";
return;
}
else {
- DEBUG and warn "$$: Registered remote kernel '$rid'\n";
+ DEBUG and
+ warn "$$: Registered remote kernel '$rid' (id=$channel)\n";
$self->{channel}{$rid}=$channel;
$self->{remote}{$rid}=[]; # list of proxy sessions
$self->{alias}{$rid}=$aliases;
@@ -546,6 +574,19 @@
}
#----------------------------------------------------
+# Register a starting channel
+sub register_channel
+{
+ my( $self, $channel ) = @_;
+ $channel = $channel->ID;
+ DEBUG and
+ warn "$$: Registered channel (id=$channel)\n";
+ $self->{channel_startup}{ $channel } = 1;
+ return;
+}
+
+
+#----------------------------------------------------
sub default
{
my($self, $name) = @_;
@@ -572,6 +613,7 @@
my($self, $channel, $rid, $aliases)=@_;
my($kernel)=@{$self}{qw(poe_kernel)};
return unless $rid;
+ $channel = $channel->ID;
unless($aliases) {
unless($self->{channel}{$rid}) { # unregister one alias only
Modified: branches/upstream/libpoe-component-ikc-perl/current/IKC/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/IKC/Server.pm?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/IKC/Server.pm (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/IKC/Server.pm Fri Apr 10 00:11:26 2009
@@ -1,7 +1,7 @@
package POE::Component::IKC::Server;
############################################################
-# $Id: Server.pm 322 2008-01-16 16:40:45Z fil $
+# $Id: Server.pm 361 2009-04-03 07:37:32Z fil $
# Based on refserver.perl and preforkedserver.perl
# Contributed by Artur Bergman <artur at vogon-solutions.com>
# Revised for 0.06 by Rocco Caputo <troc at netrus.net>
@@ -60,7 +60,7 @@
package_states => [
$params{package} =>
[qw(
- _start _stop error
+ _start _stop error _child
accept fork retry waste_time
babysit rogues shutdown
sig_CHLD sig_INT sig_USR2 sig_USR1 sig_TERM
@@ -250,6 +250,22 @@
$kernel->yield('babysit');
}
return;
+}
+
+#------------------------------------------------------------------------------
+sub _child
+{
+ my( $heap, $kernel, $op, $child, $ret ) = @_[ HEAP, KERNEL, ARG0, ARG1, ARG2 ];
+ return unless $op eq 'lose';
+ DEBUG and
+ warn "$$: _child op=$op child=$child ret=$ret wheel=$heap->{wheel}";
+ unless( $heap->{wheel} ) { # no wheel == GAME OVER
+ DEBUG and
+ warn "$$: }}}}}}}}}}}}}}} Game over\n";
+ # TODO: Using shutdown is a stop-gap measure. Maybe the daemon
+ # wants to stay alive even if IKC was shutdown...
+ $kernel->call( IKC => 'shutdown' );
+ }
}
#------------------------------------------------------------------------------
@@ -314,7 +330,7 @@
# utime and stime are Linux-only :(
$time /= 1_000_000 if $time; # in micro-seconds
- if($time and $time > 600) { # arbitrary limit of 10 minutes
+ if($time and $time > 1200) { # arbitrary limit of 20 minutes
$rogues{$pid}=$table{$pid};
warn "$$: $pid has gone rogue, time=$time s\n";
} else {
@@ -531,8 +547,8 @@
if ($heap->{'is a child'}) {
if (--$heap->{connections} < 1) {
- # DEBUG and
- warn "$$: ************* Game over\n";
+ DEBUG and
+ warn "$$: {{{{{{{{{{{{{{{ Game over\n";
$kernel->delay('waste_time');
_delete_wheel( $heap );
@@ -768,18 +784,20 @@
my($verbose)=@_;
eval {
require POE::API::Peek;
- require POE::Component::Daemon;
};
if($@) {
DEBUG and warn "Failed to load POE::API::Peek: $@";
return;
}
- my $ret = Daemon->peek( $verbose );
-
- $ret =~ s/\n/\n$$: /g;
- warn "$$: $ret";
- return 1;
-
+ eval {
+ require POE::Component::Daemon;
+ };
+ unless( $@ ) {
+ my $ret = Daemon->peek( $verbose );
+ $ret =~ s/\n/\n$$: /g;
+ warn "$$: $ret";
+ return 1;
+ }
my $api=POE::API::Peek->new();
my @queue = $api->event_queue_dump();
@@ -809,7 +827,7 @@
$ret.="Keepalive " unless $verbose;
$ret.="Sessions: \n";
my $ses;
- foreach my $session ($api->session_list) {
+ foreach my $session ( sort { $a->ID <=> $b->ID } $api->session_list) {
my $ref=0;
$ses='';
@@ -844,7 +862,7 @@
$ref += $q1;
}
- my $q1 = $events->{ $session->ID }{destination};
+ $q1 = $events->{ $session->ID }{destination};
if( $q1 ) {
$ret.="\t\tEvent destination count: $q1 (Stay alive)\n";
$ref += $q1;
Modified: branches/upstream/libpoe-component-ikc-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-ikc-perl/current/META.yml?rev=32968&op=diff
==============================================================================
--- branches/upstream/libpoe-component-ikc-perl/current/META.yml (original)
+++ branches/upstream/libpoe-component-ikc-perl/current/META.yml Fri Apr 10 00:11:26 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: POE-Component-IKC
-version: 0.2002
+version: 0.2003
abstract: Inter-Kernel Communication for POE
license: perl
generated_by: ExtUtils::MakeMaker version 6.36
More information about the Pkg-perl-cvs-commits
mailing list