This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The last parameter to gv_stashpv/gv_stashpvn/gv_stashsv is a bitmask
[perl5.git] / ext / PerlIO / via / via.xs
index 4c50d5f..5670887 100644 (file)
@@ -35,6 +35,7 @@ typedef struct
  CV *mERROR;
  CV *mEOF;
  CV *BINMODE;
+ CV *UTF8;
 } PerlIOVia;
 
 #define MYMethod(x) #x,&s->x
@@ -44,7 +45,7 @@ PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
 {
     GV *gv = gv_fetchmeth(s->stash, method, strlen(method), 0);
 #if 0
-    Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME(s->stash), method, gv);
+    Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME_get(s->stash), method, gv);
 #endif
     if (gv) {
        return *save = GvCV(gv);
@@ -86,7 +87,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
        }
        if (*PerlIONext(f)) {
            if (!s->fh) {
-               GV *gv = newGVgen(HvNAME(s->stash));
+               GV *gv = newGVgen(HvNAME_get(s->stash));
                GvIOp(gv) = newIO();
                s->fh = newRV_noinc((SV *) gv);
                s->io = GvIOp(gv);
@@ -132,15 +133,15 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        }
        else {
            STRLEN pkglen = 0;
-           char *pkg = SvPV(arg, pkglen);
+           const char *pkg = SvPV(arg, pkglen);
            s->obj = SvREFCNT_inc(arg);
-           s->stash = gv_stashpvn(pkg, pkglen, FALSE);
+           s->stash = gv_stashpvn(pkg, pkglen, 0);
            if (!s->stash) {
+               SvREFCNT_dec(s->obj);
                s->obj =
                    newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg),
                             pkglen + 13);
-               SvREFCNT_dec(arg);
-               s->stash = gv_stashpvn(SvPVX(s->obj), pkglen + 13, FALSE);
+               s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, 0);
            }
            if (s->stash) {
                char lmode[8];
@@ -155,8 +156,8 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
                                     modesv, Nullsv);
                if (result) {
                    if (sv_isobject(result)) {
+                       SvREFCNT_dec(s->obj);
                        s->obj = SvREFCNT_inc(result);
-                       SvREFCNT_dec(arg);
                    }
                    else if (SvIV(result) != 0)
                        return SvIV(result);
@@ -164,6 +165,15 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
                else {
                    goto push_failed;
                }
+               modesv = (*PerlIONext(f) && (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_UTF8))
+                           ? &PL_sv_yes : &PL_sv_no;
+               result = PerlIOVia_method(aTHX_ f, MYMethod(UTF8), G_SCALAR, modesv, Nullsv);
+               if (result && SvTRUE(result)) {
+                   PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+               }
+               else {
+                   PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
+               }
                if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) ==
                    (CV *) - 1)
                    PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
@@ -245,7 +255,7 @@ PerlIOVia_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers,
                    tab = t;
                    break;
                }
-               n--;
+               m--;
            }
            if (tab) {
                if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode,
@@ -446,7 +456,7 @@ PerlIOVia_fill(pTHX_ PerlIO * f)
        }
        if (result && SvOK(result)) {
            STRLEN len = 0;
-           char *p = SvPV(result, len);
+           const char *p = SvPV(result, len);
            s->var = newSVpvn(p, len);
            s->cnt = SvCUR(s->var);
            return 0;
@@ -580,7 +590,7 @@ PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
 
 
 
-PerlIO_funcs PerlIO_object = {
+PERLIO_FUNCS_DECL(PerlIO_object) = {
  sizeof(PerlIO_funcs),
  "via",
  sizeof(PerlIOVia),
@@ -620,7 +630,7 @@ PROTOTYPES: ENABLE;
 BOOT:
 {
 #ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_object);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
 #endif
 }