Hi Stas,
Here's the patch for APR::Poll, complete with some documentation. I
haven't included your non-blocking protocol handler tests -- could you
paste them in when you make the commit to the tree?
Index: docs/api/APR/Socket.pod
===================================================================
RCS file: /home/cvspublic/modperl-docs/src/docs/2.0/api/APR/Socket.pod,v
retrieving revision 1.12
diff -d -u -r1.12 Socket.pod
--- docs/api/APR/Socket.pod 18 Aug 2004 01:39:32 -0000 1.12
+++ docs/api/APR/Socket.pod 3 Sep 2004 18:09:21 -0000
@@ -599,6 +599,63 @@
+=head2 C<poll>
+
+ $ret = $sock->poll($pool, $timeout, $events);
+
+=over 4
+
+=item obj: C<$sock>
+( C<L<APR::Socket object|docs::2.0::api::APR::Socket>> )
+
+The socket to poll
+
+=item arg1: C<$pool>
+( C<L<APR::Pool object|docs::2.0::api::APR::Pool>> )
+
+An apr_pool_t object -- in most applications, just use the pool
+provided by the
+C<L<Apache::Connection object|docs::2.0::api::Apache::Connection>>.
+
+=item arg2: C<$timeout> ( integer )
+
+The amount of time to wait (in milliseconds) for the specified events
+to occur.
+
+=item arg3: C<$events> ( integer )
+
+The events for which to wait. To wait for incoming data to be available,
+use APR::POLLIN. To wait until it's possible to write data to the socket,
+use APR::POLLOUT. And finally, to wait for priority data to become available,
+use APR::POLLPRI.
+
+=item ret: C<$ret> ( integer )
+
+=item since: 1.99_17-dev
+
+=back
+
+Examples:
+
+ use APR::Socket ();
+ use APR::Const -compile => qw(POLLIN SUCCESS TIMEUP);
+ use APR::Connection ();
+
+ my $rc = $sock->poll($connection->pool(), 1_000_000, APR::POLLIN);
+ if ($rc == APR::SUCCESS) {
+ # Data is waiting on the socket to be read.
+ }
+ elsif ($rc == APR::TIMEUP) {
+ # One second elapsed and still there is no data waiting to be
+ # read.
+ }
+ else {
+ die "something weird happened: " . APR::Error::strerror($rc);
+ }
+
+=back
+
+
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.11
diff -d -u -r1.11 APR__Socket.h
--- xs/APR/Socket/APR__Socket.h 9 Jun 2004 14:46:22 -0000 1.11
+++ xs/APR/Socket/APR__Socket.h 3 Sep 2004 18:09:22 -0000
@@ -96,3 +96,23 @@
MP_RUN_CROAK(apr_socket_opt_set(socket, opt, val),
"APR::Socket::opt_set");
}
+
+static MP_INLINE
+apr_int32_t mpxs_APR__Socket_poll(pTHX_ apr_socket_t *socket,
+ apr_pool_t *pool,
+ apr_interval_time_t timeout,
+ apr_int16_t reqevents)
+{
+ apr_pollfd_t fd;
+ apr_int32_t nsds;
+
+ /* Set up the aprset parameter, which tells apr_poll what to poll */
+ fd.desc_type = APR_POLL_SOCKET;
+ fd.reqevents = reqevents;
+ fd.rtnevents = 0; /* XXX: not really necessary to set this */
+ fd.p = pool;
+ fd.desc.s = socket;
+
+ /* Poll the socket */
+ return apr_poll(&fd, 1, &nsds, timeout);
+}
Index: xs/APR/aprext/Makefile.PL
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/APR/aprext/Makefile.PL,v
retrieving revision 1.5
diff -d -u -r1.5 Makefile.PL
--- xs/APR/aprext/Makefile.PL 1 Aug 2004 19:44:01 -0000 1.5
+++ xs/APR/aprext/Makefile.PL 3 Sep 2004 18:09:22 -0000
@@ -19,7 +19,7 @@
$src{$cfile} = "$srcdir/$cfile";
}
-my @skip = qw(dynamic test);
+my @skip = qw(test);
push @skip, q{static}
unless (Apache::Build::BUILD_APREXT);
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.85
diff -d -u -r1.85 apr_functions.map
--- xs/maps/apr_functions.map 25 Aug 2004 22:32:01 -0000 1.85
+++ xs/maps/apr_functions.map 3 Sep 2004 18:09:22 -0000
@@ -3,16 +3,16 @@
# for mapping see %ModPerl::MapUtil::disabled_map in
# lib/ModPerl/MapUtil.pm
-!MODULE=APR::Poll
- apr_poll_socket_add
- apr_poll_socket_clear
- apr_poll_data_get
- apr_poll_revents_get
- apr_poll_socket_mask
- apr_poll
- apr_poll_socket_remove
- apr_poll_data_set
- apr_poll_setup
+MODULE=APR::Poll
+? apr_poll_poll
+? apr_poll_socket_add
+? apr_poll_socket_clear
+? apr_poll_data_get
+? apr_poll_revents_get
+? apr_poll_socket_mask
+? apr_poll_socket_remove
+? apr_poll_data_set
+? apr_poll_setup
!MODULE=APR::Time
-apr_ctime
@@ -72,6 +72,8 @@
-apr_socket_sendfile
-apr_socket_sendv
!apr_socket_from_file
+ mpxs_APR__Socket_poll | | apr_socket_t *:socket, apr_pool_t *:pool, \
+ apr_interval_time_t:timeout, apr_int16_t:reqevents
MODULE=APR::SockAddr
!apr_sockaddr_info_get
Index: xs/tables/current/Apache/ConstantsTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/ConstantsTable.pm,v
retrieving revision 1.42
diff -d -u -r1.42 ConstantsTable.pm
--- xs/tables/current/Apache/ConstantsTable.pm 13 Aug 2004 00:13:18 -0000 1.42
+++ xs/tables/current/Apache/ConstantsTable.pm 3 Sep 2004 18:09:22 -0000
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by Apache::ParseSource/0.02
-# ! Thu Aug 12 17:10:15 2004
+# ! Mon Aug 30 11:29:14 2004
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -388,6 +388,7 @@
'APR_DELONCLOSE'
],
'error' => [
+ 'APR_END',
'APR_ENOSTAT',
'APR_ENOPOOL',
'APR_EBADDATE',
@@ -443,8 +444,7 @@
'APR_EFTYPE',
'APR_EPIPE',
'APR_EXDEV',
- 'APR_ENOTEMPTY',
- 'APR_END'
+ 'APR_ENOTEMPTY'
],
'common' => [
'APR_SUCCESS'
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.176
diff -d -u -r1.176 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 25 Aug 2004 22:32:01 -0000 1.176
+++ xs/tables/current/ModPerl/FunctionTable.pm 3 Sep 2004 18:09:23 -0000
@@ -7660,6 +7660,28 @@
'name' => 'func'
}
]
+ },
+ {
+ 'return_type' => 'apr_int32_t',
+ 'name' => 'mpxs_APR__Socket_poll',
+ 'args' => [
+ {
+ 'type' => 'apr_socket_t *',
+ 'name' => 'socket'
+ },
+ {
+ 'type' => 'apr_pool_t *',
+ 'name' => 'pool'
+ },
+ {
+ 'type' => 'apr_interval_time_t',
+ 'name' => 'timeout'
+ },
+ {
+ 'type' => 'apr_int16_t',
+ 'name' => 'reqevents'
+ }
+ ]
}
];
TTUL
Ken
Stas Bekman [31/08/04 00:01 -0400]:
>
> Another thing is the test. First of all it's quite possible that on a slow
> machine the first subtest will fail, so it should probably wait much
> longer on the first call.
>
> Second, I'd like to see is replacing sleep 2 with something faster. The
> test suite is already huge and adding extra sleeps adds up to a long run
> time. I think the test can be rewritten as so:
>
>
> --- /dev/null 1969-12-31 19:00:00.000000000 -0500
> +++ t/protocol/echo_nonblock.t 2004-08-30 23:57:44.606577082 -0400
> @@ -0,0 +1,27 @@
> +use strict;
> +use warnings FATAL => 'all';
> +
> +use Test;
> +use Apache::TestUtil;
> +use Apache::TestRequest ();
> +
> +plan tests => 3;
> +
> +my $socket =
> Apache::TestRequest::vhost_socket('TestProtocol::echo_nonblock');
> +
> +ok $socket;
> +
> +my $received;
> +my $expected;
> +
> +$expected = "nonblocking";
> +print $socket "$expected\n";
> +chomp($received = <$socket> || '');
> +ok t_cmp $received, $expected, "no timeout";
> +
> +# now get a timed out request
> +$expected = "TIMEUP";
> +print $socket "should timeout\n";
> +chomp($received = <$socket> || '');
> +ok t_cmp $received, $expected, "timed out";
> +
>
> --- /dev/null 1969-12-31 19:00:00.000000000 -0500
> +++ t/protocol/TestProtocol/echo_nonblock.pm 2004-08-30
> 23:59:25.512107442 -0400
> @@ -0,0 +1,59 @@
> +package TestProtocol::echo_nonblock;
> +
> +# this test reads from/writes to the socket doing nonblocking IO
> +
> +use strict;
> +use warnings FATAL => 'all';
> +
> +use Apache::Connection ();
> +use APR::Socket ();
> +
> +use Apache::TestTrace;
> +
> +use Apache::Const -compile => 'OK';
> +use APR::Const -compile => qw(SO_NONBLOCK TIMEUP SUCCESS POLLIN);
> +
> +use constant BUFF_LEN => 1024;
> +
> +sub handler {
> + my $c = shift;
> + my $socket = $c->client_socket;
> +
> + $socket->opt_set(APR::SO_NONBLOCK => 1);
> +
> + my $counter = 0;
> + my $timeout = 0;
> + while (1) {
> + if ($counter != 1) {
> + # Wait up to ten seconds for data to arrive.
> + $timeout = 10_000_000;
> + $counter++;
> + } elsif ($counter == 1) {
> + # this will certainly fail
> + $timeout = 0;
> + $counter++;
> + }
> +
> + my $rc = $socket->poll($c->pool, $timeout, APR::POLLIN);
> + if ($rc == APR::SUCCESS) {
> + if ($socket->recv(my $buf, BUFF_LEN)) {
> + debug "no timeout";
> + $socket->send($buf);
> + }
> + else {
> + last;
> + }
> + }
> + elsif ($rc == APR::TIMEUP) {
> + debug "timeout";
> + $socket->send("TIMEUP\n");
> + }
> + else {
> + die "poll error: $rc: " . APR::Error::strerror($rc);
> + }
> + }
> +
> + Apache::OK;
> +}
> +
> +1;
>
> --
> __________________________________________________________________
> Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide ---> http://perl.apache.org
> mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org http://ticketmaster.com
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: [EMAIL PROTECTED]
> For additional commands, e-mail: [EMAIL PROTECTED]
>
--
MailChannels: Imagine no more spam
--
http://www.mailchannels.com
MailChannels Corporation
Suite 1600, 1188 West Georgia St.
Vancouver, BC, Canada
Ken Simpson, CEO
+1-604-729-1741
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
