this patch:
- implements a typemap entry and a conversion function for apr_os_file_t
from perl glob
- implements send_fd
Tested with 5.6.1 and bleadperl
APR Issues:
- apr requires the length of the file to be sent as an arg to ap_send_fd
which makes it impossible to use with just opened fh. I don't know what to
do here, it'll break existing code.
Patch issues:
- I'm not sure whether I've to dup in mpxs_Apache__RequestRec_send_fd, and
whether I need to add dup in modperl_xs_sv2apr_os_file. I'm a little bit
confused when dup should be done and when not. Currently I had to
SvREFCNT_inc(in) in modperl_xs_sv2apr_os_file, or there is core dump on
the function mpxs_Apache__RequestRec_send_fd return. I know that we want
to make sure that the handle that we hold is valid, so to be safe should
we always dup when moving between APR and Perl?
- I wanted to implement modperl_xs_sv2apr_os_file and not to do the
XS work in mpxs_Apache__RequestRec_send_fd because we can re-use it
later, but I've an issue with the pool, because I need to malloc
apr_os_file_t *os_file in modperl_xs_sv2apr_os_file. Or is there another
way to return a reference to a variable from the function, that created
this variable?
- I'm also not sure whether I've picked the right name for APR::OS_File.
Index: xs/maps/apr_types.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_types.map,v
retrieving revision 1.10
diff -u -r1.10 apr_types.map
--- xs/maps/apr_types.map 2001/09/17 00:38:07 1.10
+++ xs/maps/apr_types.map 2001/12/20 22:02:58
@@ -57,7 +57,7 @@
#file stuff
struct apr_file_t | UNDEFINED
-struct apr_os_file_t | UNDEFINED
+struct apr_os_file_t | APR::OS_File
struct apr_dir_t | UNDEFINED
struct apr_os_dir_t | UNDEFINED
apr_seek_where_t | UNDEFINED
Index: xs/maps/modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.31
diff -u -r1.31 modperl_functions.map
--- xs/maps/modperl_functions.map 2001/12/20 18:12:16 1.31
+++ xs/maps/modperl_functions.map 2001/12/20 22:02:58
@@ -31,6 +31,7 @@
apr_size_t:DEFINE_PRINTF | | ...
SV *:DEFINE_BINMODE | | request_rec *:r
mpxs_Apache__RequestRec_sendfile | | r, filename=r->filename, offset=0, len=0
+ mpxs_Apache__RequestRec_send_fd | | r, fd, length
mpxs_Apache__RequestRec_read | | r, buffer, bufsiz, offset=0
long:DEFINE_READ | | request_rec *:r, SV *:buffer, int:bufsiz, int:offset=0
mpxs_Apache__RequestRec_write | | r, buffer, bufsiz=-1, offset=0
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.32
diff -u -r1.32 compat.pm
--- lib/Apache/compat.pm 2001/12/20 01:31:24 1.32
+++ lib/Apache/compat.pm 2001/12/20 22:02:59
@@ -236,40 +236,6 @@
$line ? $line : undef;
}
-use constant IOBUFSIZE => 8192;
-
-#XXX: howto convert PerlIO to apr_file_t
-#so we can use the real ap_send_fd function
-#2.0 ap_send_fd() also has an additional offset parameter
-
-sub send_fd_length {
- my($r, $fh, $length) = @_;
-
- my $buff;
- my $total_bytes_sent = 0;
- my $len;
-
- return 0 if $length == 0;
-
- if (($length > 0) && ($total_bytes_send + IOBUFSIZE) > $length) {
- $len = $length - $total_bytes_sent;
- }
- else {
- $len = IOBUFSIZE;
- }
-
- while (read($fh, $buff, $len)) {
- $total_bytes_sent += $r->puts($buff);
- }
-
- $total_bytes_sent;
-}
-
-sub send_fd {
- my($r, $fh) = @_;
- $r->send_fd_length($fh, -1);
-}
-
package Apache::File;
use Fcntl ();
Index: lib/ModPerl/WrapXS.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
retrieving revision 1.39
diff -u -r1.39 WrapXS.pm
--- lib/ModPerl/WrapXS.pm 2001/12/14 05:12:13 1.39
+++ lib/ModPerl/WrapXS.pm 2001/12/20 22:02:59
@@ -511,6 +511,7 @@
my %typemap = (
'Apache::RequestRec' => 'T_APACHEOBJ',
'apr_time_t' => 'T_APR_TIME',
+ 'APR::OS_File' => 'T_APR_OS_FILE',
'APR::Table' => 'T_HASHOBJ',
);
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.32
diff -u -r1.32 modperl_util.c
--- src/modules/perl/modperl_util.c 2001/12/14 04:35:28 1.32
+++ src/modules/perl/modperl_util.c 2001/12/20 22:02:59
@@ -138,6 +138,28 @@
return NULL;
}
+apr_os_file_t *modperl_xs_sv2apr_os_file(pTHX_ SV *in)
+{
+ /* XXX: how to get the pool? */
+ apr_os_file_t *os_file = apr_palloc(modperl_global_get_pconf(),
+sizeof(apr_os_file_t *));
+ PerlIO *f;
+
+ if (in == &PL_sv_undef || !SvROK(in) ) {
+ Perl_croak(aTHX_ "panic: expecting file glob");
+ }
+
+ /* XXX: dumps core without this? leak with _inc? */
+ SvREFCNT_inc(in);
+ f = IoIFP(sv_2io(in));
+ if (!f) {
+ Perl_croak(aTHX_ "cannot retrieve PerlIO");
+ }
+
+ *os_file = (apr_os_file_t)PerlIO_fileno(f);
+ return os_file;
+}
+
+
MP_INLINE SV *modperl_newSVsv_obj(pTHX_ SV *stashsv, SV *obj)
{
SV *newobj;
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.31
diff -u -r1.31 modperl_util.h
--- src/modules/perl/modperl_util.h 2001/12/14 04:35:28 1.31
+++ src/modules/perl/modperl_util.h 2001/12/20 22:02:59
@@ -55,6 +55,8 @@
request_rec *modperl_xs_sv2request_rec(pTHX_ SV *sv, char *classname, CV *cv);
+apr_os_file_t *modperl_xs_sv2apr_os_file(pTHX_ SV *in);
+
MP_INLINE SV *modperl_newSVsv_obj(pTHX_ SV *stashsv, SV *obj);
MP_INLINE SV *modperl_ptr2obj(pTHX_ char *classname, void *ptr);
Index: t/api/send_fd.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/api/send_fd.t,v
retrieving revision 1.3
diff -u -r1.3 send_fd.t
--- t/api/send_fd.t 2001/12/20 03:54:41 1.3
+++ t/api/send_fd.t 2001/12/20 22:02:59
@@ -4,6 +4,7 @@
use Test;
use Apache::Test ();
use Apache::TestRequest;
+use Apache::TestUtil;
plan tests => 3;
@@ -17,7 +18,9 @@
my $module = 'response/TestAPI/send_fd.pm';
-ok length($data) == -s $module;
+ok t_cmp(-s $module,
+ length($data),
+ "send_fd sent bytes");
$data = GET_BODY("$url?noexist.txt");
Index: t/response/TestAPI/send_fd.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/send_fd.pm,v
retrieving revision 1.1
diff -u -r1.1 send_fd.pm
--- t/response/TestAPI/send_fd.pm 2001/04/28 19:29:43 1.1
+++ t/response/TestAPI/send_fd.pm 2001/12/20 22:02:59
@@ -3,20 +3,24 @@
use strict;
use warnings FATAL => 'all';
-use Apache::compat ();
-
sub handler {
my $r = shift;
my $file = $r->args || __FILE__;
open my $fh, $file or return Apache::NOT_FOUND;
+
+ my $size = -s $file;
+
+ return Apache::SERVER_ERROR unless $size;
- my $bytes = $r->send_fd($fh);
+ my $bytes = $r->send_fd($fh, $size);
- return Apache::SERVER_ERROR unless $bytes == -s $file;
+ # XXX: how to set the errno? so there will be a message in the log
+ # file
+ return Apache::SERVER_ERROR unless $bytes == $size;
- Apache::OK;
+ return Apache::OK;
}
1;
Index: xs/typemap
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/typemap,v
retrieving revision 1.5
diff -u -r1.5 typemap
--- xs/typemap 2001/09/25 19:44:03 1.5
+++ xs/typemap 2001/12/20 22:02:59
@@ -39,3 +39,6 @@
T_CONST_CHAR_LEN
$var = (const char *)SvPV($arg, ${var}_len)
+
+T_APR_OS_FILE
+ $var = modperl_xs_sv2apr_os_file(aTHX_ $arg)
\ No newline at end of file
Index: xs/Apache/RequestIO/Apache__RequestIO.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h,v
retrieving revision 1.23
diff -u -r1.23 Apache__RequestIO.h
--- xs/Apache/RequestIO/Apache__RequestIO.h 2001/12/20 18:12:15 1.23
+++ xs/Apache/RequestIO/Apache__RequestIO.h 2001/12/20 22:02:59
@@ -235,3 +235,26 @@
return status;
}
+
+static MP_INLINE
+apr_size_t mpxs_Apache__RequestRec_send_fd(request_rec *r,
+ apr_os_file_t *fd,
+ apr_size_t length)
+{
+ apr_file_t *file = NULL;
+ apr_file_t *dup = NULL;
+ apr_size_t *nbytes;
+ apr_status_t rc = 0;
+
+ rc = apr_os_file_put(&file, fd, r->pool);
+ /* XXX: error checking */
+ rc = apr_file_dup(&dup, file, r->pool);
+ /* XXX: error checking */
+ rc = ap_send_fd(dup, r, 0, length, nbytes);
+
+ if (rc != APR_SUCCESS) {
+ ap_log_rerror(APLOG_MARK, APLOG_ERR, rc, r, "ap_send_fd has failed");
+ }
+
+ return *nbytes;
+}
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
