stas 2002/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 Changes Path 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 -0000 1.10 +++ perlio.pm 21 Jun 2002 15:28:43 -0000 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 -0000 1.15 +++ apr_perlio.c 21 Jun 2002 15:28:43 -0000 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 (*PerlIONext(f)) { + /* XXX: not sure if we can do anything here, but see + * PerlIOUnix_pushed for things that it does + */ + } + return code; } + static PerlIO *PerlIOAPR_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, @@ -65,6 +79,14 @@ apr_flag = APR_READ; break; } + + /* APR_BINARY: we always do binary read and PerlIO is supposed + * to handle :crlf if any (by pushing this layer at + * open(). + * APR_BUFFERED: XXX, not sure if it'll be needed if we will push + * :perlio (== PerlIOBuf) layer on top + */ + apr_flag |= APR_BUFFERED | APR_BINARY; st = PerlIOSelf(f, PerlIOAPR); @@ -91,10 +113,9 @@ 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 */ - /* see: http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-11/thrd21.html#02040 */ - /* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-12/threads.html#00217 */ + /* apr_file_t* is an opaque struct, so fileno is not available + * -1 in this case indicates that the layer cannot provide fileno + */ return -1; } @@ -126,6 +147,33 @@ return NULL; } + +static SSize_t PerlIOAPR_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) +{ + PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); + apr_status_t rc; + + rc = apr_file_read(st->file, vbuf, &count); + if (rc == APR_EOF) { + PerlIOBase(f)->flags |= PERLIO_F_EOF; + return count; + } + else if (rc != APR_SUCCESS) { + char errbuf[120]; +#ifdef PERLIO_APR_DEBUG + /* 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 $! */ + Perl_croak(aTHX_ "failed to read from file: %s", + apr_strerror(rc, errbuf, sizeof errbuf)); +#endif + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return -1; + } + + return count; +} + static SSize_t PerlIOAPR_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); @@ -141,32 +189,45 @@ return (SSize_t) count; } + PerlIOBase(f)->flags |= PERLIO_F_ERROR; return (SSize_t) -1; } +static IV PerlIOAPR_flush(pTHX_ PerlIO *f) +{ + PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); + apr_status_t rc; + + rc = apr_file_flush(st->file); + if (rc == APR_SUCCESS) { + return 0; + } + + return -1; +} + static IV PerlIOAPR_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); apr_seek_where_t where; apr_status_t rc; - IV code; apr_off_t seek_offset = 0; -#if MP_LARGE_FILES_PERL_ONLY +#if MP_LARGE_FILES_CONFLICT if (offset != 0) { Perl_croak(aTHX_ "PerlIO::APR::seek with non-zero offset" - " not supported with -Duselargefiles"); + " not supported with Perl built w/ -Duselargefiles" + " and APR w/o largefiles support"); } #else seek_offset = offset; #endif /* Flush the fill buffer */ - code = PerlIOBuf_flush(aTHX_ f); - if (code != 0) { - return code; + if (PerlIO_flush(f) != 0) { + return -1; } - + switch(whence) { case 0: where = APR_SET; @@ -241,18 +302,7 @@ return code; } -static IV PerlIOAPR_flush(pTHX_ PerlIO *f) -{ - PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); - apr_status_t rc; - - rc = apr_file_flush(st->file); - if (rc == APR_SUCCESS) { - return 0; - } - - return -1; -} +#if 0 /* we may use it if the buffering will be done at this layer */ static IV PerlIOAPR_fill(pTHX_ PerlIO *f) { @@ -271,7 +321,8 @@ rc = apr_file_read(st->file, st->base.ptr, &count); if (rc != APR_SUCCESS) { - /* XXX */ + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + return -1; } #if 0 @@ -298,6 +349,8 @@ return 0; } +#endif + static IV PerlIOAPR_eof(pTHX_ PerlIO *f) { PerlIOAPR *st = PerlIOSelf(f, PerlIOAPR); @@ -314,34 +367,36 @@ return -1; } + + static PerlIO_funcs PerlIO_APR = { "APR", sizeof(PerlIOAPR), - PERLIO_K_BUFFERED | PERLIO_K_FASTGETS | PERLIO_K_MULTIARG, - PerlIOBase_pushed, - PerlIOAPR_popped, + PERLIO_K_MULTIARG, + PerlIOAPR_pushed, + PerlIOBase_popped, PerlIOAPR_open, - NULL, /* XXX: binmode? */ - NULL, /* no getarg needed */ + PerlIOBase_binmode, /* binmode() is handled by :crlf */ + NULL, /* no getarg needed */ PerlIOAPR_fileno, PerlIOAPR_dup, - PerlIOBuf_read, - PerlIOBuf_unread, + PerlIOAPR_read, + PerlIOBase_unread, PerlIOAPR_write, PerlIOAPR_seek, PerlIOAPR_tell, PerlIOAPR_close, - PerlIOAPR_flush, - PerlIOAPR_fill, + PerlIOAPR_flush, /* flush */ + PerlIOBase_noop_fail, /* fill */ PerlIOAPR_eof, PerlIOBase_error, PerlIOBase_clearerr, PerlIOBase_setlinebuf, - PerlIOBuf_get_base, - PerlIOBuf_bufsiz, - PerlIOBuf_get_ptr, - PerlIOBuf_get_cnt, - PerlIOBuf_set_ptrcnt, + NULL, /* get_base */ + NULL, /* get_bufsiz */ + NULL, /* get_ptr */ + NULL, /* get_cnt */ + NULL, /* set_ptrcnt */ }; void apr_perlio_init(pTHX) 1.3 +1 -0 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.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- apr_perlio.h 6 Mar 2002 05:30:27 -0000 1.2 +++ apr_perlio.h 21 Jun 2002 15:28:43 -0000 1.3 @@ -9,6 +9,7 @@ #include "apr_portable.h" #include "apr_file_io.h" +#include "apr_errno.h" #ifndef MP_SOURCE_SCAN #include "apr_optional.h"