Hi Everyone, This patch adds a poll() method to APR::Socket that allows you to poll a nonblocking APR socket -- similar to the select() call in Unix-land.
Synopsis: use APR::Socket(); use Apache::Connection (); use APR::Const -compile => qw(POLLIN);
my $timeout = 10_000_000; # microseconds
my $socket = $connection->client_socket(); $socket->poll($connection->pool, $timeout, APR::POLLIN);
Thanks to Stas for showing me the ropes of how to add this support in. mock and I will be updating Apache::TieBucketBrigade to take advantage of this polling interface so that you can do magic things like make Apache look just like a regular Perl socket or file handle -- which would be handy if you were, say, writing an SMTP server that leverages Net::Server::Mail (see Apache::SMTP). </shameless_plug>
Nice work, Ken. Though you've missed the adjusted test files. I've applied a few more tweaks and adjusted the tests. The patch is below.
One missing part is to add the API doc to docs/api/APR/Socket.pod and then it can be committed.
Another thing is the test. I'll discuss it in a separate email.
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.11
diff -u -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 31 Aug 2004 03:50:11 -0000
@@ -96,3 +96,22 @@
MP_RUN_CROAK(apr_socket_opt_set(socket, opt, val),
"APR::Socket::opt_set");
}
+
+static MP_INLINE
+apr_status_t mpxs_APR__Socket_poll(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;
+
+ /* what to poll */
+ fd.p = pool;
+ fd.desc_type = APR_POLL_SOCKET;
+ fd.desc.s = socket;
+ fd.reqevents = reqevents;
+ fd.rtnevents = 0; /* XXX: not really necessary to set this */
+
+ return apr_poll(&fd, 1, &nsds, timeout);
+}
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.85
diff -u -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 31 Aug 2004 03:50:11 -0000
@@ -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:reqeventsMODULE=APR::SockAddr
!apr_sockaddr_info_get
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.176
diff -u -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 31 Aug 2004 03:50:11 -0000
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # ! WARNING: generated by ModPerl::ParseSource/0.01 -# ! Wed Aug 25 14:56:13 2004 +# ! Mon Aug 30 22:40:23 2004 # ! do NOT edit, any changes will be lost ! # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5574,6 +5574,28 @@
{
'type' => 'apr_int32_t',
'name' => 'val'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'apr_status_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'
}
]
},--- /dev/null 1969-12-31 19:00:00.000000000 -0500
+++ t/protocol/echo_nonblock.t 2004-08-30 23:49:48.873451131 -0400
@@ -0,0 +1,29 @@
+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";
+
+# Wait two seconds so that the server will time out.
+sleep 2;
+
+$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 22:41:59.940665923 -0400
@@ -0,0 +1,47 @@
+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);
+ while (1) {
+ # Wait up to one second for data to arrive.
+ my $rc = $socket->poll($c->pool, 1_000_000, 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]
