PerlIO_funcs *osLayer = &PerlIO_unix;
PL_def_layerlist = PerlIO_list_alloc(aTHX);
PerlIO_define_layer(aTHX_ & PerlIO_unix);
-#if defined(WIN32) && !defined(UNDER_CE)
+#if defined(WIN32)
PerlIO_define_layer(aTHX_ & PerlIO_win32);
#if 0
osLayer = &PerlIO_win32;
{
STDCHAR *buf = (STDCHAR *) vbuf;
if (f) {
- if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+ if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
+ PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+ SETERRNO(EBADF, SS_IVCHAN);
return 0;
+ }
while (count > 0) {
SSize_t avail = PerlIO_get_cnt(f);
SSize_t take = 0;
stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode);
if (stdio) {
PerlIOl *l = *f;
+ PerlIO *f2;
/* De-link any lower layers so new :stdio sticks */
*f = NULL;
- if ((f = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+ if ((f2 = PerlIO_push(aTHX_ f, &PerlIO_stdio, buf, Nullsv))) {
+ PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
s->stdio = stdio;
/* Link previous lower layers under new one */
*PerlIONext(f) = l;
{
if (PerlIOValid(f)) {
PerlIO *next = PerlIONext(f);
- PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
- next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
- next, narg, args);
+ PerlIO_funcs *tab =
+ PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
+ if (tab && tab->Open)
+ next =
+ (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+ next, narg, args);
if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
return NULL;
}
* mode++;
*/
}
- f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
- f, narg, args);
+ if (tab && tab->Open)
+ f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+ f, narg, args);
+ else
+ SETERRNO(EINVAL, LIB_INVARG);
if (f) {
if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
/*
PerlIO *
PerlIO_tmpfile(void)
{
- /*
- * I have no idea how portable mkstemp() is ...
- */
-#if defined(WIN32) || !defined(HAVE_MKSTEMP)
- dTHX;
- PerlIO *f = NULL;
- FILE *stdio = PerlSIO_tmpfile();
- if (stdio) {
- if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), &PerlIO_stdio, "w+", Nullsv))) {
- PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
- s->stdio = stdio;
- }
- }
- return f;
-#else
- dTHX;
- SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
- int fd = mkstemp(SvPVX(sv));
- PerlIO *f = NULL;
- if (fd >= 0) {
- f = PerlIO_fdopen(fd, "w+");
- if (f) {
- PerlIOBase(f)->flags |= PERLIO_F_TEMP;
- }
- PerlLIO_unlink(SvPVX(sv));
- SvREFCNT_dec(sv);
- }
- return f;
-#endif
+ dTHX;
+ PerlIO *f = NULL;
+ int fd = -1;
+#ifdef WIN32
+ fd = win32_tmpfd();
+ if (fd >= 0)
+ f = PerlIO_fdopen(fd, "w+b");
+#else /* WIN32 */
+# ifdef HAS_MKSTEMP
+ SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0);
+
+ /*
+ * I have no idea how portable mkstemp() is ... NI-S
+ */
+ fd = mkstemp(SvPVX(sv));
+ if (fd >= 0) {
+ f = PerlIO_fdopen(fd, "w+");
+ if (f)
+ PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+ PerlLIO_unlink(SvPVX(sv));
+ SvREFCNT_dec(sv);
+ }
+# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
+ FILE *stdio = PerlSIO_tmpfile();
+
+ if (stdio) {
+ if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)),
+ &PerlIO_stdio, "w+", Nullsv))) {
+ PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
+
+ if (s)
+ s->stdio = stdio;
+ }
+ }
+# endif /* else HAS_MKSTEMP */
+#endif /* else WIN32 */
+ return f;
}
#undef HAS_FSETPOS