cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c apr_perlio.h
stas02/03/05 21:30:27
Modified:xs/APR/PerlIO apr_perlio.c apr_perlio.h
Log:
- convert the int APR_PERLIO_HOOK hooks into enums: benefit from
compile-time checks
- now can get rid of default: cases using these hooks
- rewrite the eof() switch to deploy the default case, which was empty and
causing warnings under gcc3.
<>
Revision ChangesPath
1.11 +12 -26modperl-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.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- apr_perlio.c 8 Jan 2002 01:09:19 - 1.10
+++ apr_perlio.c 6 Mar 2002 05:30:27 - 1.11
@@ -304,11 +304,10 @@
rc = apr_file_eof(st->file);
switch (rc) {
- case APR_SUCCESS:
-return 0;
case APR_EOF:
return 1;
default:
+return 0;
}
return -1;
@@ -357,8 +356,8 @@
/* * PerlIO <=> apr_file_t helper functions * */
-PerlIO *apr_perlio_apr_file_to_PerlIO(pTHX_ apr_file_t *file,
- apr_pool_t *pool, int type)
+PerlIO *apr_perlio_apr_file_to_PerlIO(pTHX_ apr_file_t *file, apr_pool_t *pool,
+ apr_perlio_hook_e type)
{
char *mode;
const char *layers = ":APR";
@@ -374,8 +373,6 @@
case APR_PERLIO_HOOK_READ:
mode = "r";
break;
- default:
-/* */
};
PerlIO_apply_layers(aTHX_ f, mode, layers);
@@ -394,10 +391,7 @@
return NULL;
}
-/*
- * type: APR_PERLIO_HOOK_READ | APR_PERLIO_HOOK_WRITE
- */
-static SV *apr_perlio_PerlIO_to_glob(pTHX_ PerlIO *pio, int type)
+static SV *apr_perlio_PerlIO_to_glob(pTHX_ PerlIO *pio, apr_perlio_hook_e type)
{
/* XXX: modperl_perl_gensym() cannot be used outside of httpd */
SV *retval = modperl_perl_gensym(aTHX_ "APR::PerlIO");
@@ -413,24 +407,24 @@
case APR_PERLIO_HOOK_READ:
IoIFP(GvIOp(gv)) = pio;
break;
- default:
-/* */
};
return sv_2mortal(retval);
}
-SV *apr_perlio_apr_file_to_glob(pTHX_ apr_file_t *file,
-apr_pool_t *pool, int type)
+SV *apr_perlio_apr_file_to_glob(pTHX_ apr_file_t *file, apr_pool_t *pool,
+apr_perlio_hook_e type)
{
return apr_perlio_PerlIO_to_glob(aTHX_
- apr_perlio_apr_file_to_PerlIO(aTHX_ file,
pool, type),
+ apr_perlio_apr_file_to_PerlIO(aTHX_ file,
+ pool, type),
type);
}
#elif !defined(PERLIO_LAYERS) && !defined(WIN32) /* NOT PERLIO_LAYERS (5.6.1) */
-static FILE *apr_perlio_apr_file_to_FILE(pTHX_ apr_file_t *file, int type)
+static FILE *apr_perlio_apr_file_to_FILE(pTHX_ apr_file_t *file,
+ apr_perlio_hook_e type)
{
FILE *retval;
char *mode;
@@ -445,8 +439,6 @@
case APR_PERLIO_HOOK_READ:
mode = "r";
break;
- default:
-/* */
};
/* convert to the OS representation of file */
@@ -466,12 +458,8 @@
return retval;
}
-/*
- *
- * type: APR_PERLIO_HOOK_READ | APR_PERLIO_HOOK_WRITE
- */
-SV *apr_perlio_apr_file_to_glob(pTHX_ apr_file_t *file,
-apr_pool_t *pool, int type)
+SV *apr_perlio_apr_file_to_glob(pTHX_ apr_file_t *file, apr_pool_t *pool,
+apr_perlio_hook_e type)
{
/* XXX: modperl_perl_gensym() cannot be used outside of httpd */
SV *retval = modperl_perl_gensym(aTHX_ "APR::PerlIO");
@@ -487,8 +475,6 @@
case APR_PERLIO_HOOK_READ:
IoIFP(GvIOp(gv)) = apr_perlio_apr_file_to_FILE(aTHX_ file, type);
break;
- default:
-/* */
};
return sv_2mortal(retval);
1.2 +12 -8 modperl-2.0/xs/APR/PerlIO/apr_perlio.h
Index: apr_perlio.h
===
RCS file: /home/cvs/modperl-2.0/xs/APR/PerlIO/apr_perlio.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- apr_perlio.h 17 Dec 2001 16:20:27 - 1.1
+++ apr_perlio.h 6 Mar 2002 05:30:27 - 1.2
@@ -14,8 +14,10 @@
#include "apr_optional.h"
#endif
-#define APR_PERLIO_HOOK_READ 0
-#define APR_PERLIO_HOOK_WRITE 1
+typedef enum {
+APR_PERLIO_HOOK_READ,
+APR_PERLIO_HOOK_WRITE
+} apr_perlio_hook_e;
void apr_perlio_init(pTHX);
@@ -25,19 +27,21 @
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 02/01/07 17:09:19
Modified:xs/APR/PerlIO apr_perlio.c
Log:
work around bug where some PerlIOAPR filehandles are still open during perl_destruct
Revision ChangesPath
1.10 +14 -2 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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- apr_perlio.c 8 Jan 2002 01:06:20 - 1.9
+++ apr_perlio.c 8 Jan 2002 01:09:19 - 1.10
@@ -206,14 +206,26 @@
IV code = PerlIOBase_close(aTHX_ f);
apr_status_t rc;
+#ifdef PERLIO_APR_DEBUG
const char *new_path = NULL;
-apr_file_name_get(&new_path, st->file);
+if (!PL_dirty) {
+/* if this is called during perl_destruct we are in trouble */
+apr_file_name_get(&new_path, st->file);
+}
-#ifdef PERLIO_APR_DEBUG
Perl_warn(aTHX_ "PerlIOAPR_close obj=0x%lx, file=0x%lx, name=%s\n",
(unsigned long)f, (unsigned long)st->file,
new_path ? new_path : "(UNKNOWN)");
#endif
+
+if (PL_dirty) {
+/* there should not be any PerlIOAPR handles open
+ * during perl_destruct
+ */
+Perl_warn(aTHX_ "leaked PerlIOAPR handle 0x%lx",
+ (unsigned long)f);
+return -1;
+}
rc = apr_file_flush(st->file);
if (rc != APR_SUCCESS) {
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 02/01/07 17:06:20
Modified:xs/APR/PerlIO apr_perlio.c
Log:
add some debug info
Revision ChangesPath
1.9 +23 -2 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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- apr_perlio.c 4 Jan 2002 09:29:50 - 1.8
+++ apr_perlio.c 8 Jan 2002 01:06:20 - 1.9
@@ -82,6 +82,13 @@
st->pool = modperl_sv2pool(aTHX_ sv);
rc = apr_file_open(&st->file, path, apr_flag, APR_OS_DEFAULT, st->pool);
+
+#ifdef PERLIO_APR_DEBUG
+Perl_warn(aTHX_ "PerlIOAPR_open obj=0x%lx, file=0x%lx, name=%s, rc=%d\n",
+ (unsigned long)f, (unsigned long)st->file,
+ path ? path : "(UNKNOWN)", rc);
+#endif
+
if (rc != APR_SUCCESS) {
PerlIOBase(f)->flags |= PERLIO_F_ERROR;
return NULL;
@@ -110,6 +117,15 @@
PerlIOAPR *ost = PerlIOSelf(o, PerlIOAPR);
rc = apr_file_dup(&fst->file, ost->file, ost->pool);
+
+#ifdef PERLIO_APR_DEBUG
+Perl_warn(aTHX_ "PerlIOAPR_dup obj=0x%lx, "
+"file=0x%lx => 0x%lx, rc=%d\n",
+ (unsigned long)f,
+ (unsigned long)ost->file,
+ (unsigned long)fst->file, rc);
+#endif
+
if (rc == APR_SUCCESS) {
fst->pool = ost->pool;
return f;
@@ -190,9 +206,14 @@
IV code = PerlIOBase_close(aTHX_ f);
apr_status_t rc;
-const char *new_path;
+const char *new_path = NULL;
apr_file_name_get(&new_path, st->file);
-/* Perl_warn(aTHX_ "closing file %s\n", new_path); */
+
+#ifdef PERLIO_APR_DEBUG
+Perl_warn(aTHX_ "PerlIOAPR_close obj=0x%lx, file=0x%lx, name=%s\n",
+ (unsigned long)f, (unsigned long)st->file,
+ new_path ? new_path : "(UNKNOWN)");
+#endif
rc = apr_file_flush(st->file);
if (rc != APR_SUCCESS) {
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas02/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 ChangesPath
1.8 +67 -42modperl-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 - 1.7
+++ apr_perlio.c 4 Jan 2002 09:29:50 - 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_al
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas01/12/19 19:20:33
Modified:xs/APR/PerlIO apr_perlio.c
Log:
- perl 5.7.2 patch 13809 has changed the prototype of all PerlIO vtable
functions to start with pTHX_; adjusting for this change and removing
dTHX's that aren't needed anymore.
Revision ChangesPath
1.7 +14 -16modperl-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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- apr_perlio.c 2001/12/19 18:16:41 1.6
+++ apr_perlio.c 2001/12/20 03:20:33 1.7
@@ -4,9 +4,8 @@
#include "apr_perlio.h"
/* XXX: prerequisites to have things working
- * open(): perl 5.7.2 patch 13534 is required
+ * pTHX_: perl 5.7.2 patch 13809 is required
* dup() : apr cvs date: 2001/12/06 13:43:45
- * tell(): the patch isn't in yet.
*
* XXX: it's not enough to check for PERLIO_LAYERS, some functionality
* and bug fixes were added only in the late 5.7.2, whereas
@@ -30,7 +29,7 @@
* popped without being closed if the program is dynamically managing
* layers on the stream.
*/
-static IV PerlIOAPR_popped(PerlIO *f)
+static IV PerlIOAPR_popped(pTHX_ PerlIO *f)
{
/* PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); */
@@ -92,7 +91,7 @@
return f;
}
-static IV PerlIOAPR_fileno(PerlIO *f)
+static IV PerlIOAPR_fileno(pTHX_ PerlIO *f)
{
/* apr_file_t* is an opaque struct, so fileno is not available */
/* XXX: this -1 workaround should be documented in perliol.pod */
@@ -124,13 +123,12 @@
* 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(PerlIO *f, void *vbuf, Size_t count)
+static SSize_t PerlIOAPR_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
-dTHX; /* XXX: change Perl so this function has a pTHX_ prototype */
-
-/* fprintf(stderr, "in read: count %d, %s\n",
+
+/* 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",
@@ -142,7 +140,7 @@
return (SSize_t) -1;
}
-static SSize_t PerlIOAPR_write(PerlIO *f, const void *vbuf, Size_t count)
+static SSize_t PerlIOAPR_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
@@ -157,7 +155,7 @@
return (SSize_t) -1;
}
-static IV PerlIOAPR_seek(PerlIO *f, Off_t offset, int whence)
+static IV PerlIOAPR_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_seek_where_t where;
@@ -189,7 +187,7 @@
return -1;
}
-static Off_t PerlIOAPR_tell(PerlIO *f)
+static Off_t PerlIOAPR_tell(pTHX_ PerlIO *f)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_off_t offset = 0;
@@ -203,10 +201,10 @@
return (Off_t) -1;
}
-static IV PerlIOAPR_close(PerlIO *f)
+static IV PerlIOAPR_close(pTHX_ PerlIO *f)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
-IV code = PerlIOBase_close(f);
+IV code = PerlIOBase_close(aTHX_ f);
apr_status_t rc;
const char *new_path;
@@ -226,7 +224,7 @@
return code;
}
-static IV PerlIOAPR_flush(PerlIO *f)
+static IV PerlIOAPR_flush(pTHX_ PerlIO *f)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
@@ -239,12 +237,12 @@
return -1;
}
-static IV PerlIOAPR_fill(PerlIO *f)
+static IV PerlIOAPR_fill(pTHX_ PerlIO *f)
{
return -1;
}
-static IV PerlIOAPR_eof(PerlIO *f)
+static IV PerlIOAPR_eof(pTHX_ PerlIO *f)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/19 10:16:41
Modified:xs/APR/PerlIO apr_perlio.c
Log:
fix win32 5.6.1 compile
Revision ChangesPath
1.6 +1 -1 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.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- apr_perlio.c 2001/12/18 06:00:14 1.5
+++ apr_perlio.c 2001/12/19 18:16:41 1.6
@@ -372,7 +372,7 @@
type);
}
-#elif !defined(PERLIO_LAYERS) /* NOT PERLIO_LAYERS (5.6.1) */
+#elif !defined(PERLIO_LAYERS) && !defined(WIN32) /* NOT PERLIO_LAYERS (5.6.1) */
static FILE *apr_perlio_apr_file_to_FILE(pTHX_ apr_file_t *file, int type)
{
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/17 22:00:14
Modified:xs/APR/PerlIO apr_perlio.c
Log:
#include "modperl_largefiles.h" to fix PerlIOAPR_tell issue where Off_t
is a different size (32 bit inside apache, 64 inside perl)
Revision ChangesPath
1.5 +1 -2 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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- apr_perlio.c 2001/12/18 01:13:15 1.4
+++ apr_perlio.c 2001/12/18 06:00:14 1.5
@@ -1,3 +1,4 @@
+#include "modperl_largefiles.h"
#include "mod_perl.h"
#include "apr_perlio.h"
@@ -194,8 +195,6 @@
apr_off_t offset = 0;
apr_status_t rc;
-/* this is broken, for some reason it returns 6e17 */
-
rc = apr_file_seek(st->file, APR_CUR, &offset);
if (rc == APR_SUCCESS) {
return (Off_t) offset;
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/17 17:13:15
Modified:xs/APR/PerlIO apr_perlio.c
Log:
style nits:
- no //comments
- no else branch where if returns a value
- whitespace--
make note that modperl_* functions cannot be used outside of httpd
Revision ChangesPath
1.4 +33 -36modperl-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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apr_perlio.c 2001/12/18 00:37:01 1.3
+++ apr_perlio.c 2001/12/18 01:13:15 1.4
@@ -31,7 +31,7 @@
*/
static IV PerlIOAPR_popped(PerlIO *f)
{
-//PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+/* PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); */
return 0;
}
@@ -48,7 +48,7 @@
apr_status_t rc;
SV *sv;
-if ( !(SvROK(arg) || SvPOK(arg)) ) {
+if (!(SvROK(arg) || SvPOK(arg))) {
return NULL;
}
@@ -78,6 +78,7 @@
st = PerlIOSelf(f, PerlIOAPR);
sv = args[narg-1];
+/* XXX: modperl_sv2pool cannot be used outside of httpd */
st->pool = modperl_sv2pool(aTHX_ sv);
rc = apr_file_open(&st->file, path, apr_flag, APR_OS_DEFAULT, st->pool);
@@ -85,10 +86,9 @@
PerlIOBase(f)->flags |= PERLIO_F_ERROR;
return NULL;
}
-else {
-PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-return f;
-}
+
+PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+return f;
}
static IV PerlIOAPR_fileno(PerlIO *f)
@@ -105,7 +105,7 @@
{
apr_status_t rc;
-if ( (f = PerlIOBase_dup(aTHX_ f, o, param, flags)) ) {
+if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
PerlIOAPR *fst = PerlIOSelf(f, PerlIOAPR);
PerlIOAPR *ost = PerlIOSelf(o, PerlIOAPR);
@@ -117,10 +117,8 @@
}
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
@@ -129,33 +127,33 @@
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
-dTHX;
+dTHX; /* XXX: change Perl so this function has a pTHX_ prototype */
-//fprintf(stderr, "in read: count %d, %s\n", (int)count, (char*) vbuf);
+/* 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);
+/* fprintf(stderr, "out read: count %d, %s\n",
+ (int)count, (char*) vbuf); */
if (rc == APR_SUCCESS) {
return (SSize_t) count;
}
-else {
-return (SSize_t) -1;
-}
-}
+return (SSize_t) -1;
+}
static SSize_t PerlIOAPR_write(PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
apr_status_t rc;
-//fprintf(stderr, "in write: count %d, %s\n", (int)count, (char*) vbuf);
+/* 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;
}
-else {
-return (SSize_t) -1;
-}
+
+return (SSize_t) -1;
}
static IV PerlIOAPR_seek(PerlIO *f, Off_t offset, int whence)
@@ -186,9 +184,8 @@
if (rc == APR_SUCCESS) {
return 0;
}
-else {
-return -1;
-}
+
+return -1;
}
static Off_t PerlIOAPR_tell(PerlIO *f)
@@ -202,10 +199,9 @@
rc = apr_file_seek(st->file, APR_CUR, &offset);
if (rc == APR_SUCCESS) {
return (Off_t) offset;
-}
-else {
-return (Off_t) -1;
}
+
+return (Off_t) -1;
}
static IV PerlIOAPR_close(PerlIO *f)
@@ -216,7 +212,7 @@
const char *new_path;
apr_file_name_get(&new_path, st->file);
-//fprintf(stderr, "closing file %s\n", new_path);
+/* fprintf(stderr, "closing file %s\n", new_path); */
rc = apr_file_flush(st->file);
if (rc != APR_SUCCESS) {
@@ -240,9 +236,8 @@
if (rc == APR_SUCCESS) {
return 0;
}
-else {
-return -1;
-}
+
+return -1;
}
static IV PerlIOAPR_fill(PerlIO *f)
@@ -262,8 +257,9 @@
case APR_EOF:
return 1;
default:
-return -1;
}
+
+return -1;
}
static PerlIO_funcs PerlIO_APR = {
@@ -338,10 +334,9 @@
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
return f;
-}
-else {
-return NULL;
}
+
+return NUL
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 01/12/17 16:37:01
Modified:xs/APR/PerlIO apr_perlio.c
Log:
allow to compile with older bleedperls
Revision ChangesPath
1.3 +9 -2 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- apr_perlio.c 2001/12/17 16:55:46 1.2
+++ apr_perlio.c 2001/12/18 00:37:01 1.3
@@ -12,7 +12,7 @@
* PERLIO_LAYERS is available in 5.7.1
*/
-#ifdef PERLIO_LAYERS /* 5.7.2+ */
+#if defined(PERLIO_LAYERS) && defined(PERLIO_K_MULTIARG) /* 5.7.2+ */
/**
* The PerlIO APR layer.
@@ -377,7 +377,7 @@
type);
}
-#else /* NOT PERLIO_LAYERS (5.6.1) */
+#elif !defined(PERLIO_LAYERS) /* NOT PERLIO_LAYERS (5.6.1) */
FILE *apr_perlio_apr_file_to_FILE(pTHX_ apr_file_t *file, int type)
{
@@ -445,6 +445,13 @@
void apr_perlio_init(pTHX)
{
APR_REGISTER_OPTIONAL_FN(apr_perlio_apr_file_to_glob);
+}
+
+#else
+
+void apr_perlio_init(pTHX)
+{
+Perl_croak(aTHX_ "APR::PerlIO not usable with this version of Perl");
}
#endif /* PERLIO_LAYERS */
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas01/12/17 08:55:46
Modified:xs/APR/PerlIO apr_perlio.c
Log:
- maintainer mode cleanups
Revision ChangesPath
1.2 +3 -4 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- apr_perlio.c 2001/12/17 16:20:27 1.1
+++ apr_perlio.c 2001/12/17 16:55:46 1.2
@@ -31,7 +31,7 @@
*/
static IV PerlIOAPR_popped(PerlIO *f)
{
-PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+//PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
return 0;
}
@@ -41,12 +41,10 @@
const char *mode, int fd, int imode,
int perm, PerlIO *f, int narg, SV **args)
{
-AV *av_arg;
SV *arg = (narg > 0) ? *args : PerlIOArg;
PerlIOAPR *st;
const char *path;
apr_int32_t apr_flag;
-int len;
apr_status_t rc;
SV *sv;
@@ -105,7 +103,6 @@
static PerlIO *PerlIOAPR_dup(pTHX_ PerlIO *f, PerlIO *o,
CLONE_PARAMS *param, int flags)
{
-Size_t count;
apr_status_t rc;
if ( (f = PerlIOBase_dup(aTHX_ f, o, param, flags)) ) {
@@ -264,6 +261,8 @@
return 0;
case APR_EOF:
return 1;
+ default:
+return -1;
}
}
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c apr_perlio.h Makefile.PL PerlIO.xs PerlIO.pm
stas01/12/17 08:20:27
Added: t/response/TestAPR perlio.pm
xs/APR/PerlIO apr_perlio.c apr_perlio.h Makefile.PL
PerlIO.xs PerlIO.pm
Log:
- implements APR::PerlIO layer
- implements apr_file_t to APR::PerlIO conversion hooks (one way) (two
different sets for 5.6.1 and 5.7.2+)
- tests (conversion hooks are tested in Apache::SubProcess)
Revision ChangesPath
1.1 modperl-2.0/t/response/TestAPR/perlio.pm
Index: perlio.pm
===
package TestAPR::perlio;
use strict;
use warnings;# FATAL => 'all';
use Apache::Const -compile => 'OK';
use Apache::Test;
use Apache::TestUtil;
use APR::PerlIO ();
use Fcntl ();
use File::Spec::Functions qw(catfile);
sub handler {
my $r = shift;
plan $r, tests => 9, todo => [5], have_perl 'iolayers';
my $vars = Apache::Test::config()->{vars};
my $dir = catfile $vars->{documentroot}, "perlio";
t_mkdir($dir);
# write file
my $file = catfile $dir, "test";
t_debug "open file $file";
my $foo = "bar";
open my $fh, ">:APR", $file, $r
or die "Cannot open $file for writing: $!";
ok ref($fh) eq 'GLOB';
my $expected = "This is a test: $$";
t_debug "write to a file: $expected";
print $fh $expected;
close $fh;
# open() other tests
{
# non-existant file
my $file = "/this/file/does/not/exist";
t_write_file("/tmp/testing", "some stuff");
if (open my $fh, "<:APR", $file, $r) {
t_debug "must not be able to open $file!";
ok 0;
close $fh;
}
else {
t_debug "good! cannot open/doesn't exist: $!";
ok 1;
}
}
# read() test
{
open my $fh, "<:APR", $file, $r
or die "Cannot open $file for reading: $!";
ok ref($fh) eq 'GLOB';
my $received = <$fh>;
close $fh;
ok t_cmp($expected,
$received,
"read/write file");
}
# seek/tell() tests
{
open my $fh, "<:APR", $file, $r
or die "Cannot open $file for reading: $!";
my $pos = 3;
seek $fh, $pos, Fcntl::SEEK_SET();
# XXX: broken
my $got = tell($fh);
ok t_cmp($pos,
$got,
"seek/tell the file");
# XXX: test Fcntl::SEEK_CUR() Fcntl::SEEK_END()
close $fh;
}
# eof() tests
{
open my $fh, "<:APR", $file, $r
or die "Cannot open $file for reading: $!";
ok t_cmp(0,
int eof($fh), # returns false, not 0
"not end of file");
# go to the end and read
seek $fh, 0, Fcntl::SEEK_END();
my $received = <$fh>;
ok t_cmp(1,
eof($fh),
"end of file");
close $fh;
}
# dup() test
{
open my $fh, "<:APR", $file, $r
or die "Cannot open $file for reading: $!";
open my $dup_fh, "<&:APR", $fh
or die "Cannot dup $file for reading: $!";
close $fh;
ok ref($dup_fh) eq 'GLOB';
my $received = <$dup_fh>;
close $dup_fh;
ok t_cmp($expected,
$received,
"read/write a dupped file");
}
# XXX: need tests
# - for stdin/out/err as they are handled specially
# - unbuffered read $|=1?
# XXX: tmpfile is missing:
# consider to use 5.8's syntax:
# open $fh, "+>", undef;
# cleanup: t_mkdir will remove the whole tree including the file
Apache::OK;
}
1;
1.1 modperl-2.0/xs/APR/PerlIO/apr_perlio.c
Index: apr_perlio.c
===
#include "mod_perl.h"
#include "apr_perlio.h"
/* XXX: prerequisites to have things working
* open(): perl 5.7.2 patch 13534 is required
* dup() : apr cvs date: 2001/12/06 13:43:45
* tell(): the patch isn't in yet.
*
* XXX: it's not enough to check for PERLIO_LAYERS, some functionality
* and bug fixes were added only in the late 5.7.2, whereas
* PERLIO_LAYERS is available in 5.7.1
*/
#ifdef PERLIO_LAYERS /* 5.7.2+ */
/**
* The PerlIO APR layer.
* The PerlIO API is documented in perliol.pod.
**/
typedef struct {
PerlIOBuf base;/* PerlIOBuf stuff */
apr_file_t *file;
apr_pool_t *pool;
} PerlIOAPR;
/* clean up any structures linked from
