supplied_fp, &svs, 1);
}
+static char *S_layers(pTHX_ char *mode);
+
+static char *
+S_layers(pTHX_ char *mode)
+{
+ char *type = NULL;
+ /* Need to supply default layer info from open.pm */
+ SV *layers = PL_curcop->cop_io;
+ if (layers) {
+ STRLEN len;
+ type = SvPV(layers,len);
+ if (type && mode[0] != 'r') {
+ /* Skip to write part */
+ char *s = strchr(type,0);
+ if (s && (s-type) < len) {
+ type = s+1;
+ }
+ }
+ }
+ return type;
+}
+
bool
Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
register IO *io = GvIOn(gv);
PerlIO *saveifp = Nullfp;
PerlIO *saveofp = Nullfp;
+ int savefd = -1;
char savetype = IoTYPE_CLOSED;
int writing = 0;
PerlIO *fp;
bool was_fdopen = FALSE;
bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
char *type = NULL;
- char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
- SV *svs = (num_svs) ? *svp : Nullsv;
+ char mode[8]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+ SV *namesv;
Zero(mode,sizeof(mode),char);
PL_forkprocess = 1; /* assume true if no fork */
/* If currently open - close before we re-open */
if (IoIFP(io)) {
fd = PerlIO_fileno(IoIFP(io));
- if (IoTYPE(io) == IoTYPE_STD)
+ if (IoTYPE(io) == IoTYPE_STD) {
+ /* This is a clone of one of STD* handles */
result = 0;
- else if (fd <= PL_maxsysfd) {
- saveifp = IoIFP(io);
- saveofp = IoOFP(io);
+ }
+ else if (fd >= 0 && fd <= PL_maxsysfd) {
+ /* This is one of the original STD* handles */
+ saveifp = IoIFP(io);
+ saveofp = IoOFP(io);
savetype = IoTYPE(io);
- result = 0;
+ savefd = fd;
+ result = 0;
}
else if (IoTYPE(io) == IoTYPE_PIPE)
result = PerlProc_pclose(IoIFP(io));
}
else
result = PerlIO_close(IoIFP(io));
- if (result == EOF && fd > PL_maxsysfd)
+ if (result == EOF && fd > PL_maxsysfd) {
+ /* Why is this not Perl_warn*() call ? */
PerlIO_printf(Perl_error_log,
"Warning: unable to close filehandle %s properly.\n",
GvENAME(gv));
+ }
IoOFP(io) = IoIFP(io) = Nullfp;
}
if (as_raw) {
/* sysopen style args, i.e. integer mode and permissions */
+ STRLEN ix = 0;
if (num_svs != 0) {
Perl_croak(aTHX_ "panic:sysopen with multiple args");
}
+ mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
rawmode |= O_LARGEFILE;
IoTYPE(io) = IoTYPE_RDWR;
break;
}
-
writing = (result > 0);
- fd = PerlLIO_open3(name, rawmode, rawperm);
- if (fd == -1)
- fp = NULL;
- else {
- STRLEN ix = 0;
- if (result == O_RDONLY) {
- mode[ix++] = 'r';
- }
+ if (result == O_RDONLY) {
+ mode[ix++] = 'r';
+ }
#ifdef O_APPEND
- else if (rawmode & O_APPEND) {
- mode[ix++] = 'a';
- if (result != O_WRONLY)
- mode[ix++] = '+';
- }
+ else if (rawmode & O_APPEND) {
+ mode[ix++] = 'a';
+ if (result != O_WRONLY)
+ mode[ix++] = '+';
+ }
#endif
+ else {
+ if (result == O_WRONLY)
+ mode[ix++] = 'w';
else {
- if (result == O_WRONLY)
- mode[ix++] = 'w';
- else {
- mode[ix++] = 'r';
- mode[ix++] = '+';
- }
+ mode[ix++] = 'r';
+ mode[ix++] = '+';
}
- if (rawmode & O_BINARY)
- mode[ix++] = 'b';
- mode[ix] = '\0';
- fp = PerlIO_fdopen(fd, mode);
- if (!fp)
- PerlLIO_close(fd);
}
+ if (rawmode & O_BINARY)
+ mode[ix++] = 'b';
+ mode[ix] = '\0';
+
+ namesv = sv_2mortal(newSVpvn(name,strlen(name)));
+ num_svs = 1;
+ svp = &namesv;
+ fp = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode, -1, rawmode, rawperm, saveifp, num_svs, svp);
}
else {
/* Regular (non-sys) open */
if (num_svs) {
/* New style explict name, type is just mode and discipline/layer info */
STRLEN l;
- name = SvPV(svs, l) ;
+ name = SvPV(*svp, l) ;
len = (I32)l;
name = savepvn(name, len);
SAVEFREEPV(name);
mode[0] = IoTYPE(io) = IoTYPE_APPEND;
type++;
}
- else
+ else {
mode[0] = 'w';
+ }
writing = 1;
if (out_raw)
dodup = 0;
type++;
}
- if (!num_svs && !*type && supplied_fp)
+ if (!num_svs && !*type && supplied_fp) {
/* "<+&" etc. is used by typemaps */
fp = supplied_fp;
+ }
else {
if (num_svs > 1) {
Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
}
- if (num_svs && SvIOK(*svp))
+ if (num_svs && SvIOK(*svp)) {
fd = SvUV(*svp);
+ }
else if (isDIGIT(*type)) {
/*SUPPRESS 530*/
for (; isSPACE(*type); type++) ;
fd = PerlLIO_dup(fd);
else
was_fdopen = TRUE;
- if (!(fp = PerlIO_fdopen(fd,mode))) {
+ if (!num_svs)
+ type = S_layers(aTHX_ mode);
+ if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
if (dodup)
PerlLIO_close(fd);
}
}
- }
+ } /* & */
else {
if (num_svs > 1) {
Perl_croak(aTHX_ "More than one argument to '>' open");
IoTYPE(io) = IoTYPE_STD;
}
else {
- fp = PerlIO_open((num_svs ? name : type), mode);
+ if (!num_svs) {
+ namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+ num_svs = 1;
+ svp = &namesv;
+ type = S_layers(aTHX_ mode);
+ }
+ fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
}
- }
+ } /* !& */
}
else if (*type == IoTYPE_RDONLY) {
if (num_svs > 1) {
fp = PerlIO_stdin();
IoTYPE(io) = IoTYPE_STD;
}
- else
- fp = PerlIO_open((num_svs ? name : type), mode);
+ else {
+ if (!num_svs) {
+ namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+ num_svs = 1;
+ svp = &namesv;
+ type = S_layers(aTHX_ mode);
+ }
+ fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
+ }
}
else if ((num_svs && type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) ||
(!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) {
IoTYPE(io) = IoTYPE_STD;
}
else {
- fp = PerlIO_open(name,mode);
+ if (!num_svs) {
+ namesv = sv_2mortal(newSVpvn(type,strlen(type)));
+ num_svs = 1;
+ svp = &namesv;
+ type = S_layers(aTHX_ mode);
+ }
+ fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,saveifp,num_svs,svp);
}
}
}
Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
(fp == PerlIO_stdout()) ? "out" : "err");
}
- else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdout()) {
+ else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
}
}
/* If fd is less that PL_maxsysfd i.e. STDIN..STDERR
then dup the new fileno down
*/
- fd = PerlIO_fileno(saveifp);
if (saveofp) {
PerlIO_flush(saveofp); /* emulate PerlIO_close() */
if (saveofp != saveifp) { /* was a socket? */
PerlIO_close(saveofp);
- /* This looks very suspect - NI-S 24 Nov 2000 */
- if (fd > 2)
- Safefree(saveofp); /* ??? */
}
}
- if (fd != PerlIO_fileno(fp)) {
+ if (savefd != PerlIO_fileno(fp)) {
Pid_t pid;
SV *sv;
SvIVX(sv) = pid;
if (!was_fdopen)
PerlIO_close(fp);
-
}
fp = saveifp;
PerlIO_clearerr(fp);
}
#endif
IoIFP(io) = fp;
- if (!num_svs) {
- /* Need to supply default type info from open.pm */
- SV *layers = PL_curcop->cop_io;
- type = NULL;
- if (layers) {
- STRLEN len;
- type = SvPV(layers,len);
- if (type && mode[0] != 'r') {
- /* Skip to write part */
- char *s = strchr(type,0);
- if (s && (s-type) < len) {
- type = s+1;
- }
- }
- }
- }
- if (type) {
- while (isSPACE(*type)) type++;
- if (*type) {
- errno = 0;
- if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
- goto say_false;
- }
- }
- }
IoFLAGS(io) &= ~IOf_NOLINE;
if (writing) {
if (IoTYPE(io) == IoTYPE_SOCKET
- || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
- {
+ || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) {
mode[0] = 'w';
- if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),mode))) {
+ if (!(IoOFP(io) = PerlIO_openn(aTHX_ S_layers(aTHX_ mode),mode,PerlIO_fileno(fp),0,0,saveofp,num_svs,svp))) {
PerlIO_close(fp);
IoIFP(io) = Nullfp;
goto say_false;
}
- if (type && *type) {
- if (PerlIO_apply_layers(aTHX_ IoOFP(io),mode,type) != 0) {
- PerlIO_close(IoOFP(io));
- PerlIO_close(fp);
- IoIFP(io) = Nullfp;
- IoOFP(io) = Nullfp;
- goto say_false;
- }
- }
}
else
IoOFP(io) = fp;
return perlsio_binmode(fp,iotype,mode);
}
+/* De-mux PerlIO_openn() into fdopen, freopen and fopen type entries */
+
+PerlIO *
+PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
+{
+ if (narg == 1)
+ {
+ char *name = SvPV_nolen(*args);
+ if (*mode == '#')
+ {
+ fd = PerlLIO_open3(name,imode,perm);
+ if (fd >= 0)
+ return PerlIO_fdopen(fd,mode+1);
+ }
+ else if (old)
+ {
+ return PerlIO_reopen(name,mode,old);
+ }
+ else
+ {
+ return PerlIO_open(name,mode);
+ }
+ }
+ else
+ {
+ return PerlIO_fdopen(fd,mode);
+ }
+ return NULL;
+}
+
#endif
return (*PerlIOBase(f)->tab->Fileno)(f);
}
+PerlIO_funcs *
+PerlIO_top_layer(pTHX_ const char *layers)
+{
+ /* FIXME !!! */
+ return PerlIO_default_top();
+}
+
+PerlIO *
+PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
+{
+ PerlIO_funcs *tab = (f && *f) ? PerlIOBase(f)->tab : PerlIO_top_layer(aTHX_ layers);
+ if (!_perlio)
+ PerlIO_stdstreams();
+ return (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,f,narg,args);
+}
#undef PerlIO_fdopen
PerlIO *
PerlIO_fdopen(int fd, const char *mode)
{
- PerlIO_funcs *tab = PerlIO_default_top();
- if (!_perlio)
- PerlIO_stdstreams();
- return (*tab->Fdopen)(tab,fd,mode);
+ dTHX;
+ return PerlIO_openn(aTHX_ Nullch,mode,fd,0,0,NULL,0,NULL);
}
#undef PerlIO_open
PerlIO *
PerlIO_open(const char *path, const char *mode)
{
- PerlIO_funcs *tab = PerlIO_default_top();
- if (!_perlio)
- PerlIO_stdstreams();
- return (*tab->Open)(tab,path,mode);
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path,strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch,mode,-1,0,0,NULL,1,&name);
}
#undef PerlIO_reopen
PerlIO *
PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
{
- if (f)
- {
- PerlIO_flush(f);
- if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
- {
- if ((*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) == 0)
- return f;
- }
- return NULL;
- }
- else
- return PerlIO_open(path,mode);
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path,strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch,mode,-1,0,0,f,1,&name);
}
#undef PerlIO_read
}
PerlIO *
-PerlIOUtf8_fdopen(PerlIO_funcs *self, int fd,const char *mode)
+PerlIOUtf8_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
{
PerlIO_funcs *tab = PerlIO_default_layer(-2);
- PerlIO *f = (*tab->Fdopen)(tab,fd,mode);
+ PerlIO *f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args);
if (f)
{
PerlIOl *l = PerlIOBase(f);
return f;
}
-PerlIO *
-PerlIOUtf8_open(PerlIO_funcs *self, const char *path,const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_layer(-2);
- PerlIO *f = (*tab->Open)(tab,path,mode);
- if (f)
- {
- PerlIOl *l = PerlIOBase(f);
- if (tab->kind & PERLIO_K_UTF8)
- l->flags |= PERLIO_F_UTF8;
- else
- l->flags &= ~PERLIO_F_UTF8;
- }
- return f;
-}
-
PerlIO_funcs PerlIO_utf8 = {
"utf8",
sizeof(PerlIOl),
PERLIO_K_DUMMY|PERLIO_F_UTF8,
NULL,
- PerlIOUtf8_fdopen,
PerlIOUtf8_open,
- NULL,
PerlIOUtf8_pushed,
NULL,
NULL,
sizeof(PerlIOl),
PERLIO_K_DUMMY,
NULL,
- PerlIOUtf8_fdopen,
PerlIOUtf8_open,
- NULL,
PerlIOUtf8_pushed,
NULL,
NULL,
};
PerlIO *
-PerlIORaw_fdopen(PerlIO_funcs *self, int fd,const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_btm();
- return (*tab->Fdopen)(tab,fd,mode);
-}
-
-PerlIO *
-PerlIORaw_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIORaw_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args)
{
PerlIO_funcs *tab = PerlIO_default_btm();
- return (*tab->Open)(tab,path,mode);
+ return (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args);
}
PerlIO_funcs PerlIO_raw = {
sizeof(PerlIOl),
PERLIO_K_DUMMY,
NULL,
- PerlIORaw_fdopen,
PerlIORaw_open,
- NULL,
PerlIORaw_pushed,
PerlIOBase_popped,
NULL,
}
PerlIO *
-PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIOUnix_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
{
- dTHX;
- PerlIO *f = NULL;
- int oflags = PerlIOUnix_oflags(mode);
- if (oflags != -1)
+ if (f)
{
- int fd = PerlLIO_open3(path,oflags,0666);
- if (fd >= 0)
+ if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
+ (*PerlIOBase(f)->tab->Close)(f);
+ }
+ if (narg > 0)
+ {
+ char *path = SvPV_nolen(*args);
+ if (*mode == '#')
+ mode++;
+ else
{
- PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
- s->fd = fd;
- s->oflags = oflags;
- PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+ imode = PerlIOUnix_oflags(mode);
+ perm = 0666;
+ }
+ if (imode != -1)
+ {
+ fd = PerlLIO_open3(path,imode,perm);
}
}
- return f;
-}
-
-int
-PerlIOUnix_reopen(const char *path, const char *mode, PerlIO *f)
-{
- PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix);
- int oflags = PerlIOUnix_oflags(mode);
- if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
- (*PerlIOBase(f)->tab->Close)(f);
- if (oflags != -1)
+ if (fd >= 0)
{
- dTHX;
- int fd = PerlLIO_open3(path,oflags,0666);
- if (fd >= 0)
+ PerlIOUnix *s;
+ if (*mode == 'I')
+ mode++;
+ if (!f)
{
- s->fd = fd;
- s->oflags = oflags;
- PerlIOBase(f)->flags |= PERLIO_F_OPEN;
- return 0;
+ f = PerlIO_allocate(aTHX);
+ s = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOUnix);
}
+ else
+ s = PerlIOSelf(f,PerlIOUnix);
+ s->fd = fd;
+ s->oflags = imode;
+ PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+ return f;
+ }
+ else
+ {
+ if (f)
+ {
+ /* FIXME: pop layers ??? */
+ }
+ return NULL;
}
- return -1;
}
SSize_t
sizeof(PerlIOUnix),
PERLIO_K_RAW,
PerlIOUnix_fileno,
- PerlIOUnix_fdopen,
PerlIOUnix_open,
- PerlIOUnix_reopen,
PerlIOUnix_pushed,
PerlIOBase_noop_ok,
PerlIOUnix_read,
PerlIO *f = NULL;
int init = 0;
char tmode[8];
- if (*mode == 'I')
- {
- init = 1;
- mode++;
- }
- if (fd >= 0)
- {
- FILE *stdio = NULL;
- if (init)
- {
- switch(fd)
- {
- case 0:
- stdio = PerlSIO_stdin;
- break;
- case 1:
- stdio = PerlSIO_stdout;
- break;
- case 2:
- stdio = PerlSIO_stderr;
- break;
- }
- }
- else
- {
- stdio = PerlSIO_fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
- }
- if (stdio)
- {
- PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
- s->stdio = stdio;
- }
- }
- return f;
}
/* This isn't used yet ... */
}
PerlIO *
-PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
+PerlIOStdio_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
{
- dTHX;
- PerlIO *f = NULL;
- FILE *stdio = PerlSIO_fopen(path,mode);
- if (stdio)
+ char tmode[8];
+ if (f)
{
- char tmode[8];
- PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
- (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
- PerlIOStdio);
- s->stdio = stdio;
+ char *path = SvPV_nolen(*args);
+ PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
+ FILE *stdio = PerlSIO_freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
+ if (!s->stdio)
+ return NULL;
+ s->stdio = stdio;
+ return f;
}
- return f;
-}
-
-int
-PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f)
-{
- dTHX;
- PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
- char tmode[8];
- FILE *stdio = PerlSIO_freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
- if (!s->stdio)
- return -1;
- s->stdio = stdio;
- return 0;
+ else
+ {
+ if (narg > 0)
+ {
+ char *path = SvPV_nolen(*args);
+ if (*mode == '#')
+ {
+ mode++;
+ fd = PerlLIO_open3(path,imode,perm);
+ }
+ else
+ {
+ FILE *stdio = PerlSIO_fopen(path,mode);
+ if (stdio)
+ {
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
+ (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
+ PerlIOStdio);
+ s->stdio = stdio;
+ }
+ return f;
+ }
+ }
+ if (fd >= 0)
+ {
+ FILE *stdio = NULL;
+ int init = 0;
+ if (*mode == 'I')
+ {
+ init = 1;
+ mode++;
+ }
+ if (init)
+ {
+ switch(fd)
+ {
+ case 0:
+ stdio = PerlSIO_stdin;
+ break;
+ case 1:
+ stdio = PerlSIO_stdout;
+ break;
+ case 2:
+ stdio = PerlSIO_stderr;
+ break;
+ }
+ }
+ else
+ {
+ stdio = PerlSIO_fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
+ }
+ if (stdio)
+ {
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
+ s->stdio = stdio;
+ return f;
+ }
+ }
+ }
+ return NULL;
}
SSize_t
sizeof(PerlIOStdio),
PERLIO_K_BUFFERED,
PerlIOStdio_fileno,
- PerlIOStdio_fdopen,
PerlIOStdio_open,
- PerlIOStdio_reopen,
PerlIOBase_pushed,
PerlIOBase_noop_ok,
PerlIOStdio_read,
}
PerlIO *
-PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
+PerlIOBuf_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
{
- dTHX;
- PerlIO_funcs *tab = PerlIO_default_btm();
- int init = 0;
- PerlIO *f;
- if (*mode == 'I')
- {
- init = 1;
- mode++;
- }
-#if O_BINARY != O_TEXT
- /* do something about failing setmode()? --jhi */
- PerlLIO_setmode(fd, O_BINARY);
-#endif
- f = (*tab->Fdopen)(tab,fd,mode);
if (f)
{
- PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
- if (init && fd == 2)
+ PerlIO *next = PerlIONext(f);
+ PerlIO_funcs *tab = PerlIOBase(next)->tab;
+ next = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,next,narg,args);
+ if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) != 0)
{
- /* Initial stderr is unbuffered */
- PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+ return NULL;
}
-#if 0
- PerlIO_debug("PerlIOBuf_fdopen %s f=%p fd=%d m=%s fl=%08"UVxf"\n",
- self->name,f,fd,mode,PerlIOBase(f)->flags);
-#endif
}
- return f;
-}
-
-PerlIO *
-PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
-{
- PerlIO_funcs *tab = PerlIO_default_btm();
- PerlIO *f = (*tab->Open)(tab,path,mode);
- if (f)
+ else
{
- PerlIO_push(f,self,mode,Nullch,0);
+ PerlIO_funcs *tab = PerlIO_default_btm();
+ int init = 0;
+ if (*mode == 'I')
+ {
+ init = 1;
+ mode++;
+ }
+ f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,NULL,narg,args);
+ if (f)
+ {
+ PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
+ fd = PerlIO_fileno(f);
+#if O_BINARY != O_TEXT
+ /* do something about failing setmode()? --jhi */
+ PerlLIO_setmode(fd , O_BINARY);
+#endif
+ if (init && fd == 2)
+ {
+ /* Initial stderr is unbuffered */
+ PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+ }
+ }
}
return f;
}
-int
-PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
-{
- PerlIO *next = PerlIONext(f);
- int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
- if (code = 0)
- code = (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0);
- return code;
-}
-
/* This "flush" is akin to sfio's sync in that it handles files in either
read or write state
*/
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED,
PerlIOBase_fileno,
- PerlIOBuf_fdopen,
PerlIOBuf_open,
- PerlIOBuf_reopen,
PerlIOBuf_pushed,
PerlIOBase_noop_ok,
PerlIOBuf_read,
PERLIO_K_BUFFERED,
PerlIOBase_fileno,
NULL,
- NULL,
- NULL,
PerlIOPending_pushed,
PerlIOBase_noop_ok,
PerlIOPending_read,
sizeof(PerlIOCrlf),
PERLIO_K_BUFFERED|PERLIO_K_CANCRLF,
PerlIOBase_fileno,
- PerlIOBuf_fdopen,
PerlIOBuf_open,
- PerlIOBuf_reopen,
PerlIOCrlf_pushed,
PerlIOBase_noop_ok, /* popped */
PerlIOBuf_read, /* generic read works with ptr/cnt lies ... */
sizeof(PerlIOMmap),
PERLIO_K_BUFFERED,
PerlIOBase_fileno,
- PerlIOBuf_fdopen,
PerlIOBuf_open,
- PerlIOBuf_reopen,
PerlIOBuf_pushed,
PerlIOBase_noop_ok,
PerlIOBuf_read,
projects / p5sagit/p5-mst-13.2.git / commitdiff