#define MYMethod(x) #x,&s->x
CV *
-PerlIOVia_fetchmethod(pTHX_ PerlIOVia *s,char *method,CV **save)
+PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
{
- GV *gv = gv_fetchmeth(s->stash,method,strlen(method),0);
+ 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(s->stash), method, gv);
#endif
- if (gv)
- {
- return *save = GvCV(gv);
- }
- else
- {
- return *save = (CV *) -1;
- }
+ if (gv) {
+ return *save = GvCV(gv);
+ }
+ else {
+ return *save = (CV *) - 1;
+ }
}
/*
*/
SV *
-PerlIOVia_method(pTHX_ PerlIO *f,char *method,CV **save,int flags,...)
+PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
+ ...)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- CV *cv = (*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s,method,save);
- SV *result = Nullsv;
- va_list ap;
- va_start(ap,flags);
- if (cv != (CV *)-1)
- {
- IV count;
- dSP;
- SV *arg;
- PUSHSTACKi(PERLSI_MAGIC);
- ENTER;
- SPAGAIN;
- PUSHMARK(sp);
- XPUSHs(s->obj);
- while ((arg = va_arg(ap,SV *)))
- {
- XPUSHs(arg);
- }
- if (*PerlIONext(f))
- {
- if (!s->fh)
- {
- GV *gv = newGVgen(HvNAME(s->stash));
- GvIOp(gv) = newIO();
- s->fh = newRV_noinc((SV *)gv);
- s->io = GvIOp(gv);
- }
- IoIFP(s->io) = PerlIONext(f);
- IoOFP(s->io) = PerlIONext(f);
- XPUSHs(s->fh);
- }
- else
- {
- PerlIO_debug("No next\n");
- }
- PUTBACK;
- count = call_sv((SV *)cv,flags);
- if (count)
- {
- SPAGAIN;
- result = POPs;
- PUTBACK;
- }
- else
- {
- result = &PL_sv_undef;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ CV *cv =
+ (*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s, method, save);
+ SV *result = Nullsv;
+ va_list ap;
+ va_start(ap, flags);
+ if (cv != (CV *) - 1) {
+ IV count;
+ dSP;
+ SV *arg;
+ PUSHSTACKi(PERLSI_MAGIC);
+ ENTER;
+ SPAGAIN;
+ PUSHMARK(sp);
+ XPUSHs(s->obj);
+ while ((arg = va_arg(ap, SV *))) {
+ XPUSHs(arg);
+ }
+ if (*PerlIONext(f)) {
+ if (!s->fh) {
+ GV *gv = newGVgen(HvNAME(s->stash));
+ GvIOp(gv) = newIO();
+ s->fh = newRV_noinc((SV *) gv);
+ s->io = GvIOp(gv);
+ }
+ IoIFP(s->io) = PerlIONext(f);
+ IoOFP(s->io) = PerlIONext(f);
+ XPUSHs(s->fh);
+ }
+ else {
+ PerlIO_debug("No next\n");
+ }
+ PUTBACK;
+ count = call_sv((SV *) cv, flags);
+ if (count) {
+ SPAGAIN;
+ result = POPs;
+ PUTBACK;
+ }
+ else {
+ result = &PL_sv_undef;
+ }
+ LEAVE;
+ POPSTACK;
}
- LEAVE;
- POPSTACK;
- }
- va_end(ap);
- return result;
+ va_end(ap);
+ return result;
}
IV
-PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
+ PerlIO_funcs * tab)
{
- IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab);
- if (code == 0)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- if (!arg)
- {
- if (ckWARN(WARN_LAYER))
- Perl_warner(aTHX_ packWARN(WARN_LAYER), "No package specified");
- errno = EINVAL;
- code = -1;
- }
- else
- {
- STRLEN pkglen = 0;
- char *pkg = SvPV(arg,pkglen);
- s->obj = SvREFCNT_inc(arg);
- s->stash = gv_stashpvn(pkg, pkglen, FALSE);
- if (!s->stash)
- {
- 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);
- }
- if (s->stash)
- {
- SV *modesv = (mode) ? sv_2mortal(newSVpvn(mode,strlen(mode))) : Nullsv;
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(PUSHED),G_SCALAR,modesv,Nullsv);
- if (result)
- {
- if (sv_isobject(result))
- {
- s->obj = SvREFCNT_inc(result);
- SvREFCNT_dec(arg);
- }
- else if (SvIV(result) != 0)
- return SvIV(result);
- }
- if (PerlIOVia_fetchmethod(aTHX_ s,MYMethod(FILL)) == (CV *) -1)
- PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
- else
- PerlIOBase(f)->flags |= PERLIO_F_FASTGETS;
- }
- else
- {
- if (ckWARN(WARN_LAYER))
- Perl_warner(aTHX_ packWARN(WARN_LAYER), "Cannot find package '%.*s'",(int) pkglen,pkg);
+ IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
+ if (code == 0) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ if (!arg) {
+ if (ckWARN(WARN_LAYER))
+ Perl_warner(aTHX_ packWARN(WARN_LAYER),
+ "No package specified");
+ errno = EINVAL;
+ code = -1;
+ }
+ else {
+ STRLEN pkglen = 0;
+ char *pkg = SvPV(arg, pkglen);
+ s->obj = SvREFCNT_inc(arg);
+ s->stash = gv_stashpvn(pkg, pkglen, FALSE);
+ if (!s->stash) {
+ 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);
+ }
+ if (s->stash) {
+ SV *modesv =
+ (mode) ? sv_2mortal(newSVpvn(mode, strlen(mode))) :
+ Nullsv;
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR,
+ modesv, Nullsv);
+ if (result) {
+ if (sv_isobject(result)) {
+ s->obj = SvREFCNT_inc(result);
+ SvREFCNT_dec(arg);
+ }
+ else if (SvIV(result) != 0)
+ return SvIV(result);
+ }
+ if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) ==
+ (CV *) - 1)
+ PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
+ else
+ PerlIOBase(f)->flags |= PERLIO_F_FASTGETS;
+ }
+ else {
+ if (ckWARN(WARN_LAYER))
+ Perl_warner(aTHX_ packWARN(WARN_LAYER),
+ "Cannot find package '%.*s'", (int) pkglen,
+ pkg);
#ifdef ENOSYS
- errno = ENOSYS;
+ errno = ENOSYS;
#else
#ifdef ENOENT
- errno = ENOENT;
+ errno = ENOENT;
#endif
#endif
- code = -1;
- }
+ code = -1;
+ }
+ }
}
- }
- return code;
+ return code;
}
PerlIO *
-PerlIOVia_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n,
- const char *mode, int fd, int imode, int perm,
- PerlIO *f, int narg, SV **args)
+PerlIOVia_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers,
+ IV n, const char *mode, int fd, int imode, int perm,
+ PerlIO * f, int narg, SV ** args)
{
- if (!f)
- {
- f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX),self,mode,PerlIOArg);
- }
- else
- {
- /* Reopen */
- if (!PerlIO_push(aTHX_ f,self,mode,PerlIOArg))
- return NULL;
- }
- if (f)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = Nullsv;
- if (fd >= 0)
- {
- SV *fdsv = sv_2mortal(newSViv(fd));
- result = PerlIOVia_method(aTHX_ f,MYMethod(FDOPEN),G_SCALAR,fdsv,Nullsv);
+ if (!f) {
+ f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX), self, mode,
+ PerlIOArg);
}
- else if (narg > 0)
- {
- if (*mode == '#')
- {
- SV *imodesv = sv_2mortal(newSViv(imode));
- SV *permsv = sv_2mortal(newSViv(perm));
- result = PerlIOVia_method(aTHX_ f,MYMethod(SYSOPEN),G_SCALAR,*args,imodesv,permsv,Nullsv);
- }
- else
- {
- result = PerlIOVia_method(aTHX_ f,MYMethod(OPEN),G_SCALAR,*args,Nullsv);
- }
+ else {
+ /* Reopen */
+ if (!PerlIO_push(aTHX_ f, self, mode, PerlIOArg))
+ return NULL;
}
- if (result)
- {
- if (sv_isobject(result))
- s->obj = SvREFCNT_inc(result);
- else if (!SvTRUE(result))
- {
- return NULL;
- }
- }
- else
- {
- /* Required open method not present */
- PerlIO_funcs *tab = NULL;
- IV m = n-1;
- while (m >= 0) {
- PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layers, m, NULL);
- if (t && t->Open) {
- tab = t;
- break;
+ if (f) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result = Nullsv;
+ if (fd >= 0) {
+ SV *fdsv = sv_2mortal(newSViv(fd));
+ result =
+ PerlIOVia_method(aTHX_ f, MYMethod(FDOPEN), G_SCALAR, fdsv,
+ Nullsv);
+ }
+ else if (narg > 0) {
+ if (*mode == '#') {
+ SV *imodesv = sv_2mortal(newSViv(imode));
+ SV *permsv = sv_2mortal(newSViv(perm));
+ result =
+ PerlIOVia_method(aTHX_ f, MYMethod(SYSOPEN), G_SCALAR,
+ *args, imodesv, permsv, Nullsv);
+ }
+ else {
+ result =
+ PerlIOVia_method(aTHX_ f, MYMethod(OPEN), G_SCALAR,
+ *args, Nullsv);
}
- n--;
}
- if (tab) {
- if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode, perm,
- PerlIONext(f), narg, args)) {
- PerlIO_debug("Opened with %s => %p->%p\n",tab->name,PerlIONext(f),*PerlIONext(f));
- if (m + 1 < n) {
- /*
- * More layers above the one that we used to open -
- * apply them now
- */
- if (PerlIO_apply_layera(aTHX_ PerlIONext(f), mode, layers, m+1, n) != 0) {
- /* If pushing layers fails close the file */
- PerlIO_close(f);
- f = NULL;
+ if (result) {
+ if (sv_isobject(result))
+ s->obj = SvREFCNT_inc(result);
+ else if (!SvTRUE(result)) {
+ return NULL;
+ }
+ }
+ else {
+ /* Required open method not present */
+ PerlIO_funcs *tab = NULL;
+ IV m = n - 1;
+ while (m >= 0) {
+ PerlIO_funcs *t =
+ PerlIO_layer_fetch(aTHX_ layers, m, NULL);
+ if (t && t->Open) {
+ tab = t;
+ break;
+ }
+ n--;
+ }
+ if (tab) {
+ if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode,
+ perm, PerlIONext(f), narg, args)) {
+ PerlIO_debug("Opened with %s => %p->%p\n", tab->name,
+ PerlIONext(f), *PerlIONext(f));
+ if (m + 1 < n) {
+ /*
+ * More layers above the one that we used to open -
+ * apply them now
+ */
+ if (PerlIO_apply_layera
+ (aTHX_ PerlIONext(f), mode, layers, m + 1,
+ n) != 0) {
+ /* If pushing layers fails close the file */
+ PerlIO_close(f);
+ f = NULL;
+ }
}
+ return f;
+ }
+ else {
+ /* Sub-layer open failed */
}
- return f;
}
else {
- /* Sub-layer open failed */
+ /* Nothing to do the open */
}
+ return NULL;
}
- else {
- /* Nothing to do the open */
- }
- return NULL;
}
- }
- return f;
+ return f;
}
IV
-PerlIOVia_popped(pTHX_ PerlIO *f)
+PerlIOVia_popped(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- PerlIOVia_method(aTHX_ f,MYMethod(POPPED),G_VOID,Nullsv);
- if (s->var)
- {
- SvREFCNT_dec(s->var);
- s->var = Nullsv;
- }
-
- if (s->io)
- {
- IoIFP(s->io) = NULL;
- IoOFP(s->io) = NULL;
- }
- if (s->fh)
- {
- SvREFCNT_dec(s->fh);
- s->fh = Nullsv;
- s->io = NULL;
- }
- if (s->obj)
- {
- SvREFCNT_dec(s->obj);
- s->obj = Nullsv;
- }
- return 0;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ PerlIOVia_method(aTHX_ f, MYMethod(POPPED), G_VOID, Nullsv);
+ if (s->var) {
+ SvREFCNT_dec(s->var);
+ s->var = Nullsv;
+ }
+
+ if (s->io) {
+ IoIFP(s->io) = NULL;
+ IoOFP(s->io) = NULL;
+ }
+ if (s->fh) {
+ SvREFCNT_dec(s->fh);
+ s->fh = Nullsv;
+ s->io = NULL;
+ }
+ if (s->obj) {
+ SvREFCNT_dec(s->obj);
+ s->obj = Nullsv;
+ }
+ return 0;
}
IV
-PerlIOVia_close(pTHX_ PerlIO *f)
+PerlIOVia_close(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- IV code = PerlIOBase_close(aTHX_ f);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(CLOSE),G_SCALAR,Nullsv);
- if (result && SvIV(result) != 0)
- code = SvIV(result);
- PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
- return code;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ IV code = PerlIOBase_close(aTHX_ f);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(CLOSE), G_SCALAR, Nullsv);
+ if (result && SvIV(result) != 0)
+ code = SvIV(result);
+ PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
+ return code;
}
IV
-PerlIOVia_fileno(pTHX_ PerlIO *f)
+PerlIOVia_fileno(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILENO),G_SCALAR,Nullsv);
- return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(FILENO), G_SCALAR, Nullsv);
+ return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
}
IV
-PerlIOVia_binmode(pTHX_ PerlIO *f)
+PerlIOVia_binmode(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(BINMODE),G_SCALAR,Nullsv);
- if (!result || !SvOK(result))
- {
- PerlIO_pop(aTHX_ f);
- return 0;
- }
- return SvIV(result);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(BINMODE), G_SCALAR, Nullsv);
+ if (!result || !SvOK(result)) {
+ PerlIO_pop(aTHX_ f);
+ return 0;
+ }
+ return SvIV(result);
}
IV
-PerlIOVia_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
+PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *offsv = sv_2mortal(newSViv(offset));
- SV *whsv = sv_2mortal(newSViv(whence));
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(SEEK),G_SCALAR,offsv,whsv,Nullsv);
- return (result) ? SvIV(result) : -1;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *offsv = sv_2mortal(newSViv(offset));
+ SV *whsv = sv_2mortal(newSViv(whence));
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv,
+ Nullsv);
+ return (result) ? SvIV(result) : -1;
}
Off_t
-PerlIOVia_tell(pTHX_ PerlIO *f)
+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;
+ 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;
}
SSize_t
-PerlIOVia_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+PerlIOVia_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *buf = sv_2mortal(newSVpvn((char *)vbuf,count));
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(UNREAD),G_SCALAR,buf,Nullsv);
- if (result)
- return (SSize_t) SvIV(result);
- else
- {
- return PerlIOBase_unread(aTHX_ f,vbuf,count);
- }
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *buf = sv_2mortal(newSVpvn((char *) vbuf, count));
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(UNREAD), G_SCALAR, buf, Nullsv);
+ if (result)
+ return (SSize_t) SvIV(result);
+ else {
+ return PerlIOBase_unread(aTHX_ f, vbuf, count);
+ }
}
SSize_t
-PerlIOVia_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
+PerlIOVia_read(pTHX_ PerlIO * f, void *vbuf, Size_t count)
{
- SSize_t rd = 0;
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)
- {
- rd = PerlIOBase_read(aTHX_ f,vbuf,count);
- }
- else
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *buf = sv_2mortal(newSV(count));
- SV *n = sv_2mortal(newSViv(count));
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(READ),G_SCALAR,buf,n,Nullsv);
- if (result)
- {
- rd = (SSize_t) SvIV(result);
- Move(SvPVX(buf),vbuf,rd,char);
- return rd;
- }
+ SSize_t rd = 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
+ rd = PerlIOBase_read(aTHX_ f, vbuf, count);
+ }
+ else {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *buf = sv_2mortal(newSV(count));
+ SV *n = sv_2mortal(newSViv(count));
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(READ), G_SCALAR, buf, n,
+ Nullsv);
+ if (result) {
+ rd = (SSize_t) SvIV(result);
+ Move(SvPVX(buf), vbuf, rd, char);
+ return rd;
+ }
+ }
}
- }
- return rd;
+ return rd;
}
SSize_t
-PerlIOVia_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
+PerlIOVia_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *buf = newSVpvn((char *)vbuf,count);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(WRITE),G_SCALAR,buf,Nullsv);
- SvREFCNT_dec(buf);
- if (result)
- return (SSize_t) SvIV(result);
- return -1;
- }
- return 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *buf = newSVpvn((char *) vbuf, count);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(WRITE), G_SCALAR, buf,
+ Nullsv);
+ SvREFCNT_dec(buf);
+ if (result)
+ return (SSize_t) SvIV(result);
+ return -1;
+ }
+ return 0;
}
IV
-PerlIOVia_fill(pTHX_ PerlIO *f)
+PerlIOVia_fill(pTHX_ PerlIO * f)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILL),G_SCALAR,Nullsv);
- if (s->var)
- {
- SvREFCNT_dec(s->var);
- s->var = Nullsv;
- }
- if (result && SvOK(result))
- {
- STRLEN len = 0;
- char *p = SvPV(result,len);
- s->var = newSVpvn(p,len);
- s->cnt = SvCUR(s->var);
- return 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(FILL), G_SCALAR, Nullsv);
+ if (s->var) {
+ SvREFCNT_dec(s->var);
+ s->var = Nullsv;
+ }
+ if (result && SvOK(result)) {
+ STRLEN len = 0;
+ char *p = SvPV(result, len);
+ s->var = newSVpvn(p, len);
+ s->cnt = SvCUR(s->var);
+ return 0;
+ }
+ else
+ PerlIOBase(f)->flags |= PERLIO_F_EOF;
}
- else
- PerlIOBase(f)->flags |= PERLIO_F_EOF;
- }
- return -1;
+ return -1;
}
IV
-PerlIOVia_flush(pTHX_ PerlIO *f)
+PerlIOVia_flush(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FLUSH),G_SCALAR,Nullsv);
- if (s->var && s->cnt > 0)
- {
- SvREFCNT_dec(s->var);
- s->var = Nullsv;
- }
- return (result) ? SvIV(result) : 0;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, MYMethod(FLUSH), G_SCALAR, Nullsv);
+ if (s->var && s->cnt > 0) {
+ SvREFCNT_dec(s->var);
+ s->var = Nullsv;
+ }
+ return (result) ? SvIV(result) : 0;
}
STDCHAR *
-PerlIOVia_get_base(pTHX_ PerlIO *f)
+PerlIOVia_get_base(pTHX_ PerlIO * f)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- if (s->var)
- {
- return (STDCHAR *)SvPVX(s->var);
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ if (s->var) {
+ return (STDCHAR *) SvPVX(s->var);
+ }
}
- }
- return (STDCHAR *) Nullch;
+ return (STDCHAR *) Nullch;
}
STDCHAR *
-PerlIOVia_get_ptr(pTHX_ PerlIO *f)
+PerlIOVia_get_ptr(pTHX_ PerlIO * f)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- if (s->var)
- {
- STDCHAR *p = (STDCHAR *)(SvEND(s->var) - s->cnt);
- return p;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ if (s->var) {
+ STDCHAR *p = (STDCHAR *) (SvEND(s->var) - s->cnt);
+ return p;
+ }
}
- }
- return (STDCHAR *) Nullch;
+ return (STDCHAR *) Nullch;
}
SSize_t
-PerlIOVia_get_cnt(pTHX_ PerlIO *f)
+PerlIOVia_get_cnt(pTHX_ PerlIO * f)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- if (s->var)
- {
- return s->cnt;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ if (s->var) {
+ return s->cnt;
+ }
}
- }
- return 0;
+ return 0;
}
Size_t
-PerlIOVia_bufsiz(pTHX_ PerlIO *f)
+PerlIOVia_bufsiz(pTHX_ PerlIO * f)
{
- if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
- {
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- if (s->var)
- return SvCUR(s->var);
- }
- return 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ if (s->var)
+ return SvCUR(s->var);
+ }
+ return 0;
}
void
-PerlIOVia_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
+PerlIOVia_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- s->cnt = cnt;
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ s->cnt = cnt;
}
void
-PerlIOVia_setlinebuf(pTHX_ PerlIO *f)
+PerlIOVia_setlinebuf(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- PerlIOVia_method(aTHX_ f,MYMethod(SETLINEBUF),G_VOID,Nullsv);
- PerlIOBase_setlinebuf(aTHX_ f);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ PerlIOVia_method(aTHX_ f, MYMethod(SETLINEBUF), G_VOID, Nullsv);
+ PerlIOBase_setlinebuf(aTHX_ f);
}
void
-PerlIOVia_clearerr(pTHX_ PerlIO *f)
+PerlIOVia_clearerr(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- PerlIOVia_method(aTHX_ f,MYMethod(CLEARERR),G_VOID,Nullsv);
- PerlIOBase_clearerr(aTHX_ f);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ PerlIOVia_method(aTHX_ f, MYMethod(CLEARERR), G_VOID, Nullsv);
+ PerlIOBase_clearerr(aTHX_ f);
}
IV
-PerlIOVia_error(pTHX_ PerlIO *f)
+PerlIOVia_error(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,"ERROR",&s->mERROR,G_SCALAR,Nullsv);
- return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, "ERROR", &s->mERROR, G_SCALAR, Nullsv);
+ return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
}
IV
-PerlIOVia_eof(pTHX_ PerlIO *f)
+PerlIOVia_eof(pTHX_ PerlIO * f)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- SV *result = PerlIOVia_method(aTHX_ f,"EOF",&s->mEOF,G_SCALAR,Nullsv);
- return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ SV *result =
+ PerlIOVia_method(aTHX_ f, "EOF", &s->mEOF, G_SCALAR, Nullsv);
+ return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f);
}
SV *
-PerlIOVia_getarg(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
+PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
{
- PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- return PerlIOVia_method(aTHX_ f,MYMethod(GETARG),G_SCALAR,Nullsv);
+ PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
+ return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
}
PerlIO *
-PerlIOVia_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
+PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
+ int flags)
{
- if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)))
- {
- /* Most of the fields will lazily set themselves up as needed
- stash and obj have been set up by the implied push
- */
- }
- return f;
+ if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
+ /* Most of the fields will lazily set themselves up as needed
+ stash and obj have been set up by the implied push
+ */
+ }
+ return f;
}
+
+
PerlIO_funcs PerlIO_object = {
sizeof(PerlIO_funcs),
"Via",
#endif
}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff