X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FIO%2FIO.xs;h=39e4486f995b44f70a8cbfcd8c1dff496ff3cc38;hb=0bb78401313e0347fd894143d813c3036c2eccb4;hp=e614cffabb146795f7881d89c6fa4c8b5cabd591;hpb=c5be433b5c5658093bc9cae4434721a0b63e7a85;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index e614cff..39e4486 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -4,6 +4,8 @@ * modify it under the same terms as Perl itself. */ +#define PERL_EXT_IO + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #define PERLIO_NOT_STDIO 1 @@ -17,7 +19,20 @@ # include #endif +#ifndef SIOCATMARK +# ifdef I_SYS_SOCKIO +# include +# endif +#endif + #ifdef PerlIO +#if defined(MACOS_TRADITIONAL) && defined(USE_SFIO) +#define PERLIO_IS_STDIO 1 +#undef setbuf +#undef setvbuf +#define setvbuf _stdsetvbuf +#define setbuf(f,b) ( __sf_setbuf(f,b) ) +#endif typedef int SysRet; typedef PerlIO * InputStream; typedef PerlIO * OutputStream; @@ -47,102 +62,80 @@ not_here(char *s) #endif static int -io_blocking(InputStream f, int block) +io_blocking(pTHX_ InputStream f, int block) { +#if defined(HAS_FCNTL) int RETVAL; if(!f) { errno = EBADF; return -1; } -#if defined(HAS_FCNTL) RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0); if (RETVAL >= 0) { int mode = RETVAL; + int newmode = mode; #ifdef O_NONBLOCK - /* POSIX style */ -#if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK - /* Ooops has O_NDELAY too - make sure we don't - * get SysV behaviour by mistake - */ - RETVAL = RETVAL & O_NONBLOCK ? 0 : 1; - - if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) { - int ret; - mode = (mode & ~O_NDELAY) | O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) { - int ret; - mode &= ~(O_NONBLOCK | O_NDELAY); - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; + /* POSIX style */ + +# ifndef O_NDELAY +# define O_NDELAY O_NONBLOCK +# endif + /* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY + * after a successful F_SETFL of an O_NONBLOCK. */ + RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1; + + if (block == 0) { + newmode &= ~O_NDELAY; + newmode |= O_NONBLOCK; + } else if (block > 0) { + newmode &= ~(O_NDELAY|O_NONBLOCK); } #else - /* Standard POSIX */ - RETVAL = RETVAL & O_NONBLOCK ? 0 : 1; - - if ((block == 0) && !(mode & O_NONBLOCK)) { - int ret; - mode |= O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NONBLOCK)) { - int ret; - mode &= ~O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } -#endif -#else /* Not POSIX - better have O_NDELAY or we can't cope. * for BSD-ish machines this is an acceptable alternative - * for SysV we can't tell "would block" from EOF but that is + * for SysV we can't tell "would block" from EOF but that is * the way SysV is... */ RETVAL = RETVAL & O_NDELAY ? 0 : 1; - if ((block == 0) && !(mode & O_NDELAY)) { - int ret; - mode |= O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NDELAY)) { + if (block == 0) { + newmode |= O_NDELAY; + } else if (block > 0) { + newmode &= ~O_NDELAY; + } +#endif + if (newmode != mode) { int ret; - mode &= ~O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) + ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode); + if (ret < 0) RETVAL = ret; - } -#endif + } } return RETVAL; #else - return -1; + return -1; #endif } MODULE = IO PACKAGE = IO::Seekable PREFIX = f -SV * +void fgetpos(handle) InputStream handle CODE: if (handle) { - Fpos_t pos; #ifdef PerlIO - PerlIO_getpos(handle, &pos); + ST(0) = sv_2mortal(newSV(0)); + if (PerlIO_getpos(handle, ST(0)) != 0) { + ST(0) = &PL_sv_undef; + } #else - fgetpos(handle, &pos); + if (fgetpos(handle, &pos)) { + ST(0) = &PL_sv_undef; + } else { + ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); + } #endif - ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); } else { ST(0) = &PL_sv_undef; @@ -154,14 +147,21 @@ fsetpos(handle, pos) InputStream handle SV * pos CODE: - char *p; - STRLEN len; - if (handle && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) + if (handle) { #ifdef PerlIO - RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); + RETVAL = PerlIO_setpos(handle, pos); #else - RETVAL = fsetpos(handle, (Fpos_t*)p); + char *p; + STRLEN len; + if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) { + RETVAL = fsetpos(handle, (Fpos_t*)p); + } + else { + RETVAL = -1; + errno = EINVAL; + } #endif + } else { RETVAL = -1; errno = EINVAL; @@ -171,7 +171,7 @@ fsetpos(handle, pos) MODULE = IO PACKAGE = IO::File PREFIX = f -SV * +void new_tmpfile(packname = "IO::File") char * packname PREINIT: @@ -197,7 +197,7 @@ new_tmpfile(packname = "IO::File") MODULE = IO PACKAGE = IO::Poll -void +void _poll(timeout,...) int timeout; PPCODE: @@ -210,7 +210,7 @@ PPCODE: for(i=1, j=0 ; j < nfd ; j++) { fds[j].fd = SvIV(ST(i)); i++; - fds[j].events = SvIV(ST(i)); + fds[j].events = (short)SvIV(ST(i)); i++; fds[j].revents = 0; } @@ -236,7 +236,7 @@ io_blocking(handle,blk=-1) PROTOTYPE: $;$ CODE: { - int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0); + int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0); if(ret >= 0) XSRETURN_IV(ret); else @@ -245,7 +245,6 @@ CODE: MODULE = IO PACKAGE = IO::Handle PREFIX = f - int ungetc(handle, c) InputStream handle @@ -339,34 +338,47 @@ fflush(handle) RETVAL void -setbuf(handle, buf) +setbuf(handle, ...) OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; CODE: if (handle) #ifdef PERLIO_IS_STDIO + { + char *buf = items == 2 && SvPOK(ST(1)) ? + sv_grow(ST(1), BUFSIZ) : 0; setbuf(handle, buf); + } #else not_here("IO::Handle::setbuf"); #endif SysRet -setvbuf(handle, buf, type, size) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; - int type - int size +setvbuf(...) CODE: -/* Should check HAS_SETVBUF once Configure tests for that */ -#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) + if (items != 4) + Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)"); +#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF) + { + OutputStream handle = 0; + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + int type; + int size; + + if (items == 4) { + handle = IoOFP(sv_2io(ST(0))); + buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + type = (int)SvIV(ST(2)); + size = (int)SvIV(ST(3)); + } if (!handle) /* Try input stream. */ handle = IoIFP(sv_2io(ST(0))); - if (handle) + if (items == 4 && handle) RETVAL = setvbuf(handle, buf, type, size); else { RETVAL = -1; errno = EINVAL; } + } #else RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); #endif @@ -392,6 +404,39 @@ fsync(handle) RETVAL +MODULE = IO PACKAGE = IO::Socket + +SysRet +sockatmark (sock) + InputStream sock + PROTOTYPE: $ + PREINIT: + int fd; + CODE: + { + fd = PerlIO_fileno(sock); +#ifdef HAS_SOCKATMARK + RETVAL = sockatmark(fd); +#else + { + int flag = 0; +# ifdef SIOCATMARK +# if defined(NETWARE) || defined(WIN32) + if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0) +# else + if (ioctl(fd, SIOCATMARK, &flag) != 0) +# endif + XSRETURN_UNDEF; +# else + not_here("IO::Socket::atmark"); +# endif + RETVAL = flag; + } +#endif + } + OUTPUT: + RETVAL + BOOT: { HV *stash; @@ -454,11 +499,5 @@ BOOT: #ifdef SEEK_END newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END)); #endif - /* - * constant subs for IO - */ - stash = gv_stashpvn("IO", 2, TRUE); -#ifdef EINPROGRESS - newCONSTSUB(stash,"EINPROGRESS", newSViv(EINPROGRESS)); -#endif } +