stas 02/01/04 01:29:50
Modified: xs/APR/PerlIO apr_perlio.c
Log:
- now APR PerlIO read is buffered by PerlIOBuf layer.
Attention: this requires at least bleadperl patch 13978,
14042 seems to be fine too for me.
Revision Changes Path
1.8 +67 -42 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- apr_perlio.c 20 Dec 2001 03:20:33 -0000 1.7
+++ apr_perlio.c 4 Jan 2002 09:29:50 -0000 1.8
@@ -4,7 +4,7 @@
#include "apr_perlio.h"
/* XXX: prerequisites to have things working
- * pTHX_: perl 5.7.2 patch 13809 is required
+ * PerlIO_flush patch : perl 5.7.2 patch 13978 is required
* dup() : apr cvs date: 2001/12/06 13:43:45
*
* XXX: it's not enough to check for PERLIO_LAYERS, some functionality
@@ -119,34 +119,16 @@
return NULL;
}
-/* currrently read is very not-optimized, since in many cases the read
- * process happens a char by char. Need to find a way to snoop on APR
- * read buffer from PerlIO, or implement our own buffering layer here
- */
-static SSize_t PerlIOAPR_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
-{
- PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
- apr_status_t rc;
-
- /* fprintf(stderr, "in read: count %d, %s\n",
- (int)count, (char*) vbuf); */
- rc = apr_file_read(st->file, vbuf, &count);
- /* fprintf(stderr, "out read: count %d, %s\n",
- (int)count, (char*) vbuf); */
- if (rc == APR_SUCCESS) {
- return (SSize_t) count;
- }
-
- return (SSize_t) -1;
-}
-
static SSize_t PerlIOAPR_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
+
+#if 0
+ Perl_warn(aTHX_ "in write: count %d, %s\n",
+ (int)count, (char*) vbuf);
+#endif
- /* fprintf(stderr, "in write: count %d, %s\n",
- (int)count, (char*) vbuf); */
rc = apr_file_write(st->file, vbuf, &count);
if (rc == APR_SUCCESS) {
return (SSize_t) count;
@@ -160,13 +142,14 @@
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_seek_where_t where;
apr_status_t rc;
+ IV code;
- /* XXX: must flush before seek? */
- rc = apr_file_flush(st->file);
- if (rc != APR_SUCCESS) {
- return -1;
+ /* Flush the fill buffer */
+ code = PerlIOBuf_flush(aTHX_ f);
+ if (code != 0) {
+ return code;
}
-
+
switch(whence) {
case 0:
where = APR_SET;
@@ -209,7 +192,7 @@
const char *new_path;
apr_file_name_get(&new_path, st->file);
- /* fprintf(stderr, "closing file %s\n", new_path); */
+ /* Perl_warn(aTHX_ "closing file %s\n", new_path); */
rc = apr_file_flush(st->file);
if (rc != APR_SUCCESS) {
@@ -239,7 +222,46 @@
static IV PerlIOAPR_fill(pTHX_ PerlIO *f)
{
- return -1;
+ PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+ apr_status_t rc;
+ SSize_t avail;
+ Size_t count = st->base.bufsiz;
+
+ if (!st->base.buf) {
+ PerlIO_get_base(f); /* allocate via vtable */
+ }
+
+#if 0
+ Perl_warn(aTHX_ "ask to fill %d chars\n", count);
+#endif
+
+ rc = apr_file_read(st->file, st->base.ptr, &count);
+ if (rc != APR_SUCCESS) {
+ /* XXX */
+ }
+
+#if 0
+ Perl_warn(aTHX_ "got to fill %d chars\n", count);
+#endif
+
+ avail = count; /* apr_file_read() sets how many chars were read in count */
+ if (avail <= 0) {
+ if (avail == 0) {
+ PerlIOBase(f)->flags |= PERLIO_F_EOF;
+ }
+ else {
+ PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+ }
+
+ return -1;
+ }
+ st->base.end = st->base.buf + avail;
+
+ /* indicate that the buffer this layer currently holds unconsumed
+ data read from layer below. */
+ PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
+
+ return 0;
}
static IV PerlIOAPR_eof(pTHX_ PerlIO *f)
@@ -262,14 +284,14 @@
static PerlIO_funcs PerlIO_APR = {
"APR",
sizeof(PerlIOAPR),
- PERLIO_K_BUFFERED | PERLIO_K_MULTIARG, /* XXX: document the flag in perliol.pod
*/
+ PERLIO_K_BUFFERED | PERLIO_K_FASTGETS | PERLIO_K_MULTIARG,
PerlIOBase_pushed,
PerlIOAPR_popped,
PerlIOAPR_open,
NULL, /* no getarg needed */
PerlIOAPR_fileno,
PerlIOAPR_dup,
- PerlIOAPR_read,
+ PerlIOBuf_read,
PerlIOBuf_unread,
PerlIOAPR_write,
PerlIOAPR_seek,
@@ -308,7 +330,10 @@
char *mode;
const char *layers = ":APR";
PerlIO *f = PerlIO_allocate(aTHX);
-
+ if (!f) {
+ return NULL;
+ }
+
switch (type) {
case APR_PERLIO_HOOK_WRITE:
mode = "w";
@@ -317,7 +342,7 @@
mode = "r";
break;
default:
- /* */
+ /* */
};
PerlIO_apply_layers(aTHX_ f, mode, layers);
@@ -356,7 +381,7 @@
IoIFP(GvIOp(gv)) = pio;
break;
default:
- /* */
+ /* */
};
return sv_2mortal(retval);
@@ -388,21 +413,21 @@
mode = "r";
break;
default:
- /* */
+ /* */
};
/* convert to the OS representation of file */
rc = apr_os_file_get(&os_file, file);
if (rc != APR_SUCCESS) {
- croak("filedes retrieval failed!");
+ croak("filedes retrieval failed!");
}
fd = PerlLIO_dup(os_file);
/* Perl_warn(aTHX_ "fd old: %d, new %d\n", os_file, fd); */
if (!(retval = PerlIO_fdopen(fd, mode))) {
- PerlLIO_close(fd);
- croak("fdopen failed!");
+ PerlLIO_close(fd);
+ croak("fdopen failed!");
}
return retval;
@@ -430,9 +455,9 @@
IoIFP(GvIOp(gv)) = apr_perlio_apr_file_to_FILE(aTHX_ file, type);
break;
default:
- /* */
+ /* */
};
-
+
return sv_2mortal(retval);
}
