dougm 01/05/05 11:46:15
Modified: xs/Apache/RequestIO Apache__RequestIO.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
Added: t/apache read.t
t/response/TestApache read.pm
Log:
add $r->read method (and READ alias)
Revision Changes Path
1.1 modperl-2.0/t/apache/read.t
Index: read.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestRequest;
plan tests => 1;
my $location = "/TestApache::read";
my $socket = Apache::TestRequest::vhost_socket('default');
$socket->autoflush(1);
my $file = '../pod/modperl_2.0.pod';
open(my $fh, $file) or die "open $file: $!";
my $data = join '', <$fh>;
close $fh;
my $size = length $data;
print $socket "POST $location http/1.0\r\n";
print $socket "Content-length: $size\r\n";
print $socket "\r\n";
my $written = 0;
my $bufsiz = 240;
my $sleeps = 2;
while ($written < length($data)) {
my $remain = length($data) - $written;
my $len = $remain > $bufsiz ? $bufsiz : $remain;
$written += syswrite($socket, $data, $len, $written);
sleep 1 if $sleeps-- > 0;
}
while (<$socket>) {
last if /^\015?\012$/; #skip over headers
}
my $return = join '', <$socket>;
ok $data eq $return;
1.1 modperl-2.0/t/response/TestApache/read.pm
Index: read.pm
===================================================================
package TestApache::read;
use strict;
use warnings FATAL => 'all';
use constant BUFSIZ => 512; #small for testing
sub handler {
my $r = shift;
$r->content_type('text/plain');
my $ct = $r->headers_in->get('content-length');
my $buffer = "";
my $bufsiz = $r->args || BUFSIZ;
while ((my($offset) = length($buffer)) < $ct) {
my $remain = $ct - $offset;
my $len = $remain >= $bufsiz ? $bufsiz : $remain;
last unless $len > 0;
$r->read($buffer, $len, $offset);
}
#make sure we dont block after all data is read
my $n = $r->read(my $x, BUFSIZ);
die unless $n == 0;
$r->puts($buffer);
0;
}
1;
1.9 +41 -0 modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h
Index: Apache__RequestIO.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- Apache__RequestIO.h 2001/05/05 02:16:03 1.8
+++ Apache__RequestIO.h 2001/05/05 18:46:14 1.9
@@ -73,6 +73,47 @@
return nrd;
}
+/* alias */
+#define mpxs_Apache__RequestRec_READ mpxs_Apache__RequestRec_read
+
+static long mpxs_Apache__RequestRec_read(request_rec *r,
+ SV *buffer, int bufsiz,
+ int offset)
+{
+ dTHX; /*XXX*/
+ long nrd = 0, old_read_length;
+ int rc;
+
+ if (!r->read_length) {
+ if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
+ ap_log_error(APLOG_MARK, APLOG_ERR|APLOG_NOERRNO, 0,
+ r->server,
+ "mod_perl: ap_setup_client_block failed: %d", rc);
+ return 0;
+ }
+ }
+
+ old_read_length = r->read_length;
+ r->read_length = 0;
+
+ if (ap_should_client_block(r)) {
+ mpxs_sv_grow(buffer, bufsiz+SvCUR(buffer));
+ nrd = ap_get_client_block(r, SvPVX(buffer)+offset, bufsiz);
+ }
+
+ r->read_length += old_read_length;
+
+ if (nrd > 0) {
+ mpxs_sv_cur_set(buffer, nrd+offset);
+ SvTAINTED_on(buffer);
+ }
+ else {
+ sv_setsv(buffer, &PL_sv_undef);
+ }
+
+ return nrd;
+}
+
static MP_INLINE
apr_status_t mpxs_Apache__RequestRec_sendfile(request_rec *r,
const char *filename,
1.14 +2 -0 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- modperl_functions.map 2001/05/04 04:21:54 1.13
+++ modperl_functions.map 2001/05/05 18:46:15 1.14
@@ -17,6 +17,8 @@
SV *:DEFINE_TIEHANDLE | | SV *:stashsv, SV *:sv=Nullsv
apr_size_t:DEFINE_PRINT | | ...
mpxs_Apache__RequestRec_sendfile | | r, filename=r->filename, offset=0, len=0
+ mpxs_Apache__RequestRec_read | | r, buffer, bufsiz, offset=0
+ long:DEFINE_READ | | request_rec *:r, SV *:buffer, int:bufsiz, int:offset=0
MODULE=Apache::ServerUtil PACKAGE=guess
mpxs_Apache__Server_push_handlers
1.15 +23 -1 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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- FunctionTable.pm 2001/05/05 17:38:32 1.14
+++ FunctionTable.pm 2001/05/05 18:46:15 1.15
@@ -2,7 +2,7 @@
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Sat May 5 10:26:55 2001
+# ! Sat May 5 10:40:17 2001
# ! do NOT edit, any changes will be lost !
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3702,6 +3702,28 @@
}
],
'name' => 'mpxs_ap_get_client_block'
+ },
+ {
+ 'return_type' => 'long',
+ 'args' => [
+ {
+ 'name' => 'r',
+ 'type' => 'request_rec *'
+ },
+ {
+ 'name' => 'buffer',
+ 'type' => 'SV *'
+ },
+ {
+ 'name' => 'bufsiz',
+ 'type' => 'int'
+ },
+ {
+ 'name' => 'offset',
+ 'type' => 'int'
+ }
+ ],
+ 'name' => 'mpxs_Apache__RequestRec_read'
},
{
'return_type' => 'apr_status_t',
