1N/A * perlio.c Copyright (c) 1996-2004, Nick Ing-Simmons You may distribute 1N/A * under the terms of either the GNU General Public License or the 1N/A * Artistic License, as specified in the README file. 1N/A * Hour after hour for nearly three weary days he had jogged up and down, 1N/A * over passes, and through long dales, and across many streams. 1N/A * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get 1N/A * at the dispatch tables, even when we do not need it for other reasons. 1N/A * Invent a dSYS macro to abstract this out 1N/A * #define PerlIO FILE 1N/A * This file provides those parts of PerlIO abstraction 1N/A * Which these are depends on various Configure #ifdef's 1N/A/* Missing proto on LynxOS */ 1N/A/* Call the callback or PerlIOBase, and return failure. */ 1N/A/* Call the callback or fail, and return failure. */ 1N/A/* Call the callback or PerlIOBase, and be void. */ 1N/A/* Call the callback or fail, and be void. */ 1N/A * This used to be contents of do_binmode in doio.c 1N/A * The translation mode of the stream is maintained independent of 1N/A * the translation mode of the fd in the Borland RTL (heavy 1N/A * digging through their runtime sources reveal). User has to set 1N/A * the mode explicitly for the stream (though they don't document 1N/A * this anywhere). GSAR 97-5-24 1N/A /* the r+ is a hack */ 1N/A * De-mux PerlIO_openn() into fdopen, freopen and fopen type entries 1N/A * Does nothing (yet) except force this file to be included in perl 1N/A * binary. That allows this file to force inclusion of other functions 1N/A * that may be required by loadable extensions e.g. for 1N/A * FileHandle::tmpfile 1N/A#
else /* PERLIO_IS_STDIO */ 1N/A * This section is just to make sure these functions get pulled in from 1N/A * Force this file to be included in perl binary. Which allows this 1N/A * file to force inclusion of other functions that may be required by 1N/A * loadable extensions e.g. for FileHandle::tmpfile 1N/A * Hack sfio does its own 'autoflush' on stdout in common cases. Flush 1N/A * results in a lot of lseek()s to regular files and lot of small 1N/A/* This is not the reverse of PerlIO_exportFILE(), PerlIO_releaseFILE() is. */ 1N/A/*======================================================================================*/ 1N/A * Implement all the PerlIO interface ourselves. 1N/A * We _MUST_ have <unistd.h> if we are using lseek() and may have large 1N/A /* Use fixed buffer as sv_catpvf etc. needs SVs */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * Inner level routines 1N/A * Table of pointers to the PerlIO structs (malloc'ed) 1N/A * Find a free slot in the table, allocating new table as necessary 1N/A * If popped returns non-zero do not free its layer structure 1N/A * it has either done so itself, or it is shared and still in 1N/A/* Return as an array the stack of layers on a filehandle. Note that 1N/A * the stack is returned top-first in the array, and there are three 1N/A * times as many array elements as there are layers in the stack: the 1N/A * first element of a layer triplet is the name, the second one is the 1N/A * arguments, and the third one is the flags. */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * XS Interface for perl code 1N/A * The two SVs are magically freed by load_module 1N/A#
endif /* USE_ATTIBUTES_FOR_PERLIO */ 1N/A /* This is used as a %SIG{__WARN__} handler to supress warnings 1N/A during loading of layers. 1N/A * Message is consistent with how attribute lists are 1N/A * passed. Even though this means "foo : : bar" is 1N/A * seen as an invalid separator character. 1N/A char q = ((*s ==
'\'') ?
'"' :
'\'');
1N/A "Invalid separator character %c%c%c in PerlIO layer specification %s",
1N/A * It's a nul terminated string, not allowed 1N/A * to \ the terminating null. Anything other 1N/A * character is passed over. 1N/A "Argument list not closed for PerlIO layer \"%.*s\"",
1N/A /* Real layer with a data area */ 1N/A /* Pseudo-layer where push does its own stack adjust */ 1N/A /* Is layer suitable for raw stream ? */ 1N/A /* Yes - turn off UTF-8-ness, to undo UTF-8 locale effects */ 1N/A /* Not suitable - pop it */ 1N/A * Strip all layers that are not suitable for a raw stream 1N/A while (t && (l = *t)) {
1N/A /* Has a handler - normal case */ 1N/A /* Layer still there - move down a layer */ 1N/A /* No handler - pop it */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * Given the abstraction above the public API functions 1N/A /* Do not flush etc. if (e.g.) switching encodings. 1N/A if a pushed layer knows it needs to flush lower layers 1N/A (for example :unix which is never going to call them) 1N/A it can do the flush when it is pushed. 1N/A /* Fake 5.6 legacy of using this call to turn ON O_TEXT */ 1N/A /* Legacy binmode only has meaning if O_TEXT has a value distinct from 1N/A O_BINARY so we can look for it in mode. 1N/A /* FIXME?: Looking down the layer stack seems wrong, 1N/A but is a way of reaching past (say) an encoding layer 1N/A to flip CRLF-ness of the layer(s) below 1N/A /* Perhaps we should turn on bottom-most aware layer 1N/A e.g. Ilya's idea that UNIX TTY could serve 1N/A /* Not in text mode - flush any pending stuff and flip it */ 1N/A /* Only need to turn it on in one layer so we are done */ 1N/A /* Not finding a CRLF aware layer presumably means we are binary 1N/A which is not what was requested - so we failed 1N/A We _could_ push :crlf layer but so could caller 1N/A /* Legacy binmode is now _defined_ as being equivalent to pushing :raw 1N/A So code that used to be here is now in PerlIORaw_pushed(). 1N/A * Need to supply default layer info from open.pm 1N/A * Skip to write part 1N/A * For any scalar type load the handler which is bundled with perl 1N/A * For other types allow if layer is known but don't try and load it 1N/A * If it is a reference but not an object see if we have a handler 1N/A * Don't fail if handler cannot be found :via(...) etc. may do 1N/A * something sensible else we will just stringfy and open 1N/A * This is "reopen" - it is not tested as perl does not use it 1N/A * Start at "top" of layer stack 1N/A * Found that layer 'n' can do opens - call it 1N/A * More layers above the one that we used to open - 1N/A /* If pushing layers fails close the file */ 1N/A return 0;
/* If no Flush defined, silently succeed. */ 1N/A * Is it good API design to do flush-all on NULL, a potentially 1N/A * errorneous input? Maybe some magical value (PerlIO* 1N/A * PERLIO_FLUSH_ALL = (PerlIO*)-1;)? Yes, stdio does similar 1N/A * things on fflush(NULL), but should we be bound by their design 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * utf8 and raw dummy layers 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * "Methods" of the "base class" 1N/A * Save the position as current head considers it 1N/A /* Place holder for stdstreams call ??? */ 1N/A /* Raise STDIN..STDERR refcount so we don't close them */ 1N/A for (i=0; i <
3; i++)
1N/A /* Restore STDIN..STDERR refcount */ 1N/A for (i=0; i <
3; i++)
1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * Bottom-most level for UNIX-like case 1N/A int fd;
/* UNIX like file descriptor */ 1N/A * Always open in binary mode 1N/A /* We never call down so do any pending stuff now */ 1N/A * XXX could (or should) we retrieve the oflags from the open file 1N/A * handle rather than believing the "mode" we are passed in? XXX 1N/A * Should the value on NULL mode be 0 or -1? 1N/A * FIXME: pop layers ??? 1N/A /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A/* perl5.8 - This ensures the last minute VMS ungetc fix is not 1N/A broken by the last second glibc 2.3 fix 1N/A /* Top is already stdio - pop self (duplicate) and use original */ 1N/A /* We never call down so do any pending stuff now */ 1N/A /* We need to probe to see how we can open the stream 1N/A we dup() so that we can fclose without loosing the fd. 1N/A Note that the errno value set by a failing fdopen 1N/A varies between stdio implementations. 1N/A /* Don't seem to be able to open */ 1N/A /* Cygwin wants its 'b' early. */ 1N/A /* This assumes no layers underneath - which is what 1N/A happens, but is not how I remember it. NI-S 2001/10/16 1N/A /* FIXME: To avoid messy error recovery if dup fails 1N/A re-use the existing stdio as though flag was not set 1N/A /* XXX this could use PerlIO_canset_fileno() and 1N/A * PerlIO_set_fileno() support from Configure 1N/A /* There may be a better way for GLIBC: 1N/A - libio.h defines a flag to not close() on cleanup 1N/A /* Next one ->_file seems to be a reasonable fallback, i.e. if 1N/A your platform does not have special entry try this one. 1N/A [For OSF only have confirmation for Tru64 (alpha) 1N/A but assume other OSFs will be similar.] 1N/A /* There may be a better way on FreeBSD: 1N/A - we could insert a dummy func in the _close function entry 1N/A f->_close = (int (*)(void *)) dummy_close; 1N/A /* f->_flags &= ~_IOOPEN; */ /* Will leak stream->_buffer */ 1N/A /* There may be a better way on CYGWIN: 1N/A - we could insert a dummy func in the _close function entry 1N/A f->_close = (int (*)(void *)) dummy_close; 1N/A /* WIN_CE does not have access to FILE internals, it hardly has FILE 1N/A /* Sarathy's code did this - we fall back to a dup/dup2 hack 1N/A (which isn't thread safe) instead 1N/A#
error "Don't know how to set FILE.fileno on your platform" 1N/A /* Socks lib overrides close() but stdio isn't linked to 1N/A that library (though we are) - so we must call close() 1N/A on sockets on stdio's behalf. 1N/A /* File descriptor still in use */ 1N/A /* For STD* handles don't close the stdio at all 1N/A this is because we have shared the FILE * too 1N/A /* Some stdios are buggy fflush-ing inputs */ 1N/A /* Tricky - must fclose(stdio) to free memory but not close(fd) 1N/A Use Sarathy's trick from maint-5.6 to invalidate the 1N/A fileno slot of the FILE * 1N/A /* We treat error from stdio as success if we invalidated 1N/A errno may NOT be expected EBADF 1N/A /* in SOCKS case let close() determine return value */ 1N/A * Perl is expecting PerlIO_getc() to fill the buffer Linux's 1N/A * stdio does not do that for fread() 1N/A /* We can get pointer to buffer but not its base 1N/A Do ungetc() but check chars are ending up in the 1N/A /* ungetc did not work */ 1N/A /* Did not change pointer as expected */ 1N/A * FIXME: This discards ungetc() and pre-read stuff which is not 1N/A * right if this is just a "sync" from a layer above Suspect right 1N/A * design is to do _this_ but not have layer above flush this 1N/A * layer read-to-read 1N/A * Not writeable - sync by attempting a seek 1N/A * Setting ptr _does_ change cnt - we are done 1N/A#
else /* STDIO_PTR_LVALUE */ 1N/A#
endif /* STDIO_PTR_LVALUE */ 1N/A * Now (or only) set cnt 1N/A#
else /* STDIO_CNT_LVALUE */ 1N/A#
else /* STDIO_PTR_LVAL_SETS_CNT */ 1N/A#
endif /* STDIO_PTR_LVAL_SETS_CNT */ 1N/A#
endif /* STDIO_CNT_LVALUE */ 1N/A * fflush()ing read-only streams can cause trouble on some stdio-s 1N/A /* Fake ungetc() to the real buffer in case system's ungetc 1N/A /* An ungetc()d char is handled separately from the regular 1N/A * buffer, so we stuff it in the buffer ourselves. 1N/A * Should never get called as should hit code above 1N/A /* If buffer snoop scheme above fails fall back to 1N/A#
endif /* HAS_FAST_STDIO && USE_FAST_STDIO */ 1N/A#
endif /* USE_STDIO_PTR */ 1N/A/* Note that calls to PerlIO_exportFILE() are reversed using 1N/A * PerlIO_releaseFILE(), not importFILE. */ 1N/A /* De-link any lower layers so new :stdio sticks */ 1N/A /* Link previous lower layers under new one */ 1N/A /* restore layers list */ 1N/A /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */ 1N/A/* Use this to reverse PerlIO_exportFILE calls. */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * perlio buffer layer 1N/A * if push fails during open, open fails. close will pop us. 1N/A * Initial stderr is unbuffered 1N/A * do something about failing setmode()? --jhi 1N/A * This "flush" is akin to sfio's sync in that it handles files in either 1N/A * read or write state 1N/A * write() the buffer 1N/A * Note position change 1N/A /* We did not consume all of it - try and seek downstream to 1N/A our logical position 1N/A /* Reload n as some layers may pop themselves on seek */ 1N/A /* Seek failed (e.g. pipe or tty). Do NOT clear buffer or pre-read 1N/A data is lost for good - so return saying "ok" having undone 1N/A /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */ 1N/A * Down-stream flush is defined not to loose read data so is harmless. 1N/A * we would not normally be fill'ing if there was data left in anycase. 1N/A * Layer below is also buffered. We do _NOT_ want to call its 1N/A * ->Read() because that will loop till it gets what we asked for 1N/A * which may hang on a pipe etc. Instead take anything it has to 1N/A * hand, or ask it to fill _once_. 1N/A * Buffer is already a read buffer, we can overwrite any chars 1N/A * which have been read back to buffer start 1N/A * Buffer is idle, set it up so whole buffer is available for 1N/A * Buffer extends _back_ from where we are now 1N/A * If we have space for more than count, just move count 1N/A * In simple stdio-like ungetc() case chars will be already 1N/A * b->posn is file position where b->buf was read, or will be written 1N/A /* As O_APPEND files are normally shared in some sense it is better 1N/A /* when file is NOT shared then this is sufficient */ 1N/A * If buffer is valid adjust position by amount in buffer 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * Temp layer to hold unread chars when cannot do it any other way 1N/A * Should never happen 1N/A * A tad tricky - flush pops us, then we close new top 1N/A * A tad tricky - flush pops us, then we seek new top 1N/A * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets() 1N/A * etc. get muddled when it changes mid-string when we auto-pop. 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * crlf - translation On read translate CR,LF to "\n" we do this by 1N/A * overriding ptr/cnt entries to hand back a line at a time and keeping a 1N/A * record of which nl we "lied" about. On write translate "\n" to CR,LF 1N/A /* Enable the first CRLF capable layer you can find, but if none 1N/A * found, the one we just pushed is fine. This results in at 1N/A * any given moment at most one CRLF-capable layer being enabled 1N/A * in the whole layer stack. */ 1N/A * Not CR,LF but just CR 1N/A * Blast - found CR as last char in buffer 1N/A * They may not care, defer work as long as 1N/A b->
ptr++;
/* say we have read it as far as 1N/A * flush() is concerned */ 1N/A b->
buf++;
/* Leave space in front of buffer */ 1N/A /* Note as we have moved buf up flush's 1N/A will naturally make posn point at CR 1N/A b->
bufsiz++;
/* Restore size for next time */ 1N/A b->
buf--;
/* Point at space */ 1N/A *
nl =
0xd;
/* Fill in the CR */ 1N/A goto test;
/* fill() call worked */ 1N/A * CR at EOF - just fall through 1N/A /* Should we clear EOF though ??? */ 1N/A /* Defered CR at end of buffer case - we lied about count */ 1N/A * Test code - delete when it works ... 1N/A /* Defered CR at end of buffer case - we lied about count */ 1N/A * They have taken what we lied about 1N/A /* In text mode - flush any pending stuff and flip it */ 1N/A /* CRLF is unusual case - if this is just the :crlf layer pop it */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * mmap as "buffer" layer 1N/A "panic: sysconf: pagesize unknown");
1N/A * This is a hack - should never happen - open should 1N/A * Already have a readbuffer in progress 1N/A * We have a write buffer or flushed PerlIOBuf read buffer 1N/A m->
bbuf = b->
buf;
/* save it in case we need it again */ 1N/A * Map did not work - recover PerlIOBuf buffer if we have one 1N/A * Loose the unwritable mapped buffer 1N/A * If flush took the "buffer" see if we have one from before 1N/A * No, or wrong sort of, buffer 1N/A * If unmap took the "buffer" see if we have one from before 1N/A * Now we are "synced" at PerlIOBuf level 1N/A * We seem to have a PerlIOBuf buffer which was not mapped 1N/A * remember it in case we need one later 1N/A#
endif /* HAS_MMAP */ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A/*--------------------------------------------------------------------------------------*/ 1N/A * Functions which can be called on any kind of PerlIO implemented in 1N/A return (
unsigned char)
buf[0];
1N/A * I have no idea how portable mkstemp() is ... NI-S 1N/A#
else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ 1N/A#
endif /* else HAS_MKSTEMP */ 1N/A#
endif /* else WIN32 */ 1N/A#
endif /* USE_SFIO */ 1N/A#
endif /* PERLIO_IS_STDIO */ 1N/A/*======================================================================================*/ 1N/A * Now some functions in terms of above which may be needed even if we are 1N/A * not in true PerlIO mode 1N/A return 0;
/* wrong, but perl doesn't use the return 1N/A return 0;
/* wrong, but perl doesn't use the return 1N/A "panic: sprintf overflow - memory corrupted!\n");