else \
SETERRNO(EBADF, SS_IVCHAN)
+#if defined(__osf__) && _XOPEN_SOURCE < 500
+extern int fseeko(FILE *, off_t, int);
+extern off_t ftello(FILE *);
+#endif
+
#ifndef USE_SFIO
int
perlsio_binmode(FILE *fp, int iotype, int mode)
Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
}
-static const char *
-PerlIO_context_layers(pTHX_ const char *mode)
-{
- dVAR;
- const char *type = NULL;
- /*
- * Need to supply default layer info from open.pm
- */
- if (PL_curcop) {
- SV * const layers = PL_curcop->cop_io;
- if (layers) {
- STRLEN len;
- type = SvPV_const(layers, len);
- if (type && 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;
- }
- }
- }
- }
- return type;
-}
static PerlIO_funcs *
PerlIO_layer_from_ref(pTHX_ SV *sv)
return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
case SVt_PVGV:
return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
+ default:
+ return NULL;
}
- return NULL;
}
PerlIO_list_t *
}
}
if (!layers || !*layers)
- layers = PerlIO_context_layers(aTHX_ mode);
+ layers = Perl_PerlIO_context_layers(aTHX_ mode);
if (layers && *layers) {
PerlIO_list_t *av;
if (incdef) {
if (!f && narg == 1 && *args == &PL_sv_undef) {
if ((f = PerlIO_tmpfile())) {
if (!layers || !*layers)
- layers = PerlIO_context_layers(aTHX_ mode);
+ layers = Perl_PerlIO_context_layers(aTHX_ mode);
if (layers && *layers)
PerlIO_apply_layers(aTHX_ f, mode, layers);
}
assert (new_max > new_fd);
- new_array
- = PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+ new_array =
+ (int*) PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
if (!new_array) {
#ifdef USE_THREADS
* Now some functions in terms of above which may be needed even if we are
* not in true PerlIO mode
*/
+const char *
+Perl_PerlIO_context_layers(pTHX_ const char *mode)
+{
+ dVAR;
+ const char *type = NULL;
+ /*
+ * 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;
+ }
+ }
+ }
+ }
+ return type;
+}
+
#ifndef HAS_FSETPOS
#undef PerlIO_setpos
int
PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
{
- dTHX;
+ dTHX;
const int val = my_vsnprintf(s, n > 0 ? n : 0, fmt, ap);
+ PERL_UNUSED_CONTEXT;
+
#ifndef PERL_MY_VSNPRINTF_GUARDED
if (val < 0 || (n > 0 ? val >= n : 0)) {
- dTHX;
- Perl_croak("panic: my_vsnprintf overflow in PerlIO_vsprintf\n");
+ Perl_croak(aTHX_ "panic: my_vsnprintf overflow in PerlIO_vsprintf\n");
}
#endif
return val;