[perl5.git] / ext / PerlIO / Via / Via.xs

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef PERLIO_LAYERS

#include "perliol.h"

typedef struct
{
 struct _PerlIO base;       /* Base "class" info */
 HV *		stash;
 SV *		obj;
 SV *		var;
 SSize_t	cnt;
 IO *		io;
 SV *		fh;
 CV *PUSHED;
 CV *POPPED;
 CV *OPEN;
 CV *FDOPEN;
 CV *SYSOPEN;
 CV *GETARG;
 CV *FILENO;
 CV *READ;
 CV *WRITE;
 CV *FILL;
 CV *CLOSE;
 CV *SEEK;
 CV *TELL;
 CV *UNREAD;
 CV *FLUSH;
 CV *SETLINEBUF;
 CV *CLEARERR;
 CV *mERROR;
 CV *mEOF;
} PerlIOVia;

#define MYMethod(x) #x,&s->x

CV *
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);
#endif
 if (gv)
  {
   return *save = GvCV(gv);
  }
 else
  {
   return *save = (CV *) -1;
  }
}

SV *
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;
   ENTER;
   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);
    }
   PUTBACK;
   count = call_sv((SV *)cv,flags);
   if (count)
    {
     SPAGAIN;
     result = POPs;
     PUTBACK;
    }
   else
    {
     result = &PL_sv_undef;
    }
   LEAVE;
  }
 va_end(ap);
 return result;
}

IV
PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
 IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
 if (code == 0)
  {
   PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
   if (!arg)
    {
     Perl_warn(aTHX_ "No package specified");
     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)
      {
       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
      {
       Perl_warn(aTHX_ "Cannot find package '%.*s'",(int) pkglen,pkg);
#ifdef ENOSYS
       errno = ENOSYS;
#else
#ifdef ENOENT
       errno = ENOENT;
#endif
#endif
       code = -1;
      }
    }
  }
 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)
{
 if (!f)
  {
   f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX),self,mode,PerlIOArg);
  }
 else
  {
   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);
    }
   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);
      }
    }
   if (result)
    {
     if (sv_isobject(result))
      s->obj = SvREFCNT_inc(result);
     else if (!SvTRUE(result))
      {
       return NULL;
      }
    }
   else
    return NULL;
  }
 return f;
}

IV
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;
}

IV
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;
}

IV
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));
}

IV
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;
}

Off_t
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;
}

SSize_t
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);
  }
}

SSize_t
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;
      }
    }
  }
 return rd;
}

SSize_t
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;
}

IV
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;
    }
   else
    PerlIOBase(f)->flags |= PERLIO_F_EOF;
  }
 return -1;
}

IV
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;
}

STDCHAR *
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);
    }
  }
 return (STDCHAR *) Nullch;
}

STDCHAR *
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;
    }
  }
 return (STDCHAR *) Nullch;
}

SSize_t
PerlIOVia_get_cnt(pTHX_ PerlIO *f)
{
 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
  {
   PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
   if (s->var)
    {
     return s->cnt;
    }
  }
 return 0;
}

Size_t
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;
}

void
PerlIOVia_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
{
 PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
 s->cnt = cnt;
}

void
PerlIOVia_setlinebuf(pTHX_ PerlIO *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 *s = PerlIOSelf(f,PerlIOVia);
 PerlIOVia_method(aTHX_ f,MYMethod(CLEARERR),G_VOID,Nullsv);
 PerlIOBase_clearerr(aTHX_ f);
}

IV
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);
}

IV
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);
}

SV *
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);
}

PerlIO *
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;
}

PerlIO_funcs PerlIO_object = {
 "Via",
 sizeof(PerlIOVia),
 PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
 PerlIOVia_pushed,
 PerlIOVia_popped,
 NULL, /* PerlIOVia_open, */
 PerlIOVia_getarg,
 PerlIOVia_fileno,
 PerlIOVia_dup,
 PerlIOVia_read,
 PerlIOVia_unread,
 PerlIOVia_write,
 PerlIOVia_seek,
 PerlIOVia_tell,
 PerlIOVia_close,
 PerlIOVia_flush,
 PerlIOVia_fill,
 PerlIOVia_eof,
 PerlIOVia_error,
 PerlIOVia_clearerr,
 PerlIOVia_setlinebuf,
 PerlIOVia_get_base,
 PerlIOVia_bufsiz,
 PerlIOVia_get_ptr,
 PerlIOVia_get_cnt,
 PerlIOVia_set_ptrcnt,
};


#endif /* Layers available */

MODULE = PerlIO::Via	PACKAGE = PerlIO::Via
PROTOTYPES: ENABLE;

BOOT:
{
#ifdef PERLIO_LAYERS
 PerlIO_define_layer(aTHX_ &PerlIO_object);
#endif
}
Commit	Line	Data
e7a1fdd7 NIS	1	#define PERL_NO_GET_CONTEXT
	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
	5	#ifdef PERLIO_LAYERS
	6
	7	#include "perliol.h"
	8
	9	typedef struct
	10	{
	11	struct _PerlIO base; /* Base "class" info */
	12	HV * stash;
	13	SV * obj;
	14	SV * var;
	15	SSize_t cnt;
e7a1fdd7 NIS	16	IO * io;
	17	SV * fh;
	18	CV *PUSHED;
	19	CV *POPPED;
	20	CV *OPEN;
	21	CV *FDOPEN;
	22	CV *SYSOPEN;
	23	CV *GETARG;
	24	CV *FILENO;
	25	CV *READ;
	26	CV *WRITE;
	27	CV *FILL;
	28	CV *CLOSE;
	29	CV *SEEK;
	30	CV *TELL;
	31	CV *UNREAD;
	32	CV *FLUSH;
	33	CV *SETLINEBUF;
	34	CV *CLEARERR;
c7997937	35	CV *mERROR;
e7a1fdd7 NIS	36	CV *mEOF;
	37	} PerlIOVia;
	38
	39	#define MYMethod(x) #x,&s->x
	40
	41	CV *
	42	PerlIOVia_fetchmethod(pTHX_ PerlIOVia s,char method,CV **save)
	43	{
	44	GV *gv = gv_fetchmeth(s->stash,method,strlen(method),0);
	45	#if 0
	46	Perl_warn(aTHX_ "Lookup %s::%s => %p",HvNAME(s->stash),method,gv);
	47	#endif
	48	if (gv)
	49	{
	50	return *save = GvCV(gv);
	51	}
	52	else
	53	{
	54	return save = (CV ) -1;
	55	}
e7a1fdd7 NIS	56	}
	57
	58	SV *
	59	PerlIOVia_method(pTHX_ PerlIO f,char method,CV **save,int flags,...)
	60	{
	61	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	62	CV cv = (save) ? *save : PerlIOVia_fetchmethod(aTHX_ s,method,save);
	63	SV *result = Nullsv;
	64	va_list ap;
	65	va_start(ap,flags);
	66	if (cv != (CV *)-1)
	67	{
	68	IV count;
	69	dSP;
	70	SV *arg;
e7a1fdd7 NIS	71	ENTER;
	72	PUSHMARK(sp);
	73	XPUSHs(s->obj);
	74	while ((arg = va_arg(ap,SV *)))
	75	{
	76	XPUSHs(arg);
	77	}
	78	if (*PerlIONext(f))
	79	{
	80	if (!s->fh)
	81	{
	82	GV *gv = newGVgen(HvNAME(s->stash));
	83	GvIOp(gv) = newIO();
	84	s->fh = newRV_noinc((SV *)gv);
	85	s->io = GvIOp(gv);
	86	}
	87	IoIFP(s->io) = PerlIONext(f);
	88	IoOFP(s->io) = PerlIONext(f);
	89	XPUSHs(s->fh);
	90	}
	91	PUTBACK;
	92	count = call_sv((SV *)cv,flags);
	93	if (count)
	94	{
	95	SPAGAIN;
	96	result = POPs;
	97	PUTBACK;
	98	}
	99	else
	100	{
	101	result = &PL_sv_undef;
	102	}
	103	LEAVE;
	104	}
	105	va_end(ap);
	106	return result;
	107	}
	108
	109	IV
f62ce20a	110	PerlIOVia_pushed(pTHX_ PerlIO f, const char mode, SV *arg)
e7a1fdd7	111	{
f62ce20a	112	IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
e7a1fdd7 NIS	113	if (code == 0)
e7a1fdd7 NIS	114	{
e7a1fdd7 NIS	115	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	116	if (!arg)
	117	{
	118	Perl_warn(aTHX_ "No package specified");
	119	code = -1;
	120	}
	121	else
	122	{
	123	STRLEN pkglen = 0;
	124	char *pkg = SvPV(arg,pkglen);
267cbce7	125	s->obj = SvREFCNT_inc(arg);
e7a1fdd7 NIS	126	s->stash = gv_stashpvn(pkg, pkglen, FALSE);
	127	if (s->stash)
	128	{
	129	SV *modesv = (mode) ? sv_2mortal(newSVpvn(mode,strlen(mode))) : Nullsv;
	130	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(PUSHED),G_SCALAR,modesv,Nullsv);
	131	if (result)
	132	{
	133	if (sv_isobject(result))
267cbce7 NIS	134	{
	135	s->obj = SvREFCNT_inc(result);
	136	SvREFCNT_dec(arg);
	137	}
e7a1fdd7 NIS	138	else if (SvIV(result) != 0)
	139	return SvIV(result);
	140	}
	141	if (PerlIOVia_fetchmethod(aTHX_ s,MYMethod(FILL)) == (CV *) -1)
	142	PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
	143	else
	144	PerlIOBase(f)->flags \|= PERLIO_F_FASTGETS;
	145	}
	146	else
	147	{
	148	Perl_warn(aTHX_ "Cannot find package '%.*s'",(int) pkglen,pkg);
267cbce7 NIS	149	#ifdef ENOSYS
	150	errno = ENOSYS;
	151	#else
	152	#ifdef ENOENT
	153	errno = ENOENT;
	154	#endif
	155	#endif
e7a1fdd7 NIS	156	code = -1;
	157	}
	158	}
	159	}
	160	return code;
	161	}
	162
	163	PerlIO *
fcf2db38	164	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)
e7a1fdd7 NIS	165	{
	166	if (!f)
	167	{
	168	f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX),self,mode,PerlIOArg);
	169	}
	170	else
	171	{
	172	if (!PerlIO_push(aTHX_ f,self,mode,PerlIOArg))
	173	return NULL;
	174	}
	175	if (f)
	176	{
	177	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	178	SV *result = Nullsv;
	179	if (fd >= 0)
	180	{
	181	SV *fdsv = sv_2mortal(newSViv(fd));
	182	result = PerlIOVia_method(aTHX_ f,MYMethod(FDOPEN),G_SCALAR,fdsv,Nullsv);
	183	}
	184	else if (narg > 0)
	185	{
	186	if (*mode == '#')
	187	{
	188	SV *imodesv = sv_2mortal(newSViv(imode));
	189	SV *permsv = sv_2mortal(newSViv(perm));
	190	result = PerlIOVia_method(aTHX_ f,MYMethod(SYSOPEN),G_SCALAR,*args,imodesv,permsv,Nullsv);
	191	}
	192	else
	193	{
	194	result = PerlIOVia_method(aTHX_ f,MYMethod(OPEN),G_SCALAR,*args,Nullsv);
	195	}
	196	}
	197	if (result)
	198	{
	199	if (sv_isobject(result))
	200	s->obj = SvREFCNT_inc(result);
	201	else if (!SvTRUE(result))
	202	{
	203	return NULL;
	204	}
	205	}
	206	else
	207	return NULL;
	208	}
	209	return f;
	210	}
	211
	212	IV
f62ce20a	213	PerlIOVia_popped(pTHX_ PerlIO *f)
e7a1fdd7	214	{
e7a1fdd7 NIS	215	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	216	PerlIOVia_method(aTHX_ f,MYMethod(POPPED),G_VOID,Nullsv);
	217	if (s->var)
	218	{
	219	SvREFCNT_dec(s->var);
	220	s->var = Nullsv;
	221	}
	222
	223	if (s->io)
	224	{
	225	IoIFP(s->io) = NULL;
	226	IoOFP(s->io) = NULL;
	227	}
	228	if (s->fh)
	229	{
	230	SvREFCNT_dec(s->fh);
	231	s->fh = Nullsv;
	232	s->io = NULL;
	233	}
	234	if (s->obj)
	235	{
	236	SvREFCNT_dec(s->obj);
	237	s->obj = Nullsv;
	238	}
	239	return 0;
	240	}
	241
	242	IV
f62ce20a	243	PerlIOVia_close(pTHX_ PerlIO *f)
e7a1fdd7	244	{
e7a1fdd7	245	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
f62ce20a	246	IV code = PerlIOBase_close(aTHX_ f);
e7a1fdd7 NIS	247	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(CLOSE),G_SCALAR,Nullsv);
	248	if (result && SvIV(result) != 0)
	249	code = SvIV(result);
	250	PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF\|PERLIO_F_WRBUF);
	251	return code;
	252	}
	253
	254	IV
f62ce20a	255	PerlIOVia_fileno(pTHX_ PerlIO *f)
e7a1fdd7	256	{
e7a1fdd7 NIS	257	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	258	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILENO),G_SCALAR,Nullsv);
	259	return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
	260	}
	261
	262	IV
f62ce20a	263	PerlIOVia_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
e7a1fdd7	264	{
e7a1fdd7 NIS	265	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
e7a1fdd7 NIS	266	SV *offsv = sv_2mortal(newSViv(offset));
9f16d962	267	SV *whsv = sv_2mortal(newSViv(whence));
e7a1fdd7 NIS	268	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(SEEK),G_SCALAR,offsv,whsv,Nullsv);
	269	return (result) ? SvIV(result) : -1;
	270	}
	271
	272	Off_t
f62ce20a	273	PerlIOVia_tell(pTHX_ PerlIO *f)
e7a1fdd7	274	{
e7a1fdd7 NIS	275	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
e7a1fdd7 NIS	276	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(TELL),G_SCALAR,Nullsv);
9f16d962	277	return (result) ? (Off_t) SvIV(result) : (Off_t) -1;
e7a1fdd7 NIS	278	}
	279
	280	SSize_t
f62ce20a	281	PerlIOVia_unread(pTHX_ PerlIO f, const void vbuf, Size_t count)
e7a1fdd7	282	{
e7a1fdd7 NIS	283	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	284	SV buf = sv_2mortal(newSVpvn((char )vbuf,count));
	285	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(UNREAD),G_SCALAR,buf,Nullsv);
	286	if (result)
	287	return (SSize_t) SvIV(result);
	288	else
	289	{
f62ce20a	290	return PerlIOBase_unread(aTHX_ f,vbuf,count);
e7a1fdd7 NIS	291	}
	292	}
	293
	294	SSize_t
f62ce20a	295	PerlIOVia_read(pTHX_ PerlIO f, void vbuf, Size_t count)
e7a1fdd7 NIS	296	{
	297	SSize_t rd = 0;
	298	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	299	{
	300	if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)
	301	{
f62ce20a	302	rd = PerlIOBase_read(aTHX_ f,vbuf,count);
e7a1fdd7 NIS	303	}
	304	else
	305	{
e7a1fdd7 NIS	306	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	307	SV *buf = sv_2mortal(newSV(count));
	308	SV *n = sv_2mortal(newSViv(count));
	309	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(READ),G_SCALAR,buf,n,Nullsv);
	310	if (result)
	311	{
	312	rd = (SSize_t) SvIV(result);
	313	Move(SvPVX(buf),vbuf,rd,char);
	314	return rd;
	315	}
	316	}
	317	}
	318	return rd;
	319	}
	320
	321	SSize_t
f62ce20a	322	PerlIOVia_write(pTHX_ PerlIO f, const void vbuf, Size_t count)
e7a1fdd7 NIS	323	{
	324	if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
	325	{
e7a1fdd7 NIS	326	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	327	SV buf = newSVpvn((char )vbuf,count);
	328	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(WRITE),G_SCALAR,buf,Nullsv);
	329	SvREFCNT_dec(buf);
	330	if (result)
	331	return (SSize_t) SvIV(result);
	332	return -1;
	333	}
	334	return 0;
	335	}
	336
	337	IV
f62ce20a	338	PerlIOVia_fill(pTHX_ PerlIO *f)
e7a1fdd7 NIS	339	{
	340	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	341	{
e7a1fdd7 NIS	342	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	343	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILL),G_SCALAR,Nullsv);
	344	if (s->var)
	345	{
	346	SvREFCNT_dec(s->var);
	347	s->var = Nullsv;
	348	}
	349	if (result && SvOK(result))
	350	{
	351	STRLEN len = 0;
	352	char *p = SvPV(result,len);
	353	s->var = newSVpvn(p,len);
	354	s->cnt = SvCUR(s->var);
	355	return 0;
	356	}
	357	else
	358	PerlIOBase(f)->flags \|= PERLIO_F_EOF;
	359	}
	360	return -1;
	361	}
	362
	363	IV
f62ce20a	364	PerlIOVia_flush(pTHX_ PerlIO *f)
e7a1fdd7	365	{
e7a1fdd7 NIS	366	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	367	SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FLUSH),G_SCALAR,Nullsv);
	368	if (s->var && s->cnt > 0)
	369	{
	370	SvREFCNT_dec(s->var);
	371	s->var = Nullsv;
	372	}
	373	return (result) ? SvIV(result) : 0;
	374	}
	375
	376	STDCHAR *
f62ce20a	377	PerlIOVia_get_base(pTHX_ PerlIO *f)
e7a1fdd7 NIS	378	{
	379	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	380	{
e7a1fdd7 NIS	381	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	382	if (s->var)
	383	{
	384	return (STDCHAR *)SvPVX(s->var);
	385	}
	386	}
	387	return (STDCHAR *) Nullch;
	388	}
	389
	390	STDCHAR *
f62ce20a	391	PerlIOVia_get_ptr(pTHX_ PerlIO *f)
e7a1fdd7 NIS	392	{
	393	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	394	{
	395	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	396	if (s->var)
	397	{
e7a1fdd7 NIS	398	STDCHAR p = (STDCHAR )(SvEND(s->var) - s->cnt);
	399	return p;
	400	}
	401	}
	402	return (STDCHAR *) Nullch;
	403	}
	404
	405	SSize_t
f62ce20a	406	PerlIOVia_get_cnt(pTHX_ PerlIO *f)
e7a1fdd7 NIS	407	{
	408	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	409	{
	410	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	411	if (s->var)
	412	{
	413	return s->cnt;
	414	}
	415	}
	416	return 0;
	417	}
	418
	419	Size_t
f62ce20a	420	PerlIOVia_bufsiz(pTHX_ PerlIO *f)
e7a1fdd7 NIS	421	{
	422	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
	423	{
	424	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	425	if (s->var)
	426	return SvCUR(s->var);
	427	}
	428	return 0;
	429	}
	430
	431	void
f62ce20a	432	PerlIOVia_set_ptrcnt(pTHX_ PerlIO f, STDCHAR ptr, SSize_t cnt)
e7a1fdd7 NIS	433	{
	434	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	435	s->cnt = cnt;
	436	}
	437
	438	void
f62ce20a	439	PerlIOVia_setlinebuf(pTHX_ PerlIO *f)
e7a1fdd7	440	{
e7a1fdd7 NIS	441	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
e7a1fdd7 NIS	442	PerlIOVia_method(aTHX_ f,MYMethod(SETLINEBUF),G_VOID,Nullsv);
f62ce20a	443	PerlIOBase_setlinebuf(aTHX_ f);
e7a1fdd7 NIS	444	}
	445
	446	void
f62ce20a	447	PerlIOVia_clearerr(pTHX_ PerlIO *f)
e7a1fdd7	448	{
e7a1fdd7 NIS	449	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
e7a1fdd7 NIS	450	PerlIOVia_method(aTHX_ f,MYMethod(CLEARERR),G_VOID,Nullsv);
f62ce20a	451	PerlIOBase_clearerr(aTHX_ f);
e7a1fdd7 NIS	452	}
e7a1fdd7 NIS	453
c7997937	454	IV
f62ce20a	455	PerlIOVia_error(pTHX_ PerlIO *f)
e7a1fdd7	456	{
e7a1fdd7	457	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
c7997937	458	SV *result = PerlIOVia_method(aTHX_ f,"ERROR",&s->mERROR,G_SCALAR,Nullsv);
f62ce20a	459	return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
e7a1fdd7 NIS	460	}
	461
	462	IV
f62ce20a	463	PerlIOVia_eof(pTHX_ PerlIO *f)
e7a1fdd7	464	{
e7a1fdd7 NIS	465	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
e7a1fdd7 NIS	466	SV *result = PerlIOVia_method(aTHX_ f,"EOF",&s->mEOF,G_SCALAR,Nullsv);
f62ce20a	467	return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f);
e7a1fdd7 NIS	468	}
e7a1fdd7 NIS	469
ecdeb87c NIS	470	SV *
	471	PerlIOVia_getarg(pTHX_ PerlIO f, CLONE_PARAMS param, int flags)
	472	{
	473	PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
	474	return PerlIOVia_method(aTHX_ f,MYMethod(GETARG),G_SCALAR,Nullsv);
	475	}
	476
8cf8f3d1	477	PerlIO *
ecdeb87c	478	PerlIOVia_dup(pTHX_ PerlIO f, PerlIO o, CLONE_PARAMS *param, int flags)
8cf8f3d1	479	{
ecdeb87c	480	if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)))
9f16d962	481	{
ecdeb87c	482	/* Most of the fields will lazily set themselves up as needed
9f16d962 NIS	483	stash and obj have been set up by the implied push
	484	*/
	485	}
	486	return f;
8cf8f3d1 NIS	487	}
8cf8f3d1 NIS	488
e7a1fdd7 NIS	489	PerlIO_funcs PerlIO_object = {
	490	"Via",
	491	sizeof(PerlIOVia),
	492	PERLIO_K_BUFFERED\|PERLIO_K_DESTRUCT,
	493	PerlIOVia_pushed,
	494	PerlIOVia_popped,
	495	NULL, /* PerlIOVia_open, */
	496	PerlIOVia_getarg,
	497	PerlIOVia_fileno,
8cf8f3d1	498	PerlIOVia_dup,
e7a1fdd7 NIS	499	PerlIOVia_read,
	500	PerlIOVia_unread,
	501	PerlIOVia_write,
	502	PerlIOVia_seek,
	503	PerlIOVia_tell,
	504	PerlIOVia_close,
	505	PerlIOVia_flush,
	506	PerlIOVia_fill,
	507	PerlIOVia_eof,
	508	PerlIOVia_error,
	509	PerlIOVia_clearerr,
	510	PerlIOVia_setlinebuf,
	511	PerlIOVia_get_base,
	512	PerlIOVia_bufsiz,
	513	PerlIOVia_get_ptr,
	514	PerlIOVia_get_cnt,
	515	PerlIOVia_set_ptrcnt,
	516	};
	517
	518
	519	#endif /* Layers available */
	520
	521	MODULE = PerlIO::Via PACKAGE = PerlIO::Via
	522	PROTOTYPES: ENABLE;
	523
	524	BOOT:
	525	{
	526	#ifdef PERLIO_LAYERS
	527	PerlIO_define_layer(aTHX_ &PerlIO_object);
	528	#endif
	529	}
	530