/*
- * perlio.c Copyright (c) 1996-2002, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute
* under the terms of either the GNU General Public License or the
* Artistic License, as specified in the README file.
*/
* over passes, and through long dales, and across many streams.
*/
+/* This file contains the functions needed to implement PerlIO, which
+ * is Perl's private replacement for the C stdio library. This is used
+ * by default unless you compile with -Uuseperlio or run with
+ * PERLIO=:stdio (but don't do this unless you know what you're doing)
+ */
+
/*
* If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get
* at the dispatch tables, even when we do not need it for other reasons.
va_list ap;
dSYS;
va_start(ap, fmt);
- if (!dbg) {
+ if (!dbg && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
char *s = PerlEnv_getenv("PERLIO_DEBUG");
if (s && *s)
dbg = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
}
if (dbg > 0) {
dTHX;
+ const char *s;
#ifdef USE_ITHREADS
/* Use fixed buffer as sv_catpvf etc. needs SVs */
char buffer[1024];
- char *s;
STRLEN len;
s = CopFILE(PL_curcop);
if (!s)
s = "(none)";
- sprintf(buffer, "%s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
+ sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
len = strlen(buffer);
vsprintf(buffer+len, fmt, ap);
PerlLIO_write(dbg, buffer, strlen(buffer));
#else
SV *sv = newSVpvn("", 0);
- char *s;
STRLEN len;
s = CopFILE(PL_curcop);
if (!s)
p = &(list->array[list->cur++]);
p->funcs = funcs;
if ((p->arg = arg)) {
- SvREFCNT_inc(arg);
+ (void)SvREFCNT_inc(arg);
}
}
PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
int fd = PerlIOSelf(f, PerlIOUnix)->fd;
- Off_t new;
+ Off_t new_loc;
if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
#ifdef ESPIPE
SETERRNO(ESPIPE, LIB_INVARG);
#endif
return -1;
}
- new = PerlLIO_lseek(fd, offset, whence);
- if (new == (Off_t) - 1)
+ new_loc = PerlLIO_lseek(fd, offset, whence);
+ if (new_loc == (Off_t) - 1)
{
return -1;
}
/* XXX this could use PerlIO_canset_fileno() and
* PerlIO_set_fileno() support from Configure
*/
-# if defined(__GLIBC__)
+# if defined(__UCLIBC__)
+ /* uClibc must come before glibc because it defines __GLIBC__ as well. */
+ f->__filedes = -1;
+ return 1;
+# elif defined(__GLIBC__)
/* There may be a better way for GLIBC:
- libio.h defines a flag to not close() on cleanup
*/
*/
f->_file = -1;
return 1;
+# elif defined(__OpenBSD__)
+ /* There may be a better way on OpenBSD:
+ - we could insert a dummy func in the _close function entry
+ f->_close = (int (*)(void *)) dummy_close;
+ */
+ f->_file = -1;
+ return 1;
# elif defined(__EMX__)
/* f->_flags &= ~_IOOPEN; */ /* Will leak stream->_buffer */
f->_handle = -1;
PerlIO_getname(PerlIO *f, char *buf)
{
dTHX;
- char *name = NULL;
#ifdef VMS
+ char *name = NULL;
bool exported = FALSE;
FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
if (!stdio) {
name = fgetname(stdio, buf);
if (exported) PerlIO_releaseFILE(f,stdio);
}
+ return name;
#else
+ (void)f;
+ (void)buf;
Perl_croak(aTHX_ "Don't know how to get file name");
+ return Nullch;
#endif
- return name;
}