static int io_blocking(pTHX_ InputStream f, int block) { #if defined(HAS_FCNTL) int RETVAL; if(!f) { errno = EBADF; return -1; } RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0); if (RETVAL >= 0) { int mode = RETVAL; int newmode = mode; #ifdef O_NONBLOCK /* 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 /* 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 * the way SysV is... */ RETVAL = RETVAL & O_NDELAY ? 0 : 1; if (block == 0) { newmode |= O_NDELAY; } else if (block > 0) { newmode &= ~O_NDELAY; } #endif if (newmode != mode) { const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode); if (ret < 0) RETVAL = ret; } } return RETVAL; #else # ifdef WIN32 char flags = (char)block; return ioctl(PerlIO_fileno(f), FIONBIO, &flags); # else return -1; # endif #endif }
SV * File_file( Handle self, Bool set, SV * file) { if ( !set) return var-> file ? newSVsv( var-> file) : nilSV; if ( var-> file) { apc_file_detach( self); sv_free( var-> file); } var-> file = nil; var-> fd = -1; if ( file && ( SvTYPE( file) != SVt_NULL)) { FileStream f = IoIFP(sv_2io(file)); if (!f) { warn("RTC0A0: Not a IO reference passed to File::set_file"); } else { var-> file = newSVsv( file); var-> fd = PerlIO_fileno( f); if ( !apc_file_attach( self)) { sv_free( var-> file); var-> file = nil; var-> fd = -1; } } } return nilSV; }
IV PerlIOMmap_map(pTHX_ PerlIO *f) { dVAR; PerlIOMmap * const m = PerlIOSelf(f, PerlIOMmap); const IV flags = PerlIOBase(f)->flags; IV code = 0; if (m->len) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); const int fd = PerlIO_fileno(f); Stat_t st; code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; if (len > 0) { Off_t posn; if (PL_mmap_page_size <= 0) Perl_croak(aTHX_ "panic: bad pagesize %" IVdf, PL_mmap_page_size); if (b->posn < 0) { /* * This is a hack - should never happen - open should * have set it ! */ b->posn = PerlIO_tell(PerlIONext(f)); } posn = (b->posn / PL_mmap_page_size) * PL_mmap_page_size; len = st.st_size - posn; m->mptr = (Mmap_t)mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn); if (m->mptr && m->mptr != (Mmap_t) - 1) { #if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL) madvise(m->mptr, len, MADV_SEQUENTIAL); #endif #if 0 && defined(HAS_MADVISE) && defined(MADV_WILLNEED) madvise(m->mptr, len, MADV_WILLNEED); #endif PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF; b->end = ((STDCHAR *) m->mptr) + len; b->buf = ((STDCHAR *) m->mptr) + (b->posn - posn); b->ptr = b->buf; m->len = len; } else { b->buf = NULL; } } else { PerlIOBase(f)->flags = flags | PERLIO_F_EOF | PERLIO_F_RDBUF; b->buf = NULL; b->ptr = b->end = b->ptr; code = -1; } } } return code; }
static IV PerlIOFlock_pushed(pTHX_ PerlIO* fp, const char* mode, SV* arg, PerlIO_funcs* tab){ int lock_mode; int fd; int ret; PERL_UNUSED_ARG(mode); PERL_UNUSED_ARG(tab); if(!PerlIOValid(fp)){ SETERRNO(EBADF, SS_IVCHAN); return -1; } lock_mode = IOLflag(fp, PERLIO_F_CANWRITE) ? LOCK_EX : LOCK_SH; if(arg && SvOK(arg)){ const char* const blocking = SvPV_nolen_const(arg); if(strEQ(blocking, "blocking")){ /* noop */ } else if(strEQ(blocking, "non-blocking") || strEQ(blocking, "LOCK_NB")){ lock_mode |= LOCK_NB; } else{ Perl_croak(aTHX_ "Unrecognized :flock handler '%s' " "(it must be 'blocking' or 'non-blocking')", blocking); } } fd = PerlIO_fileno(fp); if(fd == -1){ /* :scalar, :dir, etc. */ return 0; /* success */ } PerlIO_flush(fp); ret = PerlLIO_flock(fd, lock_mode); PerlIO_debug(STRINGIFY(FLOCK) "(%d, %s) -> %d\n", fd, ( lock_mode == (LOCK_SH) ? "LOCK_SH" : lock_mode == (LOCK_SH|LOCK_NB) ? "LOCK_SH|LOCK_NB" : lock_mode == (LOCK_EX) ? "LOCK_EX" : lock_mode == (LOCK_EX|LOCK_NB) ? "LOCK_EX|LOCK_NB" : "(UNKNOWN)" ), ret); return ret; }
IV PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab); if (*PerlIONext(f)) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); s->fd = PerlIO_fileno(PerlIONext(f)); } PerlIOBase(f)->flags |= PERLIO_F_OPEN; Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__WIN32_PERLIO), "PerlIO layer ':win32' is experimental"); return code; }