+ if (f && *f)
+ return (*PerlIOBase(f)->tab->Fileno) (f);
+ else {
+ SETERRNO(EBADF, SS$_IVCHAN);
+ return -1;
+ }
+}
+
+static const char *
+PerlIO_context_layers(pTHX_ const char *mode)
+{
+ const char *type = NULL;
+ /*
+ * Need to supply default layer info from open.pm
+ */
+ if (PL_curcop) {
+ SV *layers = PL_curcop->cop_io;
+ if (layers) {
+ STRLEN len;
+ type = SvPV(layers, len);
+ if (type && mode[0] != 'r') {
+ /*
+ * Skip to write part
+ */
+ const char *s = strchr(type, 0);
+ if (s && (s - type) < len) {
+ type = s + 1;
+ }
+ }
+ }
+ }
+ return type;
+}
+
+static PerlIO_funcs *
+PerlIO_layer_from_ref(pTHX_ SV *sv)
+{
+ /*
+ * For any scalar type load the handler which is bundled with perl
+ */
+ if (SvTYPE(sv) < SVt_PVAV)
+ return PerlIO_find_layer(aTHX_ "Scalar", 6, 1);
+
+ /*
+ * For other types allow if layer is known but don't try and load it
+ */
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ return PerlIO_find_layer(aTHX_ "Array", 5, 0);
+ case SVt_PVHV:
+ return PerlIO_find_layer(aTHX_ "Hash", 4, 0);
+ case SVt_PVCV:
+ return PerlIO_find_layer(aTHX_ "Code", 4, 0);
+ case SVt_PVGV:
+ return PerlIO_find_layer(aTHX_ "Glob", 4, 0);
+ }
+ return NULL;
+}
+
+PerlIO_list_t *
+PerlIO_resolve_layers(pTHX_ const char *layers,
+ const char *mode, int narg, SV **args)
+{
+ PerlIO_list_t *def = PerlIO_default_layers(aTHX);
+ int incdef = 1;
+ if (!PL_perlio)
+ PerlIO_stdstreams(aTHX);
+ if (narg) {
+ SV *arg = *args;
+ /*
+ * If it is a reference but not an object see if we have a handler
+ * for it
+ */
+ if (SvROK(arg) && !sv_isobject(arg)) {
+ PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
+ if (handler) {
+ def = PerlIO_list_alloc(aTHX);
+ PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef);
+ incdef = 0;
+ }
+ /*
+ * Don't fail if handler cannot be found :Via(...) etc. may do
+ * something sensible else we will just stringfy and open
+ * resulting string.
+ */
+ }
+ }
+ if (!layers)
+ layers = PerlIO_context_layers(aTHX_ mode);
+ if (layers && *layers) {
+ PerlIO_list_t *av;
+ if (incdef) {
+ IV i = def->cur;
+ av = PerlIO_list_alloc(aTHX);
+ for (i = 0; i < def->cur; i++) {
+ PerlIO_list_push(aTHX_ av, def->array[i].funcs,
+ def->array[i].arg);
+ }
+ }
+ else {
+ av = def;
+ }
+ PerlIO_parse_layers(aTHX_ av, layers);
+ return av;
+ }
+ else {
+ if (incdef)
+ def->refcnt++;
+ return def;
+ }