Skip to content
Browse files

windows support tweaks and a UDP test

  • Loading branch information...
1 parent 5e07210 commit 6699d4db7deeb4b6703f00fdd1ff63ed2bee3be7 @rcaputo committed Jun 15, 2000
Showing with 272 additions and 40 deletions.
  1. +23 −15 Changes
  2. +2 −0 MANIFEST
  3. +3 −3 README
  4. +14 −6 lib/POE/Kernel.pm
  5. +1 −0 lib/POE/Session.pm
  6. +11 −4 lib/POE/Wheel/SocketFactory.pm
  7. +6 −12 mylib/TestSetup.pm
  8. +212 −0 tests/13_wheels_udp.t
View
38 Changes
@@ -20,8 +20,6 @@ subversions are available from <http://www.newts.org/~troc/poe.html>.
|
| Test $kernel->fork() or replace it entirely.
|
-| Test SocketFactory with UDP sockets.
-|
| After 0.11
|
| Split the samples out into a separate distribution.
@@ -30,6 +28,29 @@ subversions are available from <http://www.newts.org/~troc/poe.html>.
`-----------------
+0.1009 2000.??.??
+-----------------
+
+Optimized away a function in lib/TestSetup.pm.
+
+Added t/13_wheels_udp.t and a corresponding MANIFEST entry.
+
+Jonathan Feinber graciously provided a Windows NT shell for testing
+and development, opening whole new worlds of pain to me. :)
+
+Tweaked the Win32 FIONBIO ioctls for non-blocking filehandles in
+POE::Kernel and POE::Wheel::SocketFactory.
+
+Added t/00_coverage.t to the MANIFEST. Whoops!
+
+Added a crucial newline between 1; and __END__ in POE::Session.
+
+Jonathan Feinber reported that ActiveState 5.6.0, build 613 doesn't
+implement F_GETFL and F_SETFL. These constants aren't used for the
+MSWin32 code, so now POE::Kernel and POE::Wheel::SocketFactory define
+dummies for them.
+
+
0.1008 2000.06.14
-----------------
@@ -59,19 +80,6 @@ them. I thought this might be a Perl bug and posted to perl5-porters
about it. Wolfgang Laun and Nick Ing-Simmons sent back enlightening
replies, and the game once again is afoot!
-blessed coderefs never have DESTROY called upon them. This means that
-postbacks haven't ever worked correctly! Grrrr! Posted a test case
-to perl5-porters, avoiding perlbug because it's been flaky ever since
-5.6.0 was released.
-
-Simon suggested wrapping the coderef in an object and performing
-cleanup when the object's DESTROY method is called. I extrapolated a
-tied scalar from his advice, where the FETCH method returns its
-coderef. As an added bonus, I'm able to store the parent session's ID
-in the tied scalar's hidden data, eliminating the need for a "global"
-hash that maps postbacks to session IDs. Excellent! Thanks muchly,
-Simon; this has been bugging me for days!
-
0.1007 2000.06.07
-----------------
View
2 MANIFEST
@@ -57,6 +57,7 @@ samples/udp.perl
samples/watermarks.perl
samples/wheels.perl
samples/wheels2.perl
+t/00_coverage.t
t/01_sessions.t
t/02_alarms.t
t/03_aliases.t
@@ -69,3 +70,4 @@ t/09_wheels_unix.t
t/10_wheels_tcp.t
t/11_signals_poe.t
t/12_signals_ev.t
+t/13_wheels_udp.t
View
6 README
@@ -64,7 +64,7 @@ Test Results and Coverage
POE's development after 0.1005 consists of a big push to test
everything. To further this effort, the author wrote a test coverage
reporting program; then he discovered Devel::Coverage. Oh well!
-Anyway, here's the test coverage summary for this version:
+Anyway, here's the test coverage summary for version 0.1008:
Source File = Ran / Total = Covered
POE.pm = 19 / 19 = 100.00%
@@ -74,14 +74,14 @@ Anyway, here's the test coverage summary for this version:
POE/Filter/Line.pm = 15 / 20 = 75.00%
POE/Filter/Reference.pm = 4 / 66 = 6.06%
POE/Filter/Stream.pm = 2 / 11 = 18.18%
- POE/Kernel.pm = 616 / 908 = 67.84%
+ POE/Kernel.pm = 639 / 913 = 69.99%
POE/Preprocessor.pm = 119 / 134 = 88.81%
POE/Session.pm = 88 / 194 = 45.36%
POE/Wheel/FollowTail.pm = 5 / 65 = 7.69%
POE/Wheel/ListenAccept.pm = 5 / 43 = 11.63%
POE/Wheel/ReadWrite.pm = 99 / 183 = 54.10%
POE/Wheel/SocketFactory.pm = 187 / 267 = 70.04%
- All Told = 1229 / 2072 = 59.31%
+ All Told = 1253 / 2083 = 60.15%
Good luck, and thank you for reading!
View
20 lib/POE/Kernel.pm
@@ -251,7 +251,10 @@ BEGIN {
# defines EINPROGRESS as 10035. We provide it here because some
# Win32 users report POSIX::EINPROGRESS is not vendor-supported.
if ($^O eq 'MSWin32') {
- eval '*EINPROGRESS = sub { 10035 };'
+ eval '*EINPROGRESS = sub { 10036 };';
+ eval '*EWOULDBLOCK = sub { 10035 };';
+ eval '*F_GETFL = sub { 0 };';
+ eval '*F_SETFL = sub { 0 };';
}
}
@@ -1284,8 +1287,11 @@ sub run {
ASSERT_SELECT and do {
if ($hits < 0) {
- die "select error = $!\n"
- unless ( ($! == EINPROGRESS) or ($! == EINTR) );
+ die "select error: $!"
+ unless ( ($! == EINPROGRESS) or
+ ($! == EWOULDBLOCK) or
+ ($! == EINTR)
+ );
}
};
@@ -2207,9 +2213,11 @@ sub _internal_select {
if ($^O eq 'MSWin32') {
my $set_it = "1";
- # 126 is FIONBIO
- ioctl($handle, 126 | (ord('f')<<8) | (4<<16) | 0x80000000, $set_it)
- or croak "Can't set the handle non-blocking: $!\n";
+ # 126 is FIONBIO (some docs say 0x7F << 16)
+ ioctl( $handle,
+ 0x80000000 | (4<<16) | (ord('f')<<8) | 126,
+ $set_it
+ ) or die "Can't set the handle non-blocking: $!";
}
# Make the handle stop blocking, the POSIX way.
View
1 lib/POE/Session.pm
@@ -690,6 +690,7 @@ sub postback {
###############################################################################
1;
+
__END__
=head1 NAME
View
15 lib/POE/Wheel/SocketFactory.pm
@@ -20,7 +20,10 @@ BEGIN {
# defines EINPROGRESS as 10035. We provide it here because some
# Win32 users report POSIX::EINPROGRESS is not vendor-supported.
if ($^O eq 'MSWin32') {
- eval '*EINPROGRESS = sub { 10035 };'
+ eval '*EINPROGRESS = sub { 10036 };';
+ eval '*EWOULDBLOCK = sub { 10035 };';
+ eval '*F_GETFL = sub { 0 };';
+ eval '*F_SETFL = sub { 0 };';
}
}
@@ -384,8 +387,12 @@ sub new {
# Do it the Win32 way. XXX This is incomplete.
if ($^O eq 'MSWin32') {
my $set_it = "1";
- # 126 is FIONBIO
- ioctl($socket_handle, 126 | (ord('f')<<8) | (4<<16) | 0x80000000, $set_it)
+
+ # 126 is FIONBIO (some docs say 0x7F << 16)
+ ioctl( $socket_handle,
+ 0x80000000 | (4<<16) | (ord('f')<<8) | 126,
+ $set_it
+ )
or do {
$poe_kernel->yield($state_failure, 'ioctl', $!+0, $!);
return undef;
@@ -583,7 +590,7 @@ sub new {
# XXX EINPROGRESS is not included in ActiveState's POSIX.pm, and
# I don't know what AS's Perl uses instead. What to do here?
- if ($! and ($! != EINPROGRESS)) {
+ if ($! and ($! != EINPROGRESS) and ($! != EWOULDBLOCK)) {
$poe_kernel->yield($state_failure, 'connect', $!+0, $!);
return undef;
}
View
18 mylib/TestSetup.pm
@@ -48,19 +48,14 @@ sub stderr_resume {
open STDERR, '>&STDERR_HOLD' or print "cannot restore STDERR: $!";
}
-sub _display_result {
- my $test = shift;
- if (defined $test_results[$test]) {
- print $test_results[$test], "\n";
- }
- else {
- print "not ok $test # no test result\n";
- }
-}
-
sub results {
for (my $test = 1; $test < @test_results; $test++) {
- &_display_result($test);
+ if (defined $test_results[$test]) {
+ print $test_results[$test], "\n";
+ }
+ else {
+ print "not ok $test # no test result\n";
+ }
}
}
@@ -119,4 +114,3 @@ sub ok_unless {
}
1;
-
View
212 tests/13_wheels_udp.t
@@ -0,0 +1,212 @@
+#!/usr/bin/perl -w
+# $Id$
+
+# Exercises the wheels commonly used with UDP sockets.
+
+use strict;
+use lib qw(./lib ../lib);
+use TestSetup;
+use Socket;
+
+# Turn on all asserts.
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+use POE qw( Wheel::SocketFactory );
+
+my $max_send_count = 10;
+
+# Congratulations! We made it this far!
+&test_setup(13);
+
+###############################################################################
+# Both a UDP server and a client in one session. This is a contrived
+# example of using two sockets/filehandles at once.
+# samples/proxy.perl does something similar.
+
+sub udp_start {
+ my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+
+ $heap->{peer_a_setup_wheel} =
+ POE::Wheel::SocketFactory->new
+ ( BindAddress => '127.0.0.1',
+ BindPort => 0,
+ SocketProtocol => 'udp',
+ Reuse => 'yes',
+ SuccessState => 'ev_peer_a_socket',
+ FailureState => 'ev_peer_a_error',
+ );
+
+ $heap->{peer_b_setup_wheel} =
+ POE::Wheel::SocketFactory->new
+ ( BindAddress => '127.0.0.1',
+ BindPort => 0,
+ SocketProtocol => 'udp',
+ Reuse => 'yes',
+ SuccessState => 'ev_peer_b_socket',
+ FailureState => 'ev_peer_b_error',
+ );
+
+ $heap->{peer_a_recv_error} = 0;
+ $heap->{peer_a_send_error} = 0;
+ $heap->{peer_a_sock_error} = 0;
+
+ $heap->{peer_b_recv_error} = 0;
+ $heap->{peer_b_send_error} = 0;
+ $heap->{peer_b_sock_error} = 0;
+
+ $heap->{peer_a_send_count} = 0;
+ $heap->{peer_b_send_count} = 0;
+
+ &ok_if( 1, defined $heap->{peer_a_setup_wheel} );
+ &ok_if( 2, defined $heap->{peer_b_setup_wheel} );
+
+ $kernel->delay( ev_took_too_long => 5 );
+}
+
+sub udp_stop {
+ my $heap = $_[HEAP];
+
+ &ok_unless(5, $heap->{peer_a_recv_error});
+ &ok_unless(6, $heap->{peer_a_send_error});
+ &ok_unless(7, $heap->{peer_a_sock_error});
+
+ &ok_unless(8, $heap->{peer_b_recv_error});
+ &ok_unless(9, $heap->{peer_b_send_error});
+ &ok_unless(10, $heap->{peer_b_sock_error});
+
+ &ok_if( 11,
+ $heap->{peer_a_send_count} == $max_send_count,
+ "only sent $heap->{peer_a_send_count}"
+ );
+ &ok_if( 12, $heap->{peer_b_send_count} == $max_send_count,
+ "only sent $heap->{peer_b_send_count}"
+ );
+}
+
+sub udp_peer_a_socket {
+ my ($kernel, $heap, $socket) = @_[KERNEL, HEAP, ARG0];
+
+ &ok(3);
+
+ delete $heap->{peer_a_setup_wheel};
+ $heap->{peer_a_socket_handle} = $socket;
+ $kernel->select_read( $socket, 'ev_peer_a_input' );
+
+ if ( defined($heap->{peer_a_socket_handle}) and
+ defined($heap->{peer_b_socket_handle})
+ ) {
+ my $peer_b_address = getsockname($heap->{peer_b_socket_handle});
+ die unless defined $peer_b_address;
+ my ($peer_b_port, $peer_b_addr) = unpack_sockaddr_in($peer_b_address);
+ $heap->{peer_a_send_count}++;
+ send( $socket, '1: this is a test', 0, $peer_b_address )
+ or $heap->{peer_a_send_error}++;
+ }
+}
+
+sub udp_peer_b_socket {
+ my ($kernel, $heap, $socket) = @_[KERNEL, HEAP, ARG0];
+
+ &ok(4);
+
+ delete $heap->{peer_b_setup_wheel};
+ $heap->{peer_b_socket_handle} = $socket;
+ $kernel->select_read( $socket, 'ev_peer_b_input' );
+
+ if ( defined($heap->{peer_a_socket_handle}) and
+ defined($heap->{peer_b_socket_handle})
+ ) {
+ my $peer_a_address = getsockname($heap->{peer_a_socket_handle});
+ die unless defined $peer_a_address;
+ my ($peer_a_port, $peer_a_addr) = unpack_sockaddr_in($peer_a_address);
+ $heap->{peer_b_send_count}++;
+ send( $socket, '1: this is a test', 0, $peer_a_address )
+ or $heap->{peer_b_send_error}++;
+ }
+}
+
+sub udp_peer_a_error {
+ $_[HEAP]->{peer_a_sock_error}++;
+}
+
+sub udp_peer_b_error {
+ $_[HEAP]->{peer_b_sock_error}++;
+}
+
+sub udp_peer_a_input {
+ my ($kernel, $heap, $socket) = @_[KERNEL, HEAP, ARG0];
+
+ my $remote_socket = recv( $socket, my $message = '', 1024, 0 );
+
+ if (defined $remote_socket) {
+ if ($heap->{peer_a_send_count} < $max_send_count) {
+ $message =~ tr/a-zA-Z/n-za-mN-ZA-M/; # rot13
+ $heap->{peer_a_send_count}++;
+ send( $socket, $message, 0, $remote_socket )
+ or $heap->{peer_a_send_error}++;
+ }
+ else {
+ $kernel->select_read($socket);
+ }
+ }
+ else {
+ $heap->{peer_a_recv_error}++;
+ }
+}
+
+sub udp_peer_b_input {
+ my ($kernel, $heap, $socket) = @_[KERNEL, HEAP, ARG0];
+
+ my $remote_socket = recv( $socket, my $message = '', 1024, 0 );
+
+ if (defined $remote_socket) {
+ if ($heap->{peer_b_send_count} < $max_send_count) {
+ $message =~ tr/a-zA-Z/n-za-mN-ZA-M/; # rot13
+ $heap->{peer_b_send_count}++;
+ send( $socket, $message, 0, $remote_socket )
+ or $heap->{peer_b_send_error}++;
+ }
+ else {
+ $kernel->select_read($socket);
+ }
+ }
+ else {
+ $heap->{peer_b_recv_error}++;
+ }
+}
+
+sub udp_timeout {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ if (defined $heap->{peer_a_socket_handle}) {
+ $kernel->select($heap->{peer_a_socket_handle});
+ delete $heap->{peer_a_socket_handle};
+ }
+
+ if (defined $heap->{peer_b_socket_handle}) {
+ $kernel->select($heap->{peer_b_socket_handle});
+ delete $heap->{peer_b_socket_handle};
+ }
+}
+
+###############################################################################
+
+POE::Session->create
+ ( inline_states =>
+ { _start => \&udp_start,
+ _stop => \&udp_stop,
+ ev_took_too_long => \&udp_timeout,
+ ev_peer_a_socket => \&udp_peer_a_socket,
+ ev_peer_a_error => \&udp_peer_a_error,
+ ev_peer_a_input => \&udp_peer_a_input,
+ ev_peer_b_socket => \&udp_peer_b_socket,
+ ev_peer_b_error => \&udp_peer_b_error,
+ ev_peer_b_input => \&udp_peer_b_input,
+ },
+ );
+
+$poe_kernel->run();
+
+&ok(13);
+&results;
+
+exit;

0 comments on commit 6699d4d

Please sign in to comment.
Something went wrong with that request. Please try again.