Permalink
Browse files

Removed $kernel->fork(); added new tests to atone

  • Loading branch information...
rcaputo committed Jun 19, 2000
1 parent 1085c47 commit e0749fad458c2ec6df16e67bb9c87276207a5606
Showing with 277 additions and 128 deletions.
  1. +23 −3 Changes
  2. +2 −0 MANIFEST
  3. +8 −7 lib/POE.pm
  4. +63 −20 lib/POE/Filter/Block.pm
  5. +1 −1 lib/POE/Filter/Stream.pm
  6. +0 −92 lib/POE/Kernel.pm
  7. +0 −5 tests/14_wheels_ft.t
  8. +124 −0 tests/15_filter_block.t
  9. +56 −0 tests/16_filter_stream.t
View
26 Changes
@@ -18,21 +18,41 @@ subversions are available from <http://www.newts.org/~troc/poe.html>.
|
| After 0.11
|
-| Fix $kernel->fork() or take it out entirely.
| Filter::HTTPD test.
| Filter::Reference test.
-| Filter::Stream test.
| Wheel::ListenAccept test.
|
| Add new newlines to Filter::Line.
-| Add variable-length capability to Filter::Block.
|
| Split the samples out into a separate distribution.
| Revise the POE web pages.
|
`-----------------
+0.1010 2000.??.?? (!!!)
+-----------------------
+
+(!!!) I have nothing good to say about POE::Kernel's experimental
+fork() method, so I will refrain from saying anything more than "It
+has been removed." Please use plain fork(2).
+
+(!!!) Added variable-length block support to Filter::Block. In this
+mode, each item will be received the same as it was put(). This
+borrows heavily from Filter::Reference which did it first. Oh, the
+"!!!" is because Filter::Block's new() method doesn't default to
+512-byte blocks anymore; an unspecified/undefined BlockSize enables
+variable-length blocks, and a <1 BlockSize is an error.
+
+Added a new test, t/15_filter_block.t to exercise the block filter.
+
+Made Filter::Stream's put() method copy the chunks it's given rather
+than pass them on by reference. This seems to be the safest thing to
+do, but I'm not sure why I think so.
+
+Added a new test, t/16_filter_stream.t to exercise the stream filter.
+
+
0.1009 2000.06.17 (!!!)
-----------------------
View
@@ -73,3 +73,5 @@ t/11_signals_poe.t
t/12_signals_ev.t
t/13_wheels_udp.t
t/14_wheels_ft.t
+t/15_filter_block.t
+t/16_filter_stream.t
View
@@ -7,7 +7,7 @@ use strict;
use Carp;
use vars qw($VERSION);
-$VERSION = 0.1009;
+$VERSION = 0.1010;
sub import {
my $self = shift;
@@ -407,13 +407,14 @@ continue with it.
=head1 SAMPLE PROGRAMS
-The POE contains 28 sample programs as of this writing. They reside
-in the archive's ./poe/samples directory. The author is considering
-moving them to a separate distribution to cut back on the archive's
-size.
+The POE contains 28 sample programs as of this writing. Please be
+advised that some of them date from the early days of POE's
+development and may not exhibit the best coding practices.
-Please contact the author or the POE mailing list if you'd like to see
-something that isn't here.
+The samples reside in the archive's ./samples directory. The author
+is considering moving them to a separate distribution to cut back on
+the archive's size, but please contact him anyway if you'd like to see
+something that isn't there.
=head2 Tutorials
View
@@ -7,6 +7,7 @@ use Carp qw(croak);
sub BLOCK_SIZE () { 0 }
sub FRAMING_BUFFER () { 1 }
+sub EXPECTED_SIZE () { 2 }
#------------------------------------------------------------------------------
@@ -15,18 +16,16 @@ sub new {
croak "$type must be given an even number of parameters" if @_ & 1;
my %params = @_;
- my $block_size =
- ( (exists $params{BlockSize})
- ? ( ($params{BlockSize} < 1)
- ? 512
- : $params{BlockSize}
- )
- : 512
- );
+ my $block_size = $params{BlockSize};
+ if (exists($params{BlockSize}) and defined($block_size)) {
+ croak "$type doesn't support zero or negative block sizes"
+ if $block_size < 1;
+ }
my $self =
bless [ $block_size,
'',
+ undef,
], $type;
$self;
@@ -36,13 +35,35 @@ sub new {
sub get {
my ($self, $stream) = @_;
-
+ my @blocks;
$self->[FRAMING_BUFFER] .= join '', @{$stream};
- my @blocks;
- while (length($self->[FRAMING_BUFFER]) >= $self->[BLOCK_SIZE]) {
- push @blocks, substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]);
- substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]) = '';
+ # If a block size is specified, then frame input into blocks of that
+ # size.
+ if (defined $self->[BLOCK_SIZE]) {
+ while (length($self->[FRAMING_BUFFER]) >= $self->[BLOCK_SIZE]) {
+ push @blocks, substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]);
+ substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]) = '';
+ }
+ }
+
+ # Otherwise we're doing the variable-length block thing. Look for a
+ # length marker, and then pull off a chunk of that length. Repeat.
+
+ else {
+ while ( defined($self->[EXPECTED_SIZE]) ||
+ ( ($self->[FRAMING_BUFFER] =~ s/^(\d+)\0//s) &&
+ ($self->[EXPECTED_SIZE] = $1)
+ )
+ ) {
+ last if (length $self->[FRAMING_BUFFER] < $self->[EXPECTED_SIZE]);
+
+ my $chunk = substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]);
+ substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]) = '';
+ undef $self->[EXPECTED_SIZE];
+
+ push @blocks, $chunk;
+ }
}
\@blocks;
@@ -52,7 +73,24 @@ sub get {
sub put {
my ($self, $blocks) = @_;
- my @raw = join '', @{$blocks};
+ my @raw;
+
+ # If a block size is specified, then just assume the put is right.
+ # This will cause quiet framing errors on the receiving side. Then
+ # again, we'll have quiet errors if the block sizes on both ends
+ # differ. Ah, well!
+
+ if (defined $self->[BLOCK_SIZE]) {
+ @raw = join '', @$blocks;
+ }
+
+ # No specified block size. Do the variable-length block thing. This
+ # steals a lot of Artur's code from the Reference filter.
+
+ else {
+ @raw = map { length($_) . "\0" . $_; } @$blocks;
+ }
+
\@raw;
}
@@ -87,11 +125,12 @@ POE::Filter::Block - POE Block Protocol Abstraction
=head1 DESCRIPTION
-The Block filter translates streams to and from blocks of bytes of a
-specified size. If the size is not specified, 512 is used as default;
-if the given size is negative, the absolute value is used instead.
-Anyway, people trying to use negative blocksizes should be soundly
-spanked.
+The Block filter translates streams to and from blocks of bytes. If a
+block size is specified when the filter is constructed, then
+fixed-length blocks of that size will be built or parsed. Otherwise
+it builds and parses length-prepended variable-sized blocks. Programs
+that specify block sizes less than 1 byte are soundly spanked, just as
+they deserve.
Extra bytes are buffered until more bytes arrive to complete a block.
@@ -110,6 +149,10 @@ None known.
=head1 AUTHORS & COPYRIGHTS
-Please see the POE manpage.
+The Block filter was contributed by Dieter Pearcey, with changes by
+Rocco Caputo.
+
+Please see the POE manpage for more information about authors and
+contributors.
=cut
View
@@ -25,7 +25,7 @@ sub get {
sub put {
my ($self, $chunks) = @_;
- $chunks;
+ [ @$chunks ];
}
#------------------------------------------------------------------------------
View
@@ -2717,83 +2717,6 @@ sub refcount_decrement {
undef;
}
-#==============================================================================
-# Safe fork and SIGCHLD, theoretically. In practice, they seem to be
-# broken.
-#==============================================================================
-
-sub fork {
- my ($self) = @_;
-
- # Disable the real signal handler. How to warn the user this has
- # occurred?
- $SIG{CHLD} = 'DEFAULT' if exists $SIG{CHLD};
- $SIG{CLD} = 'DEFAULT' if exists $SIG{CLD};
-
- my $new_pid = fork();
-
- # Error.
- unless (defined $new_pid) {
- return( undef, $!+0, $! ) if wantarray;
- return undef;
- }
-
- # This is the parent process.
- if ($new_pid) {
-
- # Remember which session forked the process. POE will post
- # _signal CHLD at that session if it's still around when the child
- # process exits.
-
- $self->[KR_PROCESSES]->{$new_pid} = $self->[KR_ACTIVE_SESSION];
-
- # Remember that the session has a child process.
-
- $self->[KR_SESSIONS]->{ $self->[KR_ACTIVE_SESSION]
- }->[SS_PROCESSES]->{$new_pid} = 1;
-
- # Went from 0 to 1 child processes; start a poll loop. This uses
- # a very raw, basic form of POE::Kernel::delay.
-
- if (scalar(keys(%{$self->[KR_PROCESSES]})) == 1) {
- $self->_enqueue_state( $self, $self,
- EN_SCPOLL, ET_SCPOLL,
- [],
- time() + 1, (caller)[1,2]
- );
- }
-
- return( $new_pid, 0, 0 ) if wantarray;
- return $new_pid;
- }
-
- # This is the child process.
- else {
-
- # Build a unique list of sessions that have child processes.
-
- my %sessions;
- foreach (values %{$self->[KR_PROCESSES]}) {
- $sessions{$_}++;
- }
-
- # Make these sessions forget that they have child processes. This
- # will ensure that the real parent process (the parent of this
- # one) reaps the proper children.
-
- foreach my $session (keys %sessions) {
- $self->[KR_SESSIONS]->{$session}->[SS_PROCESSES] = { };
- }
-
- # Clean the POE::Kernel child-process table since this is a new
- # process without any children yet.
- $self->[KR_PROCESSES] = { };
-
- return( 0, 0, 0 ) if wantarray;
- return 0;
- }
-}
-
#==============================================================================
# HANDLERS
#==============================================================================
@@ -2865,12 +2788,6 @@ Methods to manage the process' global Kernel instance:
# dispatche events to.
$kernel->run( );
- # "Safe" fork. Safety comes from blocking SIGCHLD and starting an
- # internal waitpid loop to reap children. This is experimental and
- # may better be served with a high level fork/exec function.
- # Consider feedback to be solicited.
- $pid = $kernel->fork( );
-
FIFO event methods:
# Post an event to an arbitrary session.
@@ -3203,15 +3120,6 @@ stopped. It returns immediately if no sessions have yet been started.
The run() method does not return a meaningful value.
-=item fork
-
-POE::Kernel's fork mimics fork(2)'s semantics, returning the child's
-PID in the parent process, 0 in the child process, or undef if fork
-failed.
-
-It bypasses Perl's signal handling problems by polling for stopped
-children with waitpid(2).
-
=back
=head2 FIFO event methods
View
@@ -36,7 +36,6 @@ sub sss_new {
POE::Session->create
( inline_states =>
{ _start => \&sss_start,
- _stop => \&sss_stop,
got_block => \&sss_block,
got_flush => \&sss_flush,
ev_timeout => sub { delete $_[HEAP]->{wheel} },
@@ -67,10 +66,6 @@ sub sss_block {
$kernel->delay( ev_timeout => 2 );
}
-sub sss_stop {
- warn "session ", $_[SESSION]->ID, " read $_[HEAP]->{read_count} blocks";
-}
-
###############################################################################
# A TCP socket client.
Oops, something went wrong.

0 comments on commit e0749fa

Please sign in to comment.