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 d454678..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,
@@ -350,12 +360,20 @@ IV
 PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
-    SV *offsv = sv_2mortal(newSViv(offset));
+    SV *offsv = sv_2mortal(sizeof(Off_t) > sizeof(IV)
+                          ? newSVnv((NV)offset) : newSViv((IV)offset));
     SV *whsv = sv_2mortal(newSViv(whence));
     SV *result =
        PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv,
                         Nullsv);
+#if Off_t_size == 8 && defined(CONDOP_SIZE) && CONDOP_SIZE < Off_t_size
+    if (result)
+       return (Off_t) SvIV(result);
+    else
+       return (Off_t) -1;
+#else
     return (result) ? SvIV(result) : -1;
+#endif
 }
 
 Off_t
@@ -364,7 +382,9 @@ PerlIOVia_tell(pTHX_ PerlIO * f)
     PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
     SV *result =
        PerlIOVia_method(aTHX_ f, MYMethod(TELL), G_SCALAR, Nullsv);
-    return (result) ? (Off_t) SvIV(result) : (Off_t) - 1;
+    return (result)
+          ? (SvNOK(result) ? (Off_t)SvNV(result) : (Off_t)SvIV(result))
+          : (Off_t) - 1;
 }
 
 SSize_t
@@ -436,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;
@@ -570,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),
@@ -610,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
 }