void
PerlIO_debug(const char *fmt,...)
{
- dTHX;
static int dbg = 0;
va_list ap;
va_start(ap,fmt);
return Nullsv;
}
+#ifdef USE_ATTRIBUTES_FOR_PERLIO
static int
perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
perlio_mg_get,
perlio_mg_set,
NULL, /* len */
- NULL,
+ perlio_mg_clear,
perlio_mg_free
};
XSRETURN(count);
}
+#endif /* USE_ATTIBUTES_FOR_PERLIO */
+
SV *
PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
{
{
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
-#if 0
+
+#ifdef USE_ATTRIBUTES_FOR_PERLIO
newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
#endif
+
PerlIO_define_layer(aTHX_ &PerlIO_raw);
PerlIO_define_layer(aTHX_ &PerlIO_unix);
PerlIO_define_layer(aTHX_ &PerlIO_perlio);
return -1;
}
}
- else
- {
+ else
+ {
/* Is it good API design to do flush-all on NULL,
* a potentially errorneous input? Maybe some magical
* value (PerlIO* PERLIO_FLUSH_ALL = (PerlIO*)-1;)?
{
SETERRNO(EBADF,SS$_IVCHAN);
return -1;
- }
+ }
}
#undef PerlIO_isutf8
IV
PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
{
- dTHX;
Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
return (new == (Off_t) -1) ? -1 : 0;
Off_t
PerlIOUnix_tell(PerlIO *f)
{
- dTHX;
return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
}
IV
PerlIOStdio_fileno(PerlIO *f)
{
- dTHX;
return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg)
{
- dTHX;
if (*PerlIONext(f))
{
PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
SSize_t
PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
{
- dTHX;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
SSize_t got = 0;
if (count == 1)
SSize_t
PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
STDCHAR *buf = ((STDCHAR *)vbuf)+count-1;
SSize_t unread = 0;
SSize_t
PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
return PerlSIO_fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_fseek(stdio,offset,whence);
}
Off_t
PerlIOStdio_tell(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_ftell(stdio);
}
IV
PerlIOStdio_close(PerlIO *f)
{
- dTHX;
#ifdef SOCKS5_VERSION_NAME
int optval;
Sock_size_t optlen = sizeof(int);
IV
PerlIOStdio_flush(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
{
IV
PerlIOStdio_fill(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
int c;
/* fflush()ing read-only streams can cause trouble on some stdio-s */
IV
PerlIOStdio_eof(PerlIO *f)
{
- dTHX;
return PerlSIO_feof(PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_error(PerlIO *f)
{
- dTHX;
return PerlSIO_ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_clearerr(PerlIO *f)
{
- dTHX;
PerlSIO_clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_setlinebuf(PerlIO *f)
{
- dTHX;
#ifdef HAS_SETLINEBUF
PerlSIO_setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
#else
STDCHAR *
PerlIOStdio_get_base(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_base(stdio);
}
Size_t
PerlIOStdio_get_bufsiz(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_bufsiz(stdio);
}
STDCHAR *
PerlIOStdio_get_ptr(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_ptr(stdio);
}
SSize_t
PerlIOStdio_get_cnt(PerlIO *f)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_cnt(stdio);
}
void
PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
if (ptr != NULL)
{
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
int fd = PerlIO_fileno(f);
Off_t posn;
- dTHX;
if (fd >= 0 && PerlLIO_isatty(fd))
{
PerlIOBase(f)->flags |= PERLIO_F_LINEBUF|PERLIO_F_TTY;
IV
PerlIOBuf_close(PerlIO *f)
{
- dTHX;
IV code = PerlIOBase_close(f);
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) &b->oneword)
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
if (!b->buf)
{
- dTHX;
if (!b->bufsiz)
b->bufsiz = 4096;
b->buf = PerlMemShared_calloc(b->bufsiz,sizeof(STDCHAR));
else
{
int code;
- dTHX;
b->ptr++; /* say we have read it as far as flush() is concerned */
b->buf++; /* Leave space an front of buffer */
b->bufsiz--; /* Buffer is thus smaller */