+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;
+}
+
+AV *
+PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **args)
+{
+ AV *def = PerlIO_default_layers(aTHX);
+ int incdef = 1;
+ if (!_perlio)
+ PerlIO_stdstreams(aTHX);
+ if (narg)
+ {
+ if (SvROK(*args) && !sv_isobject(*args))
+ {
+ if (SvTYPE(SvRV(*args)) < SVt_PVAV)
+ {
+ SV *handler = PerlIO_find_layer(aTHX_ "Scalar",6);
+ if (handler)
+ {
+ def = newAV();
+ av_push(def,handler);
+ av_push(def,&PL_sv_undef);
+ incdef = 0;
+ }
+ }
+ else
+ {
+ Perl_croak(aTHX_ "Unsupported reference arg to open()");
+ }
+ }
+ }
+ if (!layers)
+ layers = PerlIO_context_layers(aTHX_ mode);
+ if (layers && *layers)
+ {
+ AV *av;
+ if (incdef)
+ {
+ IV n = av_len(def)+1;
+ av = newAV();
+ while (n-- > 0)
+ {
+ SV **svp = av_fetch(def,n,0);
+ av_store(av,n,(svp) ? SvREFCNT_inc(*svp) : &PL_sv_undef);
+ }
+ }
+ else
+ {
+ av = def;
+ }
+ PerlIO_parse_layers(aTHX_ av,layers);
+ return av;
+ }
+ else
+ {
+ if (incdef)
+ SvREFCNT_inc(def);
+ return def;
+ }
+}
+
+PerlIO *
+PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
+{
+ if (!f && narg == 1 && *args == &PL_sv_undef)
+ {
+ if ((f = PerlIO_tmpfile()))
+ {
+ if (!layers)
+ layers = PerlIO_context_layers(aTHX_ mode);
+ if (layers && *layers)
+ PerlIO_apply_layers(aTHX_ f,mode,layers);
+ }
+ }
+ else
+ {
+ AV *layera;
+ IV n;
+ PerlIO_funcs *tab;
+ if (f && *f)
+ {
+ /* This is "reopen" - it is not tested as perl does not use it yet */
+ PerlIOl *l = *f;
+ layera = newAV();
+ while (l)
+ {
+ SV *arg = (l->tab->Getarg) ? (*l->tab->Getarg)(&l) : &PL_sv_undef;
+ av_unshift(layera,2);
+ av_store(layera,0,PerlIO_tab_sv(aTHX_ l->tab));
+ av_store(layera,1,arg);
+ l = *PerlIONext(&l);
+ }
+ }
+ else
+ {
+ layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args);
+ }
+ n = av_len(layera)-1;
+ while (n >= 0)
+ {
+ PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layera,n,NULL);
+ if (t && t->Open)
+ {
+ tab = t;
+ break;
+ }
+ n -= 2;
+ }
+ if (tab)
+ {
+ PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
+ tab->name,layers,mode,fd,imode,perm,f,narg,args);
+ f = (*tab->Open)(aTHX_ tab, layera, n, mode,fd,imode,perm,f,narg,args);
+ if (f)
+ {
+ if (n+2 < av_len(layera)+1)
+ {
+ if (PerlIO_apply_layera(aTHX_ f, mode, layera, n+2) != 0)
+ {
+ f = NULL;
+ }
+ }
+ }
+ }
+ SvREFCNT_dec(layera);
+ }
+ return f;
+}