cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/08/21 08:40:17
Modified:xs/APR/PerlIO apr_perlio.c
Log:
- try to go without the dup() in the non-perlio case, leave enough
comments to easily reconstruct the dupping code correctly if that proves
to be wrong.
- add some debug tracing code
Revision ChangesPath
1.23 +24 -7 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.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- apr_perlio.c 21 Aug 2002 04:46:44 - 1.22
+++ apr_perlio.c 21 Aug 2002 15:40:17 - 1.23
-525,15 +525,32
/* convert to the OS representation of file */
rc = apr_os_file_get(os_file, file);
if (rc != APR_SUCCESS) {
-croak(filedes retrieval failed!);
+Perl_croak(aTHX_ 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))) {
+
+#ifdef PERLIO_APR_DEBUG
+Perl_warn(aTHX_ converting fd %d\n, os_file);
+#endif
+
+/* let's try without the dup, it seems to work fine:
+
+ fd = PerlLIO_dup(os_file);
+ Perl_warn(aTHX_ fd old: %d, new %d\n, os_file, fd);
+ if (!(retval = PerlIO_fdopen(fd, mode))) {
+ ...
+ }
+
+ in any case if we later decide to dup, remember to:
+
+ apr_file_close(file);
+
+ after PerlIO_fdopen() or that fh will be leaked
+
+*/
+
+if (!(retval = PerlIO_fdopen(os_file, mode))) {
PerlLIO_close(fd);
-croak(fdopen failed!);
+Perl_croak(aTHX_ fdopen failed!);
}
return retval;
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/08/21 08:41:29
Modified:xs/APR/PerlIO apr_perlio.c
Log:
similar to the perlio case:
- IoIFP(io) *must* be always set on the valid io sv, otherwise it'll be
never closed and fh and memory leaked. as i saw from doio.c, the solution
is to simply copy IoOFP.
- add IoTYPE_WRONLY and IoTYPE_RDONLY flags to protect from wrong use
Revision ChangesPath
1.24 +4 -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.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- apr_perlio.c 21 Aug 2002 15:40:17 - 1.23
+++ apr_perlio.c 21 Aug 2002 15:41:29 - 1.24
-567,11 +567,14
switch (type) {
case APR_PERLIO_HOOK_WRITE:
-IoOFP(GvIOp(gv)) = apr_perlio_apr_file_to_FILE(aTHX_ file, type);
+IoIFP(GvIOp(gv)) = IoOFP(GvIOp(gv)) =
+apr_perlio_apr_file_to_FILE(aTHX_ file, type);
IoFLAGS(GvIOp(gv)) |= IOf_FLUSH;
+IoTYPE(GvIOp(gv)) = IoTYPE_WRONLY;
break;
case APR_PERLIO_HOOK_READ:
IoIFP(GvIOp(gv)) = apr_perlio_apr_file_to_FILE(aTHX_ file, type);
+IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;
break;
};
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/08/20 21:44:14
Modified:xs/APR/PerlIO apr_perlio.c
Log:
improve errors handling
add extended debugging trace
Revision ChangesPath
1.21 +34 -11modperl-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.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- apr_perlio.c 5 Jul 2002 05:05:36 - 1.20
+++ apr_perlio.c 21 Aug 2002 04:44:14 - 1.21
-268,13 +268,20
#ifdef PERLIO_APR_DEBUG
const char *new_path = NULL;
+apr_os_file_t os_file;
+
if (!PL_dirty) {
/* if this is called during perl_destruct we are in trouble */
apr_file_name_get(new_path, st-file);
}
-Perl_warn(aTHX_ PerlIOAPR_close obj=0x%lx, file=0x%lx, name=%s\n,
- (unsigned long)f, (unsigned long)st-file,
+rc = apr_os_file_get(os_file, st-file);
+if (rc != APR_SUCCESS) {
+Perl_croak(aTHX_ filedes retrieval failed!);
+}
+
+Perl_warn(aTHX_ PerlIOAPR_close obj=0x%lx, file=0x%lx, fd=%d, name=%s\n,
+ (unsigned long)f, (unsigned long)st-file, os_file,
new_path ? new_path : (UNKNOWN));
#endif
-415,9 +422,11
{
char *mode;
const char *layers = :APR;
+PerlIOAPR *st;
PerlIO *f = PerlIO_allocate(aTHX);
+
if (!f) {
-return NULL;
+Perl_croak(aTHX_ Failed to allocate PerlIO struct);
}
switch (type) {
-430,19 +439,33
};
PerlIO_apply_layers(aTHX_ f, mode, layers);
+if (!f) {
+Perl_croak(aTHX_ Failed to apply the ':APR' layer);
+}
-if (f) {
-PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
+st = PerlIOSelf(f, PerlIOAPR);
-/* XXX: should we dup first? the timeout could close the fh! */
-st-pool = pool;
-st-file = file;
-PerlIOBase(f)-flags |= PERLIO_F_OPEN;
+#ifdef PERLIO_APR_DEBUG
+{
+apr_status_t rc;
+apr_os_file_t os_file;
-return f;
+/* convert to the OS representation of file */
+rc = apr_os_file_get(os_file, file);
+if (rc != APR_SUCCESS) {
+croak(filedes retrieval failed!);
+}
+
+Perl_warn(aTHX_ converting to PerlIO fd %d, mode '%s'\n,
+ os_file, mode);
}
+#endif
+
+st-pool = pool;
+st-file = file;
+PerlIOBase(f)-flags |= PERLIO_F_OPEN;
-return NULL;
+return f;
}
static SV *apr_perlio_PerlIO_to_glob(pTHX_ PerlIO *pio, apr_perlio_hook_e type)
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/08/20 21:46:44
Modified:xs/APR/PerlIO apr_perlio.c
Log:
- IoIFP(io) *must* be always set on the valid io sv, otherwise it'll be
never closed and fh and memory leaked. as i saw from doio.c, the solution
is to simply copy IoOFP.
- add IoTYPE_WRONLY and IoTYPE_RDONLY flags to protect from wrong use
Revision ChangesPath
1.22 +5 -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.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- apr_perlio.c 21 Aug 2002 04:44:14 - 1.21
+++ apr_perlio.c 21 Aug 2002 04:46:44 - 1.22
-478,11 +478,15
switch (type) {
case APR_PERLIO_HOOK_WRITE:
-IoOFP(GvIOp(gv)) = pio;
+ /* if IoIFP() is not assigned to it'll be never closed, see
+ * Perl_io_close() */
+IoIFP(GvIOp(gv)) = IoOFP(GvIOp(gv)) = pio;
IoFLAGS(GvIOp(gv)) |= IOf_FLUSH;
+IoTYPE(GvIOp(gv)) = IoTYPE_WRONLY;
break;
case APR_PERLIO_HOOK_READ:
IoIFP(GvIOp(gv)) = pio;
+IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY;
break;
};
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c apr_perlio.h
stas2002/06/21 08:28:44
Modified:t/response/TestAPR perlio.pm
xs/APR/PerlIO apr_perlio.c apr_perlio.h
Log:
APR PerlIO updates:
- make the apr layer independent from PerlIOBuf
- sync with the latest PerlIO API changes
- cleanup
- add a new test for buffered write
- prepare for the future possible LARGE_FILES_CONFLICT constant, for seek
tests
Revision ChangesPath
1.11 +20 -8 modperl-2.0/t/response/TestAPR/perlio.pm
Index: perlio.pm
===
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- perlio.pm 15 Jun 2002 23:48:58 - 1.10
+++ perlio.pm 21 Jun 2002 15:28:43 - 1.11
-12,6 +12,10
use Apache::Const -compile = 'OK';
use constant HAVE_PERLIO = eval { require APR::PerlIO };
+#XXX: feel free to enable if largefile support is not enabled in Perl
+#XXX: APR::LARGE_FILES_CONFLICT constant?
+use constant LARGE_FILES_CONFLICT = 1;
+
sub handler {
my $r = shift;
-22,10 +26,10
return Apache::OK;
}
-my $tests = 2; #XXX 11;
+my $tests = 12;
my $lfs_tests = 3;
-#$tests += $lfs_tests if USE_LARGE_FILES; #XXX
+$tests += $lfs_tests unless LARGE_FILES_CONFLICT;
plan $r, tests = $tests, have_perl 'iolayers';
-36,6 +40,7
my $sep = -- sep --\n;
my lines = (This is a test: $$\n, test line --sep two\n);
+
my $expected = $lines[0];
my $expected_all = join $sep, lines;
-66,10 +71,9
expected failure);
}
}
-return Apache::OK; #XXX remove when perlio issues are sorted out
+
# seek/tell() tests
-#XXX: feel free to enable if largefile support is not enabled in Perl
-if (0) {
+unless (LARGE_FILES_CONFLICT) {
open my $fh, :APR, $file, $r
or die Cannot open $file for reading: $!;
-132,7 +136,7
my expect = ($lines[0] . $sep, $lines[1]);
ok t_cmp(\@expect,
\@got_lines,
- adjusted input record sep read);
+ custom complex input record sep read);
close $fh;
}
-179,17 +183,25
{
open my $wfh, :APR, $file, $r
or die Cannot open $file for writing: $!;
+open my $rfh, :APR, $file, $r
+or die Cannot open $file for reading: $!;
my $expected = This is an un buffering write test;
# unbuffer
my $oldfh = select($wfh); $| = 1; select($oldfh);
print $wfh $expected; # must be flushed to disk immediately
-open my $rfh, :APR, $file, $r
-or die Cannot open $file for reading: $!;
ok t_cmp($expected,
scalar($rfh),
file unbuffered write);
+
+# buffer up
+$oldfh = select($wfh); $| = 0; select($oldfh);
+print $wfh $expected; # must be flushed to disk immediately
+
+ok t_cmp(undef,
+ scalar($rfh),
+ file buffered write);
close $wfh;
close $rfh;
1.16 +102 -47 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.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- apr_perlio.c 21 Jun 2002 02:06:48 - 1.15
+++ apr_perlio.c 21 Jun 2002 15:28:43 - 1.16
-10,23 +10,37
* The PerlIO API is documented in perliol.pod.
**/
+/*
+ * APR::PerlIO implements a PerlIO layer using apr_file_io as the core.
+ */
+
+/*
+ * XXX: Since we cannot snoop on the internal apr_file_io buffer
+ * currently the IO is not buffered on the Perl side so every read
+ * requests a char at a time, which is slow. Consider copying the
+ * relevant code from PerlIOBuf to implement our own buffer, similar
+ * to what PerlIOBuf does or push :perlio layer on top of this layer
+ */
+
typedef struct {
-PerlIOBuf base;/* PerlIOBuf stuff */
+struct _PerlIO base;
apr_file_t *file;
apr_pool_t *pool;
} PerlIOAPR;
-/* clean up any structures linked from PerlIOAPR. a layer can be
- * popped without being closed if the program is dynamically managing
- * layers on the stream.
- */
-static IV PerlIOAPR_popped(pTHX_ PerlIO *f)
-{
-/* PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); */
-return 0;
+static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+{
+IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+if
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/06/21 08:53:40
Modified:xs/APR/PerlIO apr_perlio.c
Log:
a few minor fixes and cleanups
Revision ChangesPath
1.17 +3 -7 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.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- apr_perlio.c 21 Jun 2002 15:28:43 - 1.16
+++ apr_perlio.c 21 Jun 2002 15:53:40 - 1.17
-28,7 +28,6
apr_pool_t *pool;
} PerlIOAPR;
-
static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
-40,7 +39,6
return code;
}
-
static PerlIO *PerlIOAPR_open(pTHX_ PerlIO_funcs *self,
PerlIO_list_t *layers, IV n,
const char *mode, int fd, int imode,
-147,7 +145,6
return NULL;
}
-
static SSize_t PerlIOAPR_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR);
-159,8 +156,8
return count;
}
else if (rc != APR_SUCCESS) {
-char errbuf[120];
#ifdef PERLIO_APR_DEBUG
+char errbuf[120];
/* XXX: need to figure way to map APR errno to normal errno,
* so we can use SETERRNO to make the apr errors available to
* Perl's $! */
-203,6 +200,7
return 0;
}
+PerlIOBase(f)-flags |= PERLIO_F_ERROR;
return -1;
}
-225,7 +223,7
/* Flush the fill buffer */
if (PerlIO_flush(f) != 0) {
- return -1;
+return -1;
}
switch(whence) {
-366,8 +364,6
return -1;
}
-
-
static PerlIO_funcs PerlIO_APR = {
APR,
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/06/21 10:37:38
Modified:xs/APR/PerlIO apr_perlio.c
Log:
adjust for PerlIO bleedperl changes
Revision ChangesPath
1.18 +3 -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.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- apr_perlio.c 21 Jun 2002 15:53:40 - 1.17
+++ apr_perlio.c 21 Jun 2002 17:37:38 - 1.18
-28,9 +28,9
apr_pool_t *pool;
} PerlIOAPR;
-static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
+static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs
*tab)
{
-IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
+IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
if (*PerlIONext(f)) {
/* XXX: not sure if we can do anything here, but see
* PerlIOUnix_pushed for things that it does
-366,6 +366,7
}
static PerlIO_funcs PerlIO_APR = {
+sizeof(PerlIO_funcs),
APR,
sizeof(PerlIOAPR),
PERLIO_K_MULTIARG,
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
stas2002/06/21 10:40:18
Modified:xs/APR/PerlIO apr_perlio.c
Log:
wrap the long args line
Revision ChangesPath
1.19 +2 -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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- apr_perlio.c 21 Jun 2002 17:37:38 - 1.18
+++ apr_perlio.c 21 Jun 2002 17:40:18 - 1.19
-28,7 +28,8
apr_pool_t *pool;
} PerlIOAPR;
-static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs
*tab)
+static IV PerlIOAPR_pushed(pTHX_ PerlIO *f, const char *mode,
+ SV *arg, PerlIO_funcs *tab)
{
IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
if (*PerlIONext(f)) {
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 2002/06/20 19:06:48 Modified:xs/APR/PerlIO apr_perlio.c Log: bleedperl now has a binmode PerlIO function Revision ChangesPath 1.15 +1 -0 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.14 retrieving revision 1.15 diff -u -r1.14 -r1.15 --- apr_perlio.c 31 May 2002 15:41:40 - 1.14 +++ apr_perlio.c 21 Jun 2002 02:06:48 - 1.15 -321,6 +321,7 PerlIOBase_pushed, PerlIOAPR_popped, PerlIOAPR_open, +NULL, /* XXX: binmode? */ NULL, /* no getarg needed */ PerlIOAPR_fileno, PerlIOAPR_dup,
cvs commit: modperl-2.0/xs/APR/PerlIO apr_perlio.c
dougm 2002/05/31 08:41:40
Modified:xs/APR/PerlIO apr_perlio.c
Log:
seek is ok if both perl and apr have largefiles enabled
Revision ChangesPath
1.14 +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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- apr_perlio.c 31 May 2002 02:20:29 - 1.13
+++ apr_perlio.c 31 May 2002 15:41:40 - 1.14
-152,7 +152,7
IV code;
apr_off_t seek_offset = 0;
-#ifdef USE_LARGE_FILES
+#if MP_LARGE_FILES_PERL_ONLY
if (offset != 0) {
Perl_croak(aTHX_ PerlIO::APR::seek with non-zero offset
not supported with -Duselargefiles);
