/*
* perlio.c
* Copyright (c) 1996-2006, Nick Ing-Simmons
- * Copyright (c) 2006, 2007, Nick Ing-Simmons and others
+ * Copyright (c) 2006, 2007, Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public License
* or the Artistic License, as specified in the README file.
*/
#ifdef DOSISH
# if defined(atarist) || defined(__MINT__)
+ PERL_UNUSED_ARG(iotype);
if (!fflush(fp)) {
if (mode & O_BINARY)
((FILE *) fp)->_flag |= _IOBIN;
return 0;
# else
dTHX;
+ PERL_UNUSED_ARG(iotype);
#ifdef NETWARE
if (PerlLIO_setmode(fp, mode) != -1) {
#else
#else
# if defined(USEMYBINMODE)
dTHX;
+# if defined(__CYGWIN__)
+ PERL_UNUSED_ARG(iotype);
+# endif
if (my_binmode(fp, iotype, mode) != FALSE)
return 1;
else
} else {
SV * const pkgsv = newSVpvs("PerlIO");
SV * const layer = newSVpvn(name, len);
- CV * const cv = get_cv("PerlIO::Layer::NoWarnings", FALSE);
+ CV * const cv = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("PerlIO::Layer::NoWarnings"), 0);
ENTER;
SAVEINT(PL_in_load_module);
if (cv) {
SV *
PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
{
- HV * const stash = gv_stashpvs("PerlIO::Layer", TRUE);
+ HV * const stash = gv_stashpvs("PerlIO::Layer", GV_ADD);
SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
return sv;
}
*/
dVAR;
dXSARGS;
+ PERL_UNUSED_ARG(cv);
if (items)
PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0)));
XSRETURN(0);
{
dVAR;
dXSARGS;
+ PERL_UNUSED_ARG(cv);
if (items < 2)
Perl_croak(aTHX_ "Usage class->find(name[,load])");
else {
if (self->Getarg)
arg = (*self->Getarg)(aTHX_ o, param, flags);
f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+ if (PerlIOBase(o)->flags & PERLIO_F_UTF8)
+ PerlIOBase(f)->flags |= PERLIO_F_UTF8;
if (arg)
SvREFCNT_dec(arg);
}
if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) {
s = PerlIOSelf(f, PerlIOStdio);
s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(stdio));
}
}
return f;
if (PerlSIO_fflush(stdio) != 0)
return EOF;
}
- c = PerlSIO_fgetc(stdio);
- if (c == EOF)
- return EOF;
+ for (;;) {
+ c = PerlSIO_fgetc(stdio);
+ if (c != EOF)
+ break;
+ if (! PerlSIO_ferror(stdio) || errno != EINTR)
+ return EOF;
+ PERL_ASYNC_CHECK();
+ SETERRNO(0,0);
+ }
#if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT)))
if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) {
PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio);
s->stdio = stdio;
+ PerlIOUnix_refcnt_inc(fileno(stdio));
/* Link previous lower layers under new one */
*PerlIONext(f) = l;
}
PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
if (s->stdio == f) {
dTHX;
+ const int fd = fileno(f);
+ if (fd >= 0)
+ PerlIOUnix_refcnt_dec(fd);
PerlIO_pop(aTHX_ p);
return;
}
if (f)
PerlIOBase(f)->flags |= PERLIO_F_TEMP;
PerlLIO_unlink(SvPVX_const(sv));
- SvREFCNT_dec(sv);
}
+ SvREFCNT_dec(sv);
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
FILE * const stdio = PerlSIO_tmpfile();
Perl_PerlIO_context_layers(pTHX_ const char *mode)
{
dVAR;
- const char *type = NULL;
+ const char *direction = NULL;
+ SV *layers;
/*
* Need to supply default layer info from open.pm
*/
- if (PL_curcop && PL_curcop->cop_hints & HINT_LEXICAL_IO) {
- SV * const layers
- = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
- "open", 4, 0, 0);
- assert(layers);
- if (SvOK(layers)) {
- STRLEN len;
- type = SvPV_const(layers, len);
- if (type && mode && mode[0] != 'r') {
- /*
- * Skip to write part, which is separated by a '\0'
- */
- STRLEN read_len = strlen(type);
- if (read_len < len) {
- type += read_len + 1;
- }
- }
- }
+
+ if (!PL_curcop)
+ return NULL;
+
+ if (mode && mode[0] != 'r') {
+ if (PL_curcop->cop_hints & HINT_LEXICAL_IO_OUT)
+ direction = "open>";
+ } else {
+ if (PL_curcop->cop_hints & HINT_LEXICAL_IO_IN)
+ direction = "open<";
}
- return type;
+ if (!direction)
+ return NULL;
+
+ layers = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+ 0, direction, 5, 0, 0);
+
+ assert(layers);
+ return SvOK(layers) ? SvPV_nolen_const(layers) : NULL;
}