You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2002/01/04 10:29:50 UTC
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
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);
}
Re: cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
Posted by Stas Bekman <st...@stason.org>.
stas@apache.org wrote:
> 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.
Actually it seems that there were some bugs introduced in the later
versions, so please get at least patch level 14054. This one passes all
perl tests, but two. which is very unusual.
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:stas@stason.org http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org