X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=fa2cd8372c9ea9fed06cd40b8da21c70a2ec5653;hb=5c1546dc48d585e2ab2e244b01f0213280b12017;hp=d0ed97a42cfa14f6683c0928138037c282f7f501;hpb=a9a28921a06508e1ec8a1da7fdf58c72faa64c96;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index d0ed97a..fa2cd83 100644 --- a/perlio.c +++ b/perlio.c @@ -430,6 +430,11 @@ PerlIO_findFILE(PerlIO *pio) #include #endif +/* + * Why is this here - not in perlio.h? RMB + */ +void PerlIO_debug(const char *fmt, ...) + __attribute__format__(__printf__, 1, 2); void PerlIO_debug(const char *fmt, ...) @@ -1017,27 +1022,6 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) return def; } -PerlIO * -PerlIO_syslayer(pTHX_ PerlIO *f) -{ - if (PerlIOValid(f)) { - PerlIOl *l; - while (*PerlIONext(f)) { - f = PerlIONext(f); - } - l = *f; -#if 0 - Perl_warn(aTHX_ "syslayer %s",l->tab->name); -#endif - return f; - } - else { - SETERRNO(EBADF, SS_IVCHAN); - return NULL; - } -} - - IV PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { @@ -1086,7 +1070,7 @@ PerlIO_default_layers(pTHX) 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; @@ -2021,10 +2005,6 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)", l->flags, PerlIO_modestr(f, temp)); #endif - if (l->next) { - l->flags |= l->next->flags & - (PERLIO_F_TTY | PERLIO_F_NOTREG | PERLIO_F_SOCKET); - } return 0; } @@ -2053,8 +2033,11 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { 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; @@ -2355,16 +2338,9 @@ static void PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) { PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); - -#if 1 || defined(WIN32) || defined(HAS_SOCKET) && \ - (defined(PERL_SOCK_SYSREAD_IS_RECV) || \ - defined(PERL_SOCK_SYSWRITE_IS_SEND)) +#if defined(WIN32) Stat_t st; if (PerlLIO_fstat(fd, &st) == 0) { -#if defined(WIN32) - /* WIN32 needs to know about non-regular files - as only regular files can be lseek()ed - */ if (!S_ISREG(st.st_mode)) { PerlIO_debug("%d is not regular file\n",fd); PerlIOBase(f)->flags |= PERLIO_F_NOTREG; @@ -2372,32 +2348,8 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) else { PerlIO_debug("%d _is_ a regular file\n",fd); } -#endif - /* If read/write are to be mapped to recv/send we need - to know this is a socket. - Lifted from code in doio.c that handles socket detection on dup - */ -#ifndef PERL_MICRO - if (S_ISSOCK(st.st_mode)) - PerlIOBase(f)->flags |= PERLIO_F_SOCKET; - else if ( -#ifdef S_IFMT - !(st.st_mode & S_IFMT) -#else - !st.st_mode -#endif - ) { - char tmpbuf[256]; - Sock_size_t buflen = sizeof tmpbuf; - if (PerlSock_getsockname(fd, (struct sockaddr *)tmpbuf, &buflen) >= 0 - || errno != ENOTSOCK) - PerlIOBase(f)->flags |= PERLIO_F_SOCKET; /* some OS's return 0 on fstat()ed socket */ - /* but some return 0 for streams too, sigh */ - } -#endif /* !PERL_MICRO */ } -#endif /* HAS_SOCKET ... */ - +#endif s->fd = fd; s->oflags = imode; PerlIOUnix_refcnt_inc(fd); @@ -2498,16 +2450,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) return 0; } while (1) { - SSize_t len; -#ifdef PERL_SOCK_SYSREAD_IS_RECV - if (PerlIOBase(f)->flags & PERLIO_F_SOCKET) { - len = PerlSock_recv(fd, vbuf, count, 0); - } - else -#endif - { - len = PerlLIO_read(fd, vbuf, count); - } + SSize_t len = PerlLIO_read(fd, vbuf, count); if (len >= 0 || errno != EINTR) { if (len < 0) { if (errno != EAGAIN) { @@ -3037,6 +2980,8 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) } else got = PerlSIO_fread(vbuf, 1, count, s); + if (got == 0 && PerlSIO_ferror(s)) + got = -1; if (got >= 0 || errno != EINTR) break; PERL_ASYNC_CHECK(); @@ -3383,10 +3328,11 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) 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; @@ -3464,9 +3410,12 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, { 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; } @@ -3480,8 +3429,11 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, * 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) { /* @@ -4877,45 +4829,39 @@ PerlIO_tmpfile(void) dTHX; PerlIO *f = NULL; int fd = -1; - SV *sv = Nullsv; - GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV); - - if (!gv) { - ENTER; - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, - newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv); - gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV); - GvIMPORTED_CV_on(gv); - LEAVE; - } - - if (gv && GvCV(gv)) { - dSP; - ENTER; - SAVETMPS; - PUSHMARK(SP); - PUTBACK; - if (call_sv((SV*)GvCV(gv), G_SCALAR)) { - GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--)); - IO *io = gv ? GvIO(gv) : 0; - fd = io ? PerlIO_fileno(IoIFP(io)) : -1; - } - SPAGAIN; - PUTBACK; - FREETMPS; - LEAVE; - } - +#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 (sv) { - if (f) - PerlIOBase(f)->flags |= PERLIO_F_TEMP; - PerlLIO_unlink(SvPVX(sv)); - SvREFCNT_dec(sv); - } + 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; }