stas 2004/04/08 13:47:42
Modified: src/modules/perl modperl_util.h
xs/APR/Socket APR__Socket.h
xs/maps apr_functions.map
xs/tables/current/ModPerl FunctionTable.pm
t/protocol/TestProtocol echo.pm
. Changes
Log:
make APR::Socket::opt_(set|get) working (and change the previous behavior)
Revision Changes Path
1.54 +12 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -u -r1.53 -r1.54
--- modperl_util.h 2 Apr 2004 02:17:45 -0000 1.53
+++ modperl_util.h 8 Apr 2004 20:47:41 -0000 1.54
@@ -72,6 +72,18 @@
} \
} while (0)
+
+/* runs a given code and if failed sets $APR::err to the error message
+ * and returns &PL_sv_undef */
+#define MP_APR_RETURN_ON_FAILURE(rc_run) do { \
+ apr_status_t rc = (rc_run); \
+ if (rc != APR_SUCCESS) { \
+ GV *gv = gv_fetchpv("APR::err", GV_ADDMULTI, SVt_PV); \
+ sv_setpv(GvSV(gv), modperl_apr_strerror(rc)); \
+ return &PL_sv_undef; \
+ } \
+ } while (0)
+
/* check whether the response phase has been initialized already */
#define MP_CHECK_WBUCKET_INIT(func) \
if (!rcfg->wbucket) { \
1.5 +17 -0 modperl-2.0/xs/APR/Socket/APR__Socket.h
Index: APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- APR__Socket.h 4 Mar 2004 06:01:10 -0000 1.4
+++ APR__Socket.h 8 Apr 2004 20:47:41 -0000 1.5
@@ -64,3 +64,20 @@
return t;
}
+static MP_INLINE SV *
+mpxs_APR__Socket_opt_get(pTHX_ apr_socket_t *socket, apr_int32_t opt)
+{
+ apr_int32_t val;
+ MP_APR_RETURN_ON_FAILURE(apr_socket_opt_get(socket, opt, &val));
+ return newSViv(val);
+}
+
+static MP_INLINE SV *
+mpxs_APR__Socket_opt_set(pTHX_ apr_socket_t *socket, apr_int32_t opt,
+ apr_int32_t val)
+{
+ apr_int32_t oldval;
+ MP_APR_RETURN_ON_FAILURE(apr_socket_opt_get(socket, opt, &oldval));
+ MP_APR_RETURN_ON_FAILURE(apr_socket_opt_set(socket, opt, val));
+ return newSViv(oldval);
+}
1.71 +4 -2 modperl-2.0/xs/maps/apr_functions.map
Index: apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -u -r1.70 -r1.71
--- apr_functions.map 31 Jan 2004 10:06:59 -0000 1.70
+++ apr_functions.map 8 Apr 2004 20:47:41 -0000 1.71
@@ -58,8 +58,10 @@
!apr_socket_addr_get
!apr_socket_data_get
!apr_socket_data_set
- apr_socket_opt_get
- apr_socket_opt_set
+-apr_socket_opt_get
+-apr_socket_opt_set
+ mpxs_APR__Socket_opt_get
+ mpxs_APR__Socket_opt_set
apr_socket_timeout_get | mpxs_ | ...
apr_socket_timeout_set
-apr_socket_sendfile
1.150 +48 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.149
retrieving revision 1.150
diff -u -u -r1.149 -r1.150
--- FunctionTable.pm 2 Apr 2004 02:17:46 -0000 1.149
+++ FunctionTable.pm 8 Apr 2004 20:47:41 -0000 1.150
@@ -6829,6 +6829,54 @@
]
},
{
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_APR__Socket_opt_get',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'apr_socket_t *',
+ 'name' => 'socket'
+ },
+ {
+ 'type' => 'apr_int32_t',
+ 'name' => 'opt'
+ },
+ ]
+ },
+ {
+ 'return_type' => 'SV *',
+ 'name' => 'mpxs_APR__Socket_opt_set',
+ 'attr' => [
+ 'static',
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'apr_socket_t *',
+ 'name' => 'socket'
+ },
+ {
+ 'type' => 'apr_int32_t',
+ 'name' => 'opt'
+ },
+ {
+ 'type' => 'apr_int32_t',
+ 'name' => 'val'
+ },
+ ]
+ },
+ {
'return_type' => '',
'name' => 'mpxs_apr_sockaddr_ip_get',
'args' => [
1.5 +15 -3 modperl-2.0/t/protocol/TestProtocol/echo.pm
Index: echo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- echo.pm 8 Apr 2004 00:11:25 -0000 1.4
+++ echo.pm 8 Apr 2004 20:47:41 -0000 1.5
@@ -15,13 +15,25 @@
my Apache::Connection $c = shift;
my APR::Socket $socket = $c->client_socket;
- my $buff;
-
# make sure the socket is in the blocking mode for recv().
# on some platforms (e.g. OSX/Solaris) httpd hands us a
# non-blocking socket
- $socket->opt_set(APR::SO_NONBLOCK, 0);
+ my $nonblocking = $socket->opt_get(APR::SO_NONBLOCK);
+ die "failed to \$socket->opt_get: $ARP::err"
+ unless defined $nonblocking;
+ if ($nonblocking) {
+ my $prev_value = $socket->opt_set(APR::SO_NONBLOCK => 0);
+ die "failed to \$socket->opt_set: $ARP::err"
+ unless defined $prev_value;
+ # test that we really are in the non-blocking mode
+ $nonblocking = $socket->opt_get(APR::SO_NONBLOCK);
+ die "failed to \$socket->opt_get: $ARP::err"
+ unless defined $nonblocking;
+ die "failed to set non-blocking mode" if $nonblocking;
+ }
+
+ my $buff;
for (;;) {
my($rlen, $wlen);
$rlen = BUFF_LEN;
1.358 +3 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.357
retrieving revision 1.358
diff -u -u -r1.357 -r1.358
--- Changes 7 Apr 2004 23:44:21 -0000 1.357
+++ Changes 8 Apr 2004 20:47:41 -0000 1.358
@@ -12,6 +12,9 @@
=item 1.99_14-dev
+make APR::Socket::opt_(set|get) working (and change the previous
+behavior) [Stas]
+
make sure that our protocol module tests that interact with the socket
use a blocking read [Joe Orton]
