From: Nick Ing-Simmons Date: Sun, 16 Jun 2002 16:38:59 +0000 (+0000) Subject: Last minute tinkering with PerlIO abstraction API. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4b069b44f3c785593c10e7aca80c893a2f210b9d;p=p5sagit%2Fp5-mst-13.2.git Last minute tinkering with PerlIO abstraction API. - PerlIO_importFILE and PerlIO_exportFILE now documented as taking const char *mode. - Other 'flags' field changed to U32 - Discouraging words written about ":raw". p4raw-id: //depot/perlio@17258 --- diff --git a/perlio.c b/perlio.c index 25c78aa..4916358 100644 --- a/perlio.c +++ b/perlio.c @@ -338,11 +338,13 @@ PerlIO_init(pTHX) } PerlIO * -PerlIO_importFILE(FILE *stdio, int fl) +PerlIO_importFILE(FILE *stdio, const char *mode) { int fd = fileno(stdio); - PerlIO *r = PerlIO_fdopen(fd, "r+"); - return r; + if (!mode || !*mode) { + mmode = "r+"; + } + return PerlIO_fdopen(fd, mode); } FILE * @@ -2199,7 +2201,7 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); if (*PerlIONext(f)) { - /* We never call down so any pending stuff now */ + /* We never call down so do any pending stuff now */ PerlIO_flush(PerlIONext(f)); s->fd = PerlIO_fileno(PerlIONext(f)); /* @@ -2445,7 +2447,7 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) PerlIOStdio_mode(mode, tmode)); if (stdio) { s->stdio = stdio; - /* We never call down so any pending stuff now */ + /* We never call down so do any pending stuff now */ PerlIO_flush(PerlIONext(f)); } else @@ -2456,36 +2458,35 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) PerlIO * -PerlIO_importFILE(FILE *stdio, int fl) +PerlIO_importFILE(FILE *stdio, const char *mode) { dTHX; PerlIO *f = NULL; if (stdio) { - /* We need to probe to see how we can open the stream - so start with read/write and then try write and read - we dup() so that we can fclose without loosing the fd. - - Note that the errno value set by a failing fdopen - varies between stdio implementations. - */ - int fd = PerlLIO_dup(fileno(stdio)); - char *mode = "r+"; - FILE *f2 = fdopen(fd, mode); PerlIOStdio *s; - if (!f2) { - mode = "w"; - f2 = fdopen(fd, mode); - } - if (!f2) { - mode = "r"; - f2 = fdopen(fd, mode); - } - if (!f2) { - /* Don't seem to be able to open */ - PerlLIO_close(fd); - return f; + if (!mode || !*mode) { + /* We need to probe to see how we can open the stream + so start with read/write and then try write and read + we dup() so that we can fclose without loosing the fd. + + Note that the errno value set by a failing fdopen + varies between stdio implementations. + */ + int fd = PerlLIO_dup(fileno(stdio)); + FILE *f2 = fdopen(fd, (mode = "r+")); + if (!f2) { + f2 = fdopen(fd, (mode = "w")); + } + if (!f2) { + f2 = fdopen(fd, (mode = "r")); + } + if (!f2) { + /* Don't seem to be able to open */ + PerlLIO_close(fd); + return f; + } + fclose(f2); } - fclose(f2); s = PerlIOSelf(PerlIO_push (aTHX_(f = PerlIO_allocate(aTHX)), &PerlIO_stdio, mode, Nullsv), PerlIOStdio); @@ -2964,13 +2965,16 @@ PerlIO_funcs PerlIO_stdio = { }; FILE * -PerlIO_exportFILE(PerlIO *f, int fl) +PerlIO_exportFILE(PerlIO *f, const char *mode) { dTHX; FILE *stdio; char buf[8]; PerlIO_flush(f); - stdio = fdopen(PerlIO_fileno(f), PerlIO_modestr(f,buf)); + if (!mode || !*mode) { + mode = PerlIO_modestr(f,buf); + } + stdio = fdopen(PerlIO_fileno(f), mode); if (stdio) { PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv), @@ -2991,7 +2995,8 @@ PerlIO_findFILE(PerlIO *f) } l = *PerlIONext(&l); } - return PerlIO_exportFILE(f, 0); + /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */ + return PerlIO_exportFILE(f, Nullch); } void @@ -3022,13 +3027,14 @@ PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); int fd = PerlIO_fileno(f); - Off_t posn; if (fd >= 0 && PerlLIO_isatty(fd)) { PerlIOBase(f)->flags |= PERLIO_F_LINEBUF | PERLIO_F_TTY; } - posn = PerlIO_tell(PerlIONext(f)); - if (posn != (Off_t) - 1) { - b->posn = posn; + if (*PerlIONext(f)) { + Off_t posn = PerlIO_tell(PerlIONext(f)); + if (posn != (Off_t) - 1) { + b->posn = posn; + } } return PerlIOBase_pushed(aTHX_ f, mode, arg); } @@ -3126,14 +3132,19 @@ PerlIOBuf_flush(pTHX_ PerlIO *f) */ b->posn += (b->ptr - buf); if (b->ptr < b->end) { - /* - * We did not consume all of it + /* We did not consume all of it - try and seek downstream to + our logical position */ - if (PerlIO_seek(n, b->posn, SEEK_SET) == 0) { + if (PerlIOValid(n) && PerlIO_seek(n, b->posn, SEEK_SET) == 0) { /* Reload n as some layers may pop themselves on seek */ b->posn = PerlIO_tell(n = PerlIONext(f)); } else { + /* Seek failed (e.g. pipe or tty). Do NOT clear buffer or pre-read + data is lost for good - so return saying "ok" having undone + the position adjust + */ + b->posn -= (b->ptr - buf); return code; } } @@ -3141,7 +3152,6 @@ PerlIOBuf_flush(pTHX_ PerlIO *f) b->ptr = b->end = b->buf; PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */ - /* FIXME: Doing downstream flush may be sub-optimal see PerlIOBuf_fill() below */ if (PerlIOValid(n) && PerlIO_flush(n) != 0) code = -1; return code; @@ -3154,10 +3164,8 @@ PerlIOBuf_fill(pTHX_ PerlIO *f) PerlIO *n = PerlIONext(f); SSize_t avail; /* - * FIXME: doing the down-stream flush maybe sub-optimal if it causes - * pre-read data in stdio buffer to be discarded. - * However, skipping the flush also skips _our_ hosekeeping - * and breaks tell tests. So we do the flush. + * Down-stream flush is defined not to loose read data so is harmless. + * we would not normally be fill'ing if there was data left in anycase. */ if (PerlIO_flush(f) != 0) return -1; @@ -3168,6 +3176,12 @@ PerlIOBuf_fill(pTHX_ PerlIO *f) PerlIO_get_base(f); /* allocate via vtable */ b->ptr = b->end = b->buf; + + if (!PerlIOValid(n)) { + PerlIOBase(f)->flags |= PERLIO_F_EOF; + return -1; + } + if (PerlIO_fast_gets(n)) { /* * Layer below is also buffered. We do _NOT_ want to call its diff --git a/perlio.h b/perlio.h index 172a806..3fa6b15 100644 --- a/perlio.h +++ b/perlio.h @@ -241,10 +241,10 @@ extern int PerlIO_ungetc(PerlIO *, int); extern PerlIO *PerlIO_fdopen(int, const char *); #endif #ifndef PerlIO_importFILE -extern PerlIO *PerlIO_importFILE(FILE *, int); +extern PerlIO *PerlIO_importFILE(FILE *, const char *); #endif #ifndef PerlIO_exportFILE -extern FILE *PerlIO_exportFILE(PerlIO *, int); +extern FILE *PerlIO_exportFILE(PerlIO *, const char *); #endif #ifndef PerlIO_findFILE extern FILE *PerlIO_findFILE(PerlIO *); diff --git a/perliol.h b/perliol.h index 250a015..124589b 100644 --- a/perliol.h +++ b/perliol.h @@ -64,7 +64,7 @@ struct _PerlIO_funcs { struct _PerlIO { PerlIOl *next; /* Lower layer */ PerlIO_funcs *tab; /* Functions for this layer */ - IV flags; /* Various flags for state */ + U32 flags; /* Various flags for state */ }; /*--------------------------------------------------------------------------------------*/ diff --git a/pod/perlapio.pod b/pod/perlapio.pod index 981ee20..9da7f2d 100644 --- a/pod/perlapio.pod +++ b/pod/perlapio.pod @@ -56,7 +56,7 @@ perlapio - perl's IO abstraction interface. char *PerlIO_get_base(PerlIO *f); int PerlIO_get_bufsiz(PerlIO *f); - PerlIO *PerlIO_importFILE(FILE *stdio, int flags); + PerlIO *PerlIO_importFILE(FILE *stdio, const char *mode); FILE *PerlIO_exportFILE(PerlIO *f, int flags); FILE *PerlIO_findFILE(PerlIO *f); void PerlIO_releaseFILE(PerlIO *f,FILE *stdio); @@ -162,7 +162,7 @@ so it is (currently) legal to use C in perl sources. These correspond to fread() and fwrite(). Note that arguments are different, there is only one "count" and order has "file" -first. Returns a byte count if successful (which may be zero), returns +first. Returns a byte count if successful (which may be zero or positive), returns negative value and sets C on error. Depending on implementation C may be C if operation was interrupted by a signal. @@ -220,9 +220,12 @@ This corresponds to clearerr(), i.e., clears 'error' and (usually) This corresponds to fflush(). Sends any buffered write data to the underlying file. If called with C this may flush all open -streams (or core dump). Calling on a handle open for read only, or on -which last operation was a read of some kind may lead to undefined -behaviour. +streams (or core dump with some USE_STDIO implementattions). +Calling on a handle open for read only, or on which last operation was a read of some kind +may lead to undefined behaviour on some USE_STDIO implementations. +The USE_PERLIO (layers) implementation tries to behave better: it flushes all open streams +when passed C, and attempts to retain data on read streams either in the buffer +or by seeking the handle to the current logical position. =item B @@ -303,14 +306,14 @@ changes in this area. =over 4 -=item B +=item B Used to get a PerlIO * from a FILE *. -The flags argument was meant to be used for read vs write vs -read/write information. In hindsight it would have been better to make -it a char *mode as in fopen/freopen. Flags are currently ignored, and -code attempts to empirically determine the mode in which I is open. +The mode argument should be a string as would be passed to fopen/PerlIO_open. +If it is NULL then - for legacy support - the code will (depending upon +the platform and the implementation) either attempt to empirically determine the mode in +which I is open, or use "r+" to indicate a read/write stream. Once called the FILE * should I be closed by calling C on the returned PerlIO *. @@ -318,14 +321,13 @@ C on the returned PerlIO *. The PerlIO is set to textmode. Use PerlIO_binmode if this is not the desired mode. -=item B +=item B Given a PerlIO * create a 'native' FILE * suitable for passing to code expecting to be compiled and linked with ANSI C I. -The flags argument was meant to be used for read vs write vs -read/write information. In hindsight it would have been better to make -it a char *mode as in fopen/freopen. Flags are ignored and the -FILE * is opened in same mode as the PerlIO *. +The mode argument should be a string as would be passed to fopen/PerlIO_open. +If it is NULL then - for legacy support - the FILE * is opened +in same mode as the PerlIO *. The fact that such a FILE * has been 'exported' is recorded, (normally by pushing a new :stdio "layer" onto the PerlIO *), which may affect future @@ -445,8 +447,8 @@ happened to C (or whatever) last time IO was requested. The new interface to the USE_PERLIO implementation. The layers ":crlf" and ":raw" are only ones allowed for other implementations and those -are silently ignored. Use PerlIO_binmode() below for the portable -case. +are silently ignored. (As of perl5.8 ":raw" is deprecated.) +Use PerlIO_binmode() below for the portable case. =item PerlIO_binmode(f,ptype,imode,layers) @@ -465,12 +467,12 @@ B is perl's character for the kind of IO: B is C or C. -B is a string of layers to apply, only ":raw" or :"crlf" make -sense in the non USE_PERLIO case. +B is a string of layers to apply, only ":crlf" makes sense in the non USE_PERLIO +case. (As of perl5.8 ":raw" is deprecated in favour of passing NULL.) Portable cases are: - PerlIO_binmode(f,ptype,O_BINARY,":raw"); + PerlIO_binmode(f,ptype,O_BINARY,Nullch); and PerlIO_binmode(f,ptype,O_TEXT,":crlf"); diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 683026d..52cdd6a 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -4704,7 +4704,7 @@ B, B, B =item Co-existence with stdio -B, B, +B, B, B, B =item "Fast gets" Functions @@ -5371,6 +5371,8 @@ I =item Mac OS X +=item OS/2 Test Failures + =item op/sprintf tests 91, 129, and 130 =item Solaris 2.5 @@ -6990,6 +6992,8 @@ long, Process terminated by SIG%s =over 4 +=item NOTE + =item SYNOPSIS =back @@ -7042,6 +7046,8 @@ B, B =back +=item PERL 5.8.0 BROKEN IN AMIGAOS + =item AUTHORS =item SEE ALSO @@ -12980,7 +12986,7 @@ MYEXTLIB, NAME, NEEDS_LINKING, NOECHO, NORECURS, NO_VC, OBJECT, OPTIMIZE, PERL, PERL_CORE, PERLMAINCC, PERL_ARCHLIB, PERL_LIB, PERL_MALLOC_OK, PERLRUN, PERLRUNINST, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, PM, PMLIBDIRS, PM_FILTER, POLLUTE, PPM_INSTALL_EXEC, PPM_INSTALL_SCRIPT, PREFIX, -PREREQ_PM, PREREQ_FATAL, PREREQ_PRINT, PRINT_PREREQ, SITEPREFIX, SKIP, +PREREQ_FATAL, PREREQ_PM, PREREQ_PRINT, PRINT_PREREQ, SITEPREFIX, SKIP, TYPEMAPS, VENDORPREFIX, VERBINST, VERSION, VERSION_FROM, XS, XSOPT, XSPROTOARG, XS_VERSION