#include "XSUB.h"
-#undef PerlMemShared_calloc
-#define PerlMemShared_calloc(x,y) calloc(x,y)
-#undef PerlMemShared_free
-#define PerlMemShared_free(x) free(x)
-
int
perlsio_binmode(FILE *fp, int iotype, int mode)
{
#endif
}
+#ifndef O_ACCMODE
+#define O_ACCMODE 3 /* Assume traditional implementation */
+#endif
+
+int
+PerlIO_intmode2str(int rawmode, char *mode, int *writing)
+{
+ int result = rawmode & O_ACCMODE;
+ int ix = 0;
+ int ptype;
+ switch (result) {
+ case O_RDONLY:
+ ptype = IoTYPE_RDONLY;
+ break;
+ case O_WRONLY:
+ ptype = IoTYPE_WRONLY;
+ break;
+ case O_RDWR:
+ default:
+ ptype = IoTYPE_RDWR;
+ break;
+ }
+ if (writing)
+ *writing = (result != O_RDONLY);
+
+ if (result == O_RDONLY) {
+ mode[ix++] = 'r';
+ }
+#ifdef O_APPEND
+ else if (rawmode & O_APPEND) {
+ mode[ix++] = 'a';
+ if (result != O_WRONLY)
+ mode[ix++] = '+';
+ }
+#endif
+ else {
+ if (result == O_WRONLY)
+ mode[ix++] = 'w';
+ else {
+ mode[ix++] = 'r';
+ mode[ix++] = '+';
+ }
+ }
+ if (rawmode & O_BINARY)
+ mode[ix++] = 'b';
+ mode[ix] = '\0';
+ return ptype;
+}
+
#ifndef PERLIO_LAYERS
int
PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
#endif
}
+PerlIO *
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+{
+#ifndef PERL_MICRO
+ if (f) {
+ int fd = PerlLIO_dup(PerlIO_fileno(f));
+ if (fd >= 0) {
+ char mode[8];
+ int omode = fcntl(fd, F_GETFL);
+ PerlIO_intmode2str(omode,mode,NULL);
+ /* the r+ is a hack */
+ return PerlIO_fdopen(fd, mode);
+ }
+ return NULL;
+ }
+ else {
+ SETERRNO(EBADF, SS$_IVCHAN);
+ }
+#endif
+ return NULL;
+}
+
+
/*
* De-mux PerlIO_openn() into fdopen, freopen and fopen type entries
*/
#ifdef PERLIO_IS_STDIO
void
-PerlIO_init(void)
+PerlIO_init(pTHX)
{
/*
* Does nothing (yet) except force this file to be included in perl
}
void
-PerlIO_init(void)
+PerlIO_init(pTHX)
{
/*
* Force this file to be included in perl binary. Which allows this
/*
* Table of pointers to the PerlIO structs (malloc'ed)
*/
-PerlIO *_perlio = NULL;
#define PERLIO_TABLE_SIZE 64
-
-
PerlIO *
PerlIO_allocate(pTHX)
{
*/
PerlIO **last;
PerlIO *f;
- last = &_perlio;
+ last = &PL_perlio;
while ((f = *last)) {
int i;
last = (PerlIO **) (f);
}
}
}
- f = PerlMemShared_calloc(PERLIO_TABLE_SIZE, sizeof(PerlIO));
+ Newz('I',f,PERLIO_TABLE_SIZE,PerlIO);
if (!f) {
return NULL;
}
return f + 1;
}
+#undef PerlIO_fdupopen
+PerlIO *
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+{
+ if (f && *f) {
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO *new;
+ PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
+ new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
+ return new;
+ }
+ else {
+ SETERRNO(EBADF, SS$_IVCHAN);
+ return NULL;
+ }
+}
+
void
PerlIO_cleantable(pTHX_ PerlIO **tablep)
{
PerlIO_close(f);
}
}
- PerlMemShared_free(table);
+ Safefree(table);
*tablep = NULL;
}
}
-PerlIO_list_t *PerlIO_known_layers;
-PerlIO_list_t *PerlIO_def_layerlist;
PerlIO_list_t *
-PerlIO_list_alloc(void)
+PerlIO_list_alloc(pTHX)
{
PerlIO_list_t *list;
Newz('L', list, 1, PerlIO_list_t);
}
void
-PerlIO_list_free(PerlIO_list_t *list)
+PerlIO_list_free(pTHX_ PerlIO_list_t *list)
{
if (list) {
if (--list->refcnt == 0) {
if (list->array) {
- dTHX;
IV i;
for (i = 0; i < list->cur; i++) {
if (list->array[i].arg)
}
void
-PerlIO_list_push(PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
+PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
{
- dTHX;
PerlIO_pair_t *p;
if (list->cur >= list->len) {
list->len += 8;
}
}
-
-void
-PerlIO_cleanup_layers(pTHX_ void *data)
+PerlIO_list_t *
+PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
{
-#if 0
- PerlIO_known_layers = Nullhv;
- PerlIO_def_layerlist = Nullav;
-#endif
+ PerlIO_list_t *list = (PerlIO_list_t *) NULL;
+ if (proto) {
+ int i;
+ list = PerlIO_list_alloc(aTHX);
+ for (i=0; i < proto->cur; i++) {
+ SV *arg = Nullsv;
+ if (proto->array[i].arg)
+ arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
+ PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
+ }
+ }
+ return list;
}
void
-PerlIO_cleanup()
+PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
{
- dTHX;
- PerlIO_cleantable(aTHX_ & _perlio);
+#ifdef USE_ITHREADS
+ PerlIO **table = &proto->Iperlio;
+ PerlIO *f;
+ PL_perlio = NULL;
+ PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
+ PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
+ PerlIO_allocate(aTHX); /* root slot is never used */
+ PerlIO_debug("Clone %p from %p\n",aTHX,proto);
+ while ((f = *table)) {
+ int i;
+ table = (PerlIO **) (f++);
+ for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
+ if (*f) {
+ (void) fp_dup(f, 0, param);
+ }
+ f++;
+ }
+ }
+#endif
}
void
PerlIO_destruct(pTHX)
{
- PerlIO **table = &_perlio;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
+#ifdef USE_ITHREADS
+ PerlIO_debug("Destruct %p\n",aTHX);
+#endif
while ((f = *table)) {
int i;
table = (PerlIO **) (f++);
f++;
}
}
+ PerlIO_list_free(aTHX_ PL_known_layers);
+ PL_known_layers = NULL;
+ PerlIO_list_free(aTHX_ PL_def_layerlist);
+ PL_def_layerlist = NULL;
}
void
return;
}
*f = l->next;;
- PerlMemShared_free(l);
+ Safefree(l);
}
}
IV i;
if ((SSize_t) len <= 0)
len = strlen(name);
- for (i = 0; i < PerlIO_known_layers->cur; i++) {
- PerlIO_funcs *f = PerlIO_known_layers->array[i].funcs;
+ for (i = 0; i < PL_known_layers->cur; i++) {
+ PerlIO_funcs *f = PL_known_layers->array[i].funcs;
if (memEQ(f->name, name, len)) {
PerlIO_debug("%.*s => %p\n", (int) len, name, f);
return f;
}
}
- if (load && PL_subname && PerlIO_def_layerlist
- && PerlIO_def_layerlist->cur >= 2) {
+ if (load && PL_subname && PL_def_layerlist
+ && PL_def_layerlist->cur >= 2) {
SV *pkgsv = newSVpvn("PerlIO", 6);
SV *layer = newSVpvn(name, len);
ENTER;
void
PerlIO_define_layer(pTHX_ PerlIO_funcs *tab)
{
- if (!PerlIO_known_layers)
- PerlIO_known_layers = PerlIO_list_alloc();
- PerlIO_list_push(PerlIO_known_layers, tab, Nullsv);
+ if (!PL_known_layers)
+ PL_known_layers = PerlIO_list_alloc(aTHX);
+ PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv);
PerlIO_debug("define %s %p\n", tab->name, tab);
}
PerlIO_funcs *layer =
PerlIO_find_layer(aTHX_ s, llen, 1);
if (layer) {
- PerlIO_list_push(av, layer,
+ PerlIO_list_push(aTHX_ av, layer,
(as) ? newSVpvn(as,
alen) :
&PL_sv_undef);
}
}
PerlIO_debug("Pushing %s\n", tab->name);
- PerlIO_list_push(av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
+ PerlIO_list_push(aTHX_ av, PerlIO_find_layer(aTHX_ tab->name, 0, 0),
&PL_sv_undef);
}
PerlIO_list_t *
PerlIO_default_layers(pTHX)
{
- if (!PerlIO_def_layerlist) {
+ if (!PL_def_layerlist) {
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PerlIO_funcs *osLayer = &PerlIO_unix;
- PerlIO_def_layerlist = PerlIO_list_alloc();
+ PL_def_layerlist = PerlIO_list_alloc(aTHX);
PerlIO_define_layer(aTHX_ & PerlIO_unix);
#if defined(WIN32) && !defined(UNDER_CE)
PerlIO_define_layer(aTHX_ & PerlIO_win32);
#endif
PerlIO_define_layer(aTHX_ & PerlIO_utf8);
PerlIO_define_layer(aTHX_ & PerlIO_byte);
- PerlIO_list_push(PerlIO_def_layerlist,
+ PerlIO_list_push(aTHX_ PL_def_layerlist,
PerlIO_find_layer(aTHX_ osLayer->name, 0, 0),
&PL_sv_undef);
if (s) {
- PerlIO_parse_layers(aTHX_ PerlIO_def_layerlist, s);
+ PerlIO_parse_layers(aTHX_ PL_def_layerlist, s);
}
else {
- PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+ PerlIO_default_buffer(aTHX_ PL_def_layerlist);
}
}
- if (PerlIO_def_layerlist->cur < 2) {
- PerlIO_default_buffer(aTHX_ PerlIO_def_layerlist);
+ if (PL_def_layerlist->cur < 2) {
+ PerlIO_default_buffer(aTHX_ PL_def_layerlist);
}
- return PerlIO_def_layerlist;
+ return PL_def_layerlist;
}
void
void
PerlIO_stdstreams(pTHX)
{
- if (!_perlio) {
+ if (!PL_perlio) {
PerlIO_allocate(aTHX);
PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT);
PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
{
PerlIOl *l = NULL;
- l = PerlMemShared_calloc(tab->size, sizeof(char));
+ Newc('L',l,tab->size,char,PerlIOl);
if (l) {
Zero(l, tab->size, char);
l->next = *f;
{
int code = 0;
if (names) {
- PerlIO_list_t *layers = PerlIO_list_alloc();
+ PerlIO_list_t *layers = PerlIO_list_alloc(aTHX);
code = PerlIO_parse_layers(aTHX_ layers, names);
if (code == 0) {
code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0);
}
- PerlIO_list_free(layers);
+ PerlIO_list_free(aTHX_ layers);
}
return code;
}
}
}
-#undef PerlIO_fdupopen
-PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
-{
- if (f && *f) {
- PerlIO_funcs *tab = PerlIOBase(f)->tab;
- PerlIO *new;
- PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
- new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
- return new;
- }
- else {
- SETERRNO(EBADF, SS$_IVCHAN);
- return NULL;
- }
-}
-
#undef PerlIO_close
int
PerlIO_close(PerlIO *f)
{
PerlIO_list_t *def = PerlIO_default_layers(aTHX);
int incdef = 1;
- if (!_perlio)
+ if (!PL_perlio)
PerlIO_stdstreams(aTHX);
if (narg) {
SV *arg = *args;
if (SvROK(arg) && !sv_isobject(arg)) {
PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
if (handler) {
- def = PerlIO_list_alloc();
- PerlIO_list_push(def, handler, &PL_sv_undef);
+ def = PerlIO_list_alloc(aTHX);
+ PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef);
incdef = 0;
}
/*
PerlIO_list_t *av;
if (incdef) {
IV i = def->cur;
- av = PerlIO_list_alloc();
+ av = PerlIO_list_alloc(aTHX);
for (i = 0; i < def->cur; i++) {
- PerlIO_list_push(av, def->array[i].funcs,
+ PerlIO_list_push(aTHX_ av, def->array[i].funcs,
def->array[i].arg);
}
}
* yet
*/
PerlIOl *l = *f;
- layera = PerlIO_list_alloc();
+ layera = PerlIO_list_alloc(aTHX);
while (l) {
SV *arg =
(l->tab->Getarg) ? (*l->tab->
Getarg) (&l) : &PL_sv_undef;
- PerlIO_list_push(layera, l->tab, arg);
+ PerlIO_list_push(aTHX_ layera, l->tab, arg);
l = *PerlIONext(&l);
}
}
}
}
}
- PerlIO_list_free(layera);
+ PerlIO_list_free(aTHX_ layera);
}
return f;
}
* things on fflush(NULL), but should we be bound by their design
* decisions? --jhi
*/
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
int code = 0;
while ((f = *table)) {
int i;
void
PerlIOBase_flush_linebuf()
{
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
int i;
}
}
+SV *
+PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
+{
+ if (!arg)
+ return Nullsv;
+#ifdef sv_dup
+ if (param) {
+ return sv_dup(arg, param);
+ }
+ else {
+ return newSVsv(arg);
+ }
+#else
+ return newSVsv(arg);
+#endif
+}
+
+PerlIO *
+PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+ PerlIO *nexto = PerlIONext(o);
+ if (*nexto) {
+ PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
+ f = (*tab->Dup)(aTHX_ f, nexto, param);
+ }
+ if (f) {
+ PerlIO_funcs *self = PerlIOBase(o)->tab;
+ SV *arg = Nullsv;
+ char buf[8];
+ PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",self->name,f,o,param);
+ if (self->Getarg) {
+ arg = (*self->Getarg)(o);
+ if (arg) {
+ arg = PerlIO_sv_dup(aTHX_ arg, param);
+ }
+ }
+ f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+ if (!f && arg) {
+ SvREFCNT_dec(arg);
+ }
+ }
+ return f;
+}
+
+#define PERLIO_MAX_REFCOUNTABLE_FD 2048
+#ifdef USE_THREADS
+perl_mutex PerlIO_mutex;
+#endif
+int PerlIO_fd_refcnt[PERLIO_MAX_REFCOUNTABLE_FD];
+
+void
+PerlIO_init(pTHX)
+{
+ /* Place holder for stdstreams call ??? */
+#ifdef USE_THREADS
+ MUTEX_INIT(&PerlIO_mutex);
+#endif
+}
+
+void
+PerlIOUnix_refcnt_inc(int fd)
+{
+ if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PerlIO_mutex);
+#endif
+ PerlIO_fd_refcnt[fd]++;
+ PerlIO_debug("fd %d refcnt=%d\n",fd,PerlIO_fd_refcnt[fd]);
+#ifdef USE_THREADS
+ MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+ }
+}
+
+int
+PerlIOUnix_refcnt_dec(int fd)
+{
+ int cnt = 0;
+ if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
+#ifdef USE_THREADS
+ MUTEX_LOCK(&PerlIO_mutex);
+#endif
+ cnt = --PerlIO_fd_refcnt[fd];
+ PerlIO_debug("fd %d refcnt=%d\n",fd,cnt);
+#ifdef USE_THREADS
+ MUTEX_UNLOCK(&PerlIO_mutex);
+#endif
+ }
+ return cnt;
+}
+
+void
+PerlIO_cleanup(pTHX)
+{
+ int i;
+#ifdef USE_ITHREADS
+ PerlIO_debug("Cleanup %p\n",aTHX);
+#endif
+ /* Raise STDIN..STDERR refcount so we don't close them */
+ for (i=0; i < 3; i++)
+ PerlIOUnix_refcnt_inc(i);
+ PerlIO_cleantable(aTHX_ &PL_perlio);
+ /* Restore STDIN..STDERR refcount */
+ for (i=0; i < 3; i++)
+ PerlIOUnix_refcnt_dec(i);
+}
+
+
+
/*--------------------------------------------------------------------------------------*/
/*
* Bottom-most level for UNIX-like case
PerlIOUnix_pushed(PerlIO *f, const char *mode, SV *arg)
{
IV code = PerlIOBase_pushed(f, mode, arg);
+ PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
if (*PerlIONext(f)) {
- PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
s->fd = PerlIO_fileno(PerlIONext(f));
/*
* XXX could (or should) we retrieve the oflags from the open file
s->fd = fd;
s->oflags = imode;
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+ PerlIOUnix_refcnt_inc(fd);
return f;
}
else {
}
}
-SV *
-PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
-{
- if (!arg)
- return Nullsv;
-#ifdef sv_dup
- if (param) {
- return sv_dup(arg, param);
- }
- else {
- return newSVsv(arg);
- }
-#else
- return newSVsv(arg);
-#endif
-}
-
-PerlIO *
-PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
-{
- PerlIO *nexto = PerlIONext(o);
- if (*nexto) {
- PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
- f = (*tab->Dup)(aTHX_ f, nexto, param);
- }
- if (f) {
- PerlIO_funcs *self = PerlIOBase(o)->tab;
- SV *arg = Nullsv;
- char buf[8];
- PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",self->name,f,o,param);
- if (self->Getarg) {
- arg = (*self->Getarg)(o);
- if (arg) {
- arg = PerlIO_sv_dup(aTHX_ arg, param);
- }
- }
- f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
- if (!f && arg) {
- SvREFCNT_dec(arg);
- }
- }
- return f;
-}
-
PerlIO *
PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
{
PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
- int fd = PerlLIO_dup(os->fd);
- if (fd >= 0) {
+ int fd = os->fd;
+ if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) {
f = PerlIOBase_dup(aTHX_ f, o, param);
if (f) {
/* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
s->fd = fd;
+ PerlIOUnix_refcnt_inc(fd);
return f;
}
- else {
- PerlLIO_close(fd);
- }
}
return NULL;
}
dTHX;
int fd = PerlIOSelf(f, PerlIOUnix)->fd;
int code = 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_OPEN) {
+ if (PerlIOUnix_refcnt_dec(fd) > 0) {
+ PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
+ return 0;
+ }
+ }
+ else {
+ SETERRNO(EBADF,SS$_IVCHAN);
+ return -1;
+ }
while (PerlLIO_close(fd) != 0) {
if (errno != EINTR) {
code = -1;
if (f) {
char *path = SvPV_nolen(*args);
PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
- FILE *stdio =
- PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
+ FILE *stdio;
+ PerlIOUnix_refcnt_dec(fileno(s->stdio));
+ stdio = PerlSIO_freopen(path, (mode = PerlIOStdio_mode(mode, tmode)),
s->stdio);
if (!s->stdio)
return NULL;
s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(s->stdio));
return f;
}
else {
PerlIOArg),
PerlIOStdio);
s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(s->stdio));
}
return f;
}
(aTHX_(f = PerlIO_allocate(aTHX)), self,
mode, PerlIOArg), PerlIOStdio);
s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(s->stdio));
return f;
}
}
return NULL;
}
+PerlIO *
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+ /* This assumes no layers underneath - which is what
+ happens, but is not how I remember it. NI-S 2001/10/16
+ */
+ if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
+ FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio;
+ PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(stdio));
+ }
+ return f;
+}
+
+IV
+PerlIOStdio_close(PerlIO *f)
+{
+ dSYS;
+#ifdef SOCKS5_VERSION_NAME
+ int optval;
+ Sock_size_t optlen = sizeof(int);
+#endif
+ FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
+ if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
+ /* Do not close it but do flush any buffers */
+ PerlIO_flush(f);
+ return 0;
+ }
+ return (
+#ifdef SOCKS5_VERSION_NAME
+ (getsockopt
+ (PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
+ &optlen) <
+ 0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
+#else
+ PerlSIO_fclose(stdio)
+#endif
+ );
+
+}
+
+
+
SSize_t
PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
{
}
IV
-PerlIOStdio_close(PerlIO *f)
-{
- dSYS;
-#ifdef SOCKS5_VERSION_NAME
- int optval;
- Sock_size_t optlen = sizeof(int);
-#endif
- FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
- return (
-#ifdef SOCKS5_VERSION_NAME
- (getsockopt
- (PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval,
- &optlen) <
- 0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f))
-#else
- PerlSIO_fclose(stdio)
-#endif
- );
-
-}
-
-IV
PerlIOStdio_flush(PerlIO *f)
{
dSYS;
#endif
-PerlIO *
-PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
-{
- /* This assumes no layers underneath - which is what
- happens, but is not how I remember it. NI-S 2001/10/16
- */
- int fd = PerlLIO_dup(PerlIO_fileno(o));
- if (fd >= 0) {
- char buf[8];
- FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
- if (stdio) {
- if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
- PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
- }
- else {
- PerlSIO_fclose(stdio);
- }
- }
- else {
- PerlLIO_close(fd);
- f = NULL;
- }
- }
- return f;
-}
-
PerlIO_funcs PerlIO_stdio = {
"stdio",
sizeof(PerlIOStdio),
if (f) {
PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
fd = PerlIO_fileno(f);
-#if O_BINARY != O_TEXT
+#if (O_BINARY != O_TEXT) && !defined(__BEOS__)
/*
* do something about failing setmode()? --jhi
*/
IV code = PerlIOBase_close(f);
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
- PerlMemShared_free(b->buf);
+ Safefree(b->buf);
}
b->buf = NULL;
b->ptr = b->end = b->buf;
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
- b->buf = PerlMemShared_calloc(b->bufsiz, sizeof(STDCHAR));
+ b->buf =
+ Newz('B',b->buf,b->bufsiz, STDCHAR);
if (!b->buf) {
b->buf = (STDCHAR *) & b->oneword;
b->bufsiz = sizeof(b->oneword);
dTHX;
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
- PerlMemShared_free(b->buf);
+ Safefree(b->buf);
b->buf = NULL;
}
PerlIO_pop(aTHX_ f);
if (flags & PERLIO_F_CANREAD) {
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
int fd = PerlIO_fileno(f);
- struct stat st;
- code = fstat(fd, &st);
+ 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) {
#endif /* HAS_MMAP */
-void
-PerlIO_init(void)
-{
- dTHX;
-#ifndef WIN32
- call_atexit(PerlIO_cleanup_layers, NULL);
-#endif
- if (!_perlio) {
-#ifndef WIN32
- atexit(&PerlIO_cleanup);
-#endif
- }
-}
-
#undef PerlIO_stdin
PerlIO *
PerlIO_stdin(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[1];
+ return &PL_perlio[1];
}
#undef PerlIO_stdout
PerlIO *
PerlIO_stdout(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[2];
+ return &PL_perlio[2];
}
#undef PerlIO_stderr
PerlIO *
PerlIO_stderr(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[3];
+ return &PL_perlio[3];
}
/*--------------------------------------------------------------------------------------*/
return result;
}
#endif
+
+
+
+
+
https://perl5.git.perl.org / perl5.git / blobdiff