You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Stas Bekman <st...@stason.org> on 2004/04/08 21:23:58 UTC
[mp2 patch take2] $socket_opt_(get|set) API and test
OK, here is a new version which returns undef on failure and sets $APR::err to
the error message:
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.53
diff -u -r1.53 modperl_util.h
--- src/modules/perl/modperl_util.h 2 Apr 2004 02:17:45 -0000 1.53
+++ src/modules/perl/modperl_util.h 8 Apr 2004 19:21:46 -0000
@@ -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) { \
Index: t/protocol/TestProtocol/echo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo.pm,v
retrieving revision 1.4
diff -u -r1.4 echo.pm
--- t/protocol/TestProtocol/echo.pm 8 Apr 2004 00:11:25 -0000 1.4
+++ t/protocol/TestProtocol/echo.pm 8 Apr 2004 19:21:47 -0000
@@ -15,13 +15,21 @@
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_get: $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 set non-blocking mode" if $nonblocking;
+ }
+
+ my $buff;
for (;;) {
my($rlen, $wlen);
$rlen = BUFF_LEN;
Index: xs/APR/Socket/APR__Socket.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/Socket/APR__Socket.h,v
retrieving revision 1.4
diff -u -r1.4 APR__Socket.h
--- xs/APR/Socket/APR__Socket.h 4 Mar 2004 06:01:10 -0000 1.4
+++ xs/APR/Socket/APR__Socket.h 8 Apr 2004 19:21:48 -0000
@@ -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);
+}
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.70
diff -u -r1.70 apr_functions.map
--- xs/maps/apr_functions.map 31 Jan 2004 10:06:59 -0000 1.70
+++ xs/maps/apr_functions.map 8 Apr 2004 19:21:48 -0000
@@ -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
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.149
diff -u -r1.149 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 2 Apr 2004 02:17:46 -0000 1.149
+++ xs/tables/current/ModPerl/FunctionTable.pm 8 Apr 2004 19:21:49 -0000
@@ -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' => [
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org