#define NATIVE_0xd CR_NATIVE
#define NATIVE_0xa LF_NATIVE
-#ifndef USE_SFIO
-
EXTERN_C int perlsio_binmode(FILE *fp, int iotype, int mode);
int
# endif
#endif
}
-#endif /* sfio */
#ifndef O_ACCMODE
#define O_ACCMODE 3 /* Assume traditional implementation */
mode[ix++] = '+';
}
}
+#if O_BINARY != 0
+ /* Unless O_BINARY is different from zero, bit-and:ing
+ * with it won't do much good. */
if (rawmode & O_BINARY)
mode[ix++] = 'b';
+# endif
mode[ix] = '\0';
return ptype;
}
int
PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
{
-#ifdef USE_SFIO
- PERL_UNUSED_ARG(iotype);
- PERL_UNUSED_ARG(mode);
- PERL_UNUSED_ARG(names);
- return 1;
-#else
return perlsio_binmode(fp, iotype, mode);
-#endif
}
PerlIO *
return NULL;
}
+XS(XS_PerlIO__Layer__find); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlIO__Layer__find)
{
dXSARGS;
#else /* PERLIO_IS_STDIO */
-#ifdef USE_SFIO
-
-#undef HAS_FSETPOS
-#undef HAS_FGETPOS
-
-/*
- * This section is just to make sure these functions get pulled in from
- * libsfio.a
- */
-
-#undef PerlIO_tmpfile
-PerlIO *
-PerlIO_tmpfile(void)
-{
- return sftmp(0);
-}
-
-void
-PerlIO_init(pTHX)
-{
- PERL_UNUSED_CONTEXT;
- /*
- * Force this file to be included in perl binary. Which allows this
- * file to force inclusion of other functions that may be required by
- * loadable extensions e.g. for FileHandle::tmpfile
- */
-
- /*
- * Hack sfio does its own 'autoflush' on stdout in common cases. Flush
- * results in a lot of lseek()s to regular files and lot of small
- * writes to pipes.
- */
- sfset(sfstdout, SF_SHARE, 0);
-}
-
-/* This is not the reverse of PerlIO_exportFILE(), PerlIO_releaseFILE() is. */
-PerlIO *
-PerlIO_importFILE(FILE *stdio, const char *mode)
-{
- const int fd = fileno(stdio);
- if (!mode || !*mode) {
- mode = "r+";
- }
- return PerlIO_fdopen(fd, mode);
-}
-
-FILE *
-PerlIO_findFILE(PerlIO *pio)
-{
- const int fd = PerlIO_fileno(pio);
- FILE * const f = fdopen(fd, "r+");
- PerlIO_flush(pio);
- if (!f && errno == EINVAL)
- f = fdopen(fd, "w");
- if (!f && errno == EINVAL)
- f = fdopen(fd, "r");
- return f;
-}
-
-
-#else /* USE_SFIO */
/*======================================================================================*/
/*
* Implement all the PerlIO interface ourselves.
char buffer[1024];
const STRLEN len1 = my_snprintf(buffer, sizeof(buffer), "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop));
const STRLEN len2 = my_vsnprintf(buffer + len1, sizeof(buffer) - len1, fmt, ap);
- (void)PerlLIO_write(PL_perlio_debug_fd, buffer, len1 + len2);
+ PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, buffer, len1 + len2));
#else
const char *s = CopFILE(PL_curcop);
STRLEN len;
Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap);
s = SvPV_const(sv, len);
- (void)PerlLIO_write(PL_perlio_debug_fd, s, len);
+ PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, s, len));
SvREFCNT_dec(sv);
#endif
}
perlio_mg_free
};
+XS(XS_io_MODIFY_SCALAR_ATTRIBUTES); /* prototype to pass -Wmissing-prototypes */
XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
{
dXSARGS;
return sv;
}
+XS(XS_PerlIO__Layer__NoWarnings); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlIO__Layer__NoWarnings)
{
/* This is used as a %SIG{__WARN__} handler to suppress warnings
XSRETURN(0);
}
+XS(XS_PerlIO__Layer__find); /* prototype to pass -Wmissing-prototypes */
XS(XS_PerlIO__Layer__find)
{
dVAR;
PerlIO_funcs * const self = PerlIOBase(o)->tab;
SV *arg = NULL;
char buf[8];
+ assert(self);
PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
self ? self->name : "(Null)",
(void*)f, (void*)o, (void*)param);
oflags |= O_WRONLY;
break;
}
- if (*mode == 'b') {
- oflags |= O_BINARY;
+
+ /* XXX TODO: PerlIO_open() test that exercises 'rb' and 'rt'. */
+
+ /* Unless O_BINARY is different from O_TEXT, first bit-or:ing one
+ * of them in, and then bit-and-masking the other them away, won't
+ * have much of an effect. */
+ switch (*mode) {
+ case 'b':
+#if O_TEXT != O_BINARY
+ oflags |= O_BINARY;
oflags &= ~O_TEXT;
- mode++;
- }
- else if (*mode == 't') {
+#endif
+ mode++;
+ break;
+ case 't':
+#if O_TEXT != O_BINARY
oflags |= O_TEXT;
oflags &= ~O_BINARY;
- mode++;
- }
- else {
-#ifdef PERLIO_USING_CRLF
+#endif
+ mode++;
+ break;
+ default:
+# if O_BINARY != 0
+ /* bit-or:ing with zero O_BINARY would be useless. */
/*
* If neither "t" nor "b" was specified, open the file
* in O_BINARY mode.
+ *
+ * Note that if something else than the zero byte was seen
+ * here (e.g. bogus mode "rx"), just few lines later we will
+ * set the errno and invalidate the flags.
*/
oflags |= O_BINARY;
-#endif
+# endif
+ break;
}
if (*mode || oflags == -1) {
SETERRNO(EINVAL, LIB_INVARG);
}
if (!PerlIOValid(f)) {
if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
+ PerlLIO_close(fd);
return NULL;
}
}
PerlIOUnix_setfd(aTHX_ f, fd, os->oflags);
return f;
}
+ PerlLIO_close(fd);
}
return NULL;
}
PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
/* We never call down so do any pending stuff now */
PerlIO_flush(PerlIONext(f));
+ return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
}
else {
return -1;
PerlIO *f = NULL;
if (stdio) {
PerlIOStdio *s;
+ int fd0 = fileno(stdio);
+ if (fd0 < 0) {
+ return NULL;
+ }
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
Note that the errno value set by a failing fdopen
varies between stdio implementations.
*/
- const int fd = PerlLIO_dup(fileno(stdio));
- FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+"));
+ const int fd = PerlLIO_dup(fd0);
+ FILE *f2;
+ if (fd < 0) {
+ return f;
+ }
+ f2 = PerlSIO_fdopen(fd, (mode = "r+"));
if (!f2) {
f2 = PerlSIO_fdopen(fd, (mode = "w"));
}
}
fclose(f2);
}
- if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) {
+ if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) {
s = PerlIOSelf(f, PerlIOStdio);
s->stdio = stdio;
PerlIOUnix_refcnt_inc(fileno(stdio));
if (!IS_SAFE_PATHNAME(path, len, "open"))
return NULL;
PerlIOUnix_refcnt_dec(fileno(s->stdio));
- stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
- s->stdio);
+ stdio = PerlSIO_freopen(path, PerlIOStdio_mode(mode, tmode),
+ s->stdio);
if (!s->stdio)
return NULL;
s->stdio = stdio;
}
return f;
}
+ PerlLIO_close(fd);
}
}
return NULL;
}
if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) {
/* Did not change pointer as expected */
- fgetc(s); /* get char back again */
- break;
+ if (fgetc(s) != EOF) /* get char back again */
+ break;
}
/* It worked ! */
count--;
FILE *stdio = NULL;
if (PerlIOValid(f)) {
char buf[8];
+ int fd = PerlIO_fileno(f);
+ if (fd < 0) {
+ return NULL;
+ }
PerlIO_flush(f);
if (!mode || !*mode) {
mode = PerlIO_modestr(f, buf);
va_list apc;
Perl_va_copy(ap, apc);
sv = vnewSVpvf(fmt, &apc);
+ va_end(apc);
#else
sv = vnewSVpvf(fmt, &ap);
#endif
char tempname[] = "/tmp/PerlIO_XXXXXX";
const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
SV * sv = NULL;
+ int old_umask = umask(0600);
/*
* I have no idea how portable mkstemp() is ... NI-S
*/
fd = mkstemp(SvPVX(sv));
}
if (fd < 0) {
+ SvREFCNT_dec(sv);
sv = NULL;
/* else we try /tmp */
fd = mkstemp(tempname);
}
+ if (fd < 0) {
+ /* Try cwd */
+ sv = newSVpvs(".");
+ sv_catpv(sv, tempname + 4);
+ fd = mkstemp(SvPVX(sv));
+ }
+ umask(old_umask);
if (fd >= 0) {
f = PerlIO_fdopen(fd, "w+");
if (f)
#undef HAS_FSETPOS
#undef HAS_FGETPOS
-#endif /* USE_SFIO */
#endif /* PERLIO_IS_STDIO */
/*======================================================================================*/
}
#endif
-#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
+#if !defined(HAS_VPRINTF)
int
vprintf(char *pat, char *args)
https://perl5.git.perl.org / perl5.git / blobdiff