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;
    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;
    35			 CV *mERROR;
    36			 CV *mEOF;
    37			 CV *BINMODE;
    38			 CV *UTF8;
    39			} PerlIOVia;
    40			
    41			#define MYMethod(x) #x,&s->x
    42			
    43			CV *
    44			PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
    45	          53    {
    46	          53        GV *gv = gv_fetchmeth(s->stash, method, strlen(method), 0);
    47			#if 0
    48			    Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME_get(s->stash), method, gv);
    49			#endif
    50	          53        if (gv) {
    51	          14    	return *save = GvCV(gv);
    52			    }
    53			    else {
    54	          39    	return *save = (CV *) - 1;
    55			    }
    56			}
    57			
    58			/*
    59			 * Try and call method, possibly via cached lookup.
    60			 * If method does not exist return Nullsv (caller may fallback to another approach
    61			 * If method does exist call it with flags passing variable number of args
    62			 * Last arg is a "filehandle" to layer below (if present)
    63			 * Returns scalar returned by method (if any) otherwise sv_undef
    64			 */
    65			
    66			SV *
    67			PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
    68					 ...)
    69	          57    {
    70	          57        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
    71	          57        CV *cv =
    72	          57    	(*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s, method, save);
    73	          57        SV *result = Nullsv;
    74	          57        va_list ap;
    75	          57        va_start(ap, flags);
    76	          57        if (cv != (CV *) - 1) {
    77	          15    	IV count;
    78	          15    	dSP;
    79	          15    	SV *arg;
    80	          15    	PUSHSTACKi(PERLSI_MAGIC);
    81	          15    	ENTER;
    82	          15    	SPAGAIN;
    83	          15    	PUSHMARK(sp);
    84	          15    	XPUSHs(s->obj);
    85	          24    	while ((arg = va_arg(ap, SV *))) {
    86	           9    	    XPUSHs(arg);
    87				}
    88	          15    	if (*PerlIONext(f)) {
    89	           8    	    if (!s->fh) {
    90	           4    		GV *gv = newGVgen(HvNAME_get(s->stash));
    91	           4    		GvIOp(gv) = newIO();
    92	           4    		s->fh = newRV_noinc((SV *) gv);
    93	           4    		s->io = GvIOp(gv);
    94				    }
    95	           8    	    IoIFP(s->io) = PerlIONext(f);
    96	           8    	    IoOFP(s->io) = PerlIONext(f);
    97	           8    	    XPUSHs(s->fh);
    98				}
    99				else {
   100	           7    	    PerlIO_debug("No next\n");
   101				    /* FIXME: How should this work for OPEN etc? */
   102				}
   103	          15    	PUTBACK;
   104	          15    	count = call_sv((SV *) cv, flags);
   105	          15    	if (count) {
   106	          15    	    SPAGAIN;
   107	          15    	    result = POPs;
   108	          15    	    PUTBACK;
   109				}
   110				else {
   111	      ######    	    result = &PL_sv_undef;
   112				}
   113	          15    	LEAVE;
   114	          15    	POPSTACK;
   115			    }
   116	          57        va_end(ap);
   117	          57        return result;
   118			}
   119			
   120			IV
   121			PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
   122					 PerlIO_funcs * tab)
   123	          10    {
   124	          10        IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
   125	          10        if (code == 0) {
   126	          10    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   127	          10    	if (!arg) {
   128	      ######    	    if (ckWARN(WARN_LAYER))
   129	      ######    		Perl_warner(aTHX_ packWARN(WARN_LAYER),
   130						    "No package specified");
   131	      ######    	    errno = EINVAL;
   132	      ######    	    code = -1;
   133				}
   134				else {
   135	          10    	    STRLEN pkglen = 0;
   136	          10    	    const char *pkg = SvPV(arg, pkglen);
   137	          10    	    s->obj = SvREFCNT_inc(arg);
   138	          10    	    s->stash = gv_stashpvn(pkg, pkglen, FALSE);
   139	          10    	    if (!s->stash) {
   140	           4    		s->obj =
   141					    newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg),
   142						     pkglen + 13);
   143	           4    		SvREFCNT_dec(arg);
   144	           4    		s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, FALSE);
   145				    }
   146	          10    	    if (s->stash) {
   147	           8    		char lmode[8];
   148	           8    		SV *modesv;
   149	           8    		SV *result;
   150	           8    		if (!mode) {
   151					    /* binmode() passes NULL - so find out what mode is */
   152	      ######    		    mode = PerlIO_modestr(f,lmode);
   153					}
   154	           8    		modesv = sv_2mortal(newSVpvn(mode, strlen(mode)));
   155	           8    		result = PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR,
   156							     modesv, Nullsv);
   157	           8    		if (result) {
   158	           7    		    if (sv_isobject(result)) {
   159	           5    			s->obj = SvREFCNT_inc(result);
   160	           5    			SvREFCNT_dec(arg);
   161					    }
   162	           2    		    else if (SvIV(result) != 0)
   163	           2    			return SvIV(result);
   164					}
   165					else {
   166	           5    		    goto push_failed;
   167					}
   168	           5    		modesv = (*PerlIONext(f) && (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_UTF8))
   169			                           ? &PL_sv_yes : &PL_sv_no;
   170	           5    		result = PerlIOVia_method(aTHX_ f, MYMethod(UTF8), G_SCALAR, modesv, Nullsv);
   171	           5    		if (result && SvTRUE(result)) {
   172	      ######    		    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
   173					}
   174					else {
   175	           5    		    PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
   176					}
   177	           5    		if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) ==
   178					    (CV *) - 1)
   179	      ######    		    PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
   180					else
   181	           5    		    PerlIOBase(f)->flags |= PERLIO_F_FASTGETS;
   182				    }
   183				    else {
   184	           2    		if (ckWARN(WARN_LAYER))
   185	           1    		    Perl_warner(aTHX_ packWARN(WARN_LAYER),
   186							"Cannot find package '%.*s'", (int) pkglen,
   187							pkg);
   188			push_failed:
   189			#ifdef ENOSYS
   190	           3    		errno = ENOSYS;
   191			#else
   192			#ifdef ENOENT
   193					errno = ENOENT;
   194			#endif
   195			#endif
   196	           3    		code = -1;
   197				    }
   198				}
   199			    }
   200	           8        return code;
   201			}
   202			
   203			PerlIO *
   204			PerlIOVia_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers,
   205				       IV n, const char *mode, int fd, int imode, int perm,
   206				       PerlIO * f, int narg, SV ** args)
   207	          10    {
   208	          10        if (!f) {
   209	          10    	f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX), self, mode,
   210						PerlIOArg);
   211			    }
   212			    else {
   213				/* Reopen */
   214	      ######    	if (!PerlIO_push(aTHX_ f, self, mode, PerlIOArg))
   215	      ######    	    return NULL;
   216			    }
   217	          10        if (f) {
   218	           5    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   219	           5    	SV *result = Nullsv;
   220	           5    	if (fd >= 0) {
   221	      ######    	    SV *fdsv = sv_2mortal(newSViv(fd));
   222	      ######    	    result =
   223					PerlIOVia_method(aTHX_ f, MYMethod(FDOPEN), G_SCALAR, fdsv,
   224							 Nullsv);
   225				}
   226	           5    	else if (narg > 0) {
   227	           5    	    if (*mode == '#') {
   228	      ######    		SV *imodesv = sv_2mortal(newSViv(imode));
   229	      ######    		SV *permsv = sv_2mortal(newSViv(perm));
   230	      ######    		result =
   231					    PerlIOVia_method(aTHX_ f, MYMethod(SYSOPEN), G_SCALAR,
   232							     *args, imodesv, permsv, Nullsv);
   233				    }
   234				    else {
   235	           5    		result =
   236					    PerlIOVia_method(aTHX_ f, MYMethod(OPEN), G_SCALAR,
   237							     *args, Nullsv);
   238				    }
   239				}
   240	           5    	if (result) {
   241	      ######    	    if (sv_isobject(result))
   242	      ######    		s->obj = SvREFCNT_inc(result);
   243	      ######    	    else if (!SvTRUE(result)) {
   244	      ######    		return NULL;
   245				    }
   246				}
   247				else {
   248				    /* Required open method not present */
   249	           5    	    PerlIO_funcs *tab = NULL;
   250	           5    	    IV m = n - 1;
   251	           5    	    while (m >= 0) {
   252	           5    		PerlIO_funcs *t =
   253	           5    		    PerlIO_layer_fetch(aTHX_ layers, m, NULL);
   254	           5    		if (t && t->Open) {
   255	           5    		    tab = t;
   256	           5    		    break;
   257					}
   258	      ######    		m--;
   259				    }
   260	           5    	    if (tab) {
   261	           5    		if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode,
   262							  perm, PerlIONext(f), narg, args)) {
   263	           4    		    PerlIO_debug("Opened with %s => %p->%p\n", tab->name,
   264							 PerlIONext(f), *PerlIONext(f));
   265	           4    		    if (m + 1 < n) {
   266						/*
   267						 * More layers above the one that we used to open -
   268						 * apply them now
   269						 */
   270	      ######    			if (PerlIO_apply_layera
   271						    (aTHX_ PerlIONext(f), mode, layers, m + 1,
   272						     n) != 0) {
   273						    /* If pushing layers fails close the file */
   274	      ######    			    PerlIO_close(f);
   275	      ######    			    f = NULL;
   276						}
   277					    }
   278					    /* FIXME - Call an OPENED method here ? */
   279	           4    		    return f;
   280					}
   281					else {
   282	           1    		    PerlIO_debug("Open fail %s => %p->%p\n", tab->name,
   283							 PerlIONext(f), *PerlIONext(f));
   284					    /* Sub-layer open failed */
   285					}
   286				    }
   287				    else {
   288	      ######    	         PerlIO_debug("Nothing to open with");
   289					/* Nothing to do the open */
   290				    }
   291	           1    	    PerlIO_pop(aTHX_ f);
   292	           1    	    return NULL;
   293				}
   294			    }
   295	           5        return f;
   296			}
   297			
   298			IV
   299			PerlIOVia_popped(pTHX_ PerlIO * f)
   300	          10    {
   301	          10        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   302	          10        PerlIOVia_method(aTHX_ f, MYMethod(POPPED), G_VOID, Nullsv);
   303	          10        if (s->var) {
   304	      ######    	SvREFCNT_dec(s->var);
   305	      ######    	s->var = Nullsv;
   306			    }
   307			
   308	          10        if (s->io) {
   309	           4    	IoIFP(s->io) = NULL;
   310	           4    	IoOFP(s->io) = NULL;
   311			    }
   312	          10        if (s->fh) {
   313	           4    	SvREFCNT_dec(s->fh);
   314	           4    	s->fh = Nullsv;
   315	           4    	s->io = NULL;
   316			    }
   317	          10        if (s->obj) {
   318	          10    	SvREFCNT_dec(s->obj);
   319	          10    	s->obj = Nullsv;
   320			    }
   321	          10        return 0;
   322			}
   323			
   324			IV
   325			PerlIOVia_close(pTHX_ PerlIO * f)
   326	           4    {
   327	           4        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   328	           4        IV code = PerlIOBase_close(aTHX_ f);
   329	           4        SV *result =
   330	           4    	PerlIOVia_method(aTHX_ f, MYMethod(CLOSE), G_SCALAR, Nullsv);
   331	           4        if (result && SvIV(result) != 0)
   332	      ######    	code = SvIV(result);
   333	           4        PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
   334	           4        return code;
   335			}
   336			
   337			IV
   338			PerlIOVia_fileno(pTHX_ PerlIO * f)
   339	           5    {
   340	           5        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   341	           5        SV *result =
   342	           5    	PerlIOVia_method(aTHX_ f, MYMethod(FILENO), G_SCALAR, Nullsv);
   343	           5        return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
   344			}
   345			
   346			IV
   347			PerlIOVia_binmode(pTHX_ PerlIO * f)
   348	      ######    {
   349	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   350	      ######        SV *result =
   351	      ######    	PerlIOVia_method(aTHX_ f, MYMethod(BINMODE), G_SCALAR, Nullsv);
   352	      ######        if (!result || !SvOK(result)) {
   353	      ######    	PerlIO_pop(aTHX_ f);
   354	      ######    	return 0;
   355			    }
   356	      ######        return SvIV(result);
   357			}
   358			
   359			IV
   360			PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
   361	      ######    {
   362	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   363	      ######        SV *offsv = sv_2mortal(sizeof(Off_t) > sizeof(IV)
   364	      ######    			   ? newSVnv((NV)offset) : newSViv((IV)offset));
   365	      ######        SV *whsv = sv_2mortal(newSViv(whence));
   366	      ######        SV *result =
   367				PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv,
   368	      ######    			 Nullsv);
   369			#if Off_t_size == 8 && defined(CONDOP_SIZE) && CONDOP_SIZE < Off_t_size
   370			    if (result)
   371				return (Off_t) SvIV(result);
   372			    else
   373				return (Off_t) -1;
   374			#else
   375	      ######        return (result) ? SvIV(result) : -1;
   376			#endif
   377			}
   378			
   379			Off_t
   380			PerlIOVia_tell(pTHX_ PerlIO * f)
   381	           1    {
   382	           1        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   383	           1        SV *result =
   384	           1    	PerlIOVia_method(aTHX_ f, MYMethod(TELL), G_SCALAR, Nullsv);
   385	           1        return (result)
   386				   ? (SvNOK(result) ? (Off_t)SvNV(result) : (Off_t)SvIV(result))
   387				   : (Off_t) - 1;
   388			}
   389			
   390			SSize_t
   391			PerlIOVia_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
   392	      ######    {
   393	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   394	      ######        SV *buf = sv_2mortal(newSVpvn((char *) vbuf, count));
   395	      ######        SV *result =
   396	      ######    	PerlIOVia_method(aTHX_ f, MYMethod(UNREAD), G_SCALAR, buf, Nullsv);
   397	      ######        if (result)
   398	      ######    	return (SSize_t) SvIV(result);
   399			    else {
   400	      ######    	return PerlIOBase_unread(aTHX_ f, vbuf, count);
   401			    }
   402			}
   403			
   404			SSize_t
   405			PerlIOVia_read(pTHX_ PerlIO * f, void *vbuf, Size_t count)
   406	           6    {
   407	           6        SSize_t rd = 0;
   408	           6        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   409	           6    	if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
   410	           6    	    rd = PerlIOBase_read(aTHX_ f, vbuf, count);
   411				}
   412				else {
   413	      ######    	    PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   414	      ######    	    SV *buf = sv_2mortal(newSV(count));
   415	      ######    	    SV *n = sv_2mortal(newSViv(count));
   416	      ######    	    SV *result =
   417					PerlIOVia_method(aTHX_ f, MYMethod(READ), G_SCALAR, buf, n,
   418	      ######    				 Nullsv);
   419	      ######    	    if (result) {
   420	      ######    		rd = (SSize_t) SvIV(result);
   421	      ######    		Move(SvPVX(buf), vbuf, rd, char);
   422	      ######    		return rd;
   423				    }
   424				}
   425			    }
   426	           6        return rd;
   427			}
   428			
   429			SSize_t
   430			PerlIOVia_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
   431	           2    {
   432	           2        if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
   433	           2    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   434	           2    	SV *buf = newSVpvn((char *) vbuf, count);
   435	           2    	SV *result =
   436				    PerlIOVia_method(aTHX_ f, MYMethod(WRITE), G_SCALAR, buf,
   437	           2    			     Nullsv);
   438	           2    	SvREFCNT_dec(buf);
   439	           2    	if (result)
   440	           2    	    return (SSize_t) SvIV(result);
   441	      ######    	return -1;
   442			    }
   443	      ######        return 0;
   444			}
   445			
   446			IV
   447			PerlIOVia_fill(pTHX_ PerlIO * f)
   448	           6    {
   449	           6        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   450	           6    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   451	           6    	SV *result =
   452	           6    	    PerlIOVia_method(aTHX_ f, MYMethod(FILL), G_SCALAR, Nullsv);
   453	           6    	if (s->var) {
   454	           4    	    SvREFCNT_dec(s->var);
   455	           4    	    s->var = Nullsv;
   456				}
   457	           6    	if (result && SvOK(result)) {
   458	           4    	    STRLEN len = 0;
   459	           4    	    const char *p = SvPV(result, len);
   460	           4    	    s->var = newSVpvn(p, len);
   461	           4    	    s->cnt = SvCUR(s->var);
   462	           4    	    return 0;
   463				}
   464				else
   465	           2    	    PerlIOBase(f)->flags |= PERLIO_F_EOF;
   466			    }
   467	           2        return -1;
   468			}
   469			
   470			IV
   471			PerlIOVia_flush(pTHX_ PerlIO * f)
   472	           4    {
   473	           4        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   474	           4        SV *result =
   475	           4    	PerlIOVia_method(aTHX_ f, MYMethod(FLUSH), G_SCALAR, Nullsv);
   476	           4        if (s->var && s->cnt > 0) {
   477	      ######    	SvREFCNT_dec(s->var);
   478	      ######    	s->var = Nullsv;
   479			    }
   480	           4        return (result) ? SvIV(result) : 0;
   481			}
   482			
   483			STDCHAR *
   484			PerlIOVia_get_base(pTHX_ PerlIO * f)
   485	      ######    {
   486	      ######        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   487	      ######    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   488	      ######    	if (s->var) {
   489	      ######    	    return (STDCHAR *) SvPVX(s->var);
   490				}
   491			    }
   492	      ######        return (STDCHAR *) Nullch;
   493			}
   494			
   495			STDCHAR *
   496			PerlIOVia_get_ptr(pTHX_ PerlIO * f)
   497	          14    {
   498	          14        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   499	          14    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   500	          14    	if (s->var) {
   501	          10    	    STDCHAR *p = (STDCHAR *) (SvEND(s->var) - s->cnt);
   502	          10    	    return p;
   503				}
   504			    }
   505	           4        return (STDCHAR *) Nullch;
   506			}
   507			
   508			SSize_t
   509			PerlIOVia_get_cnt(pTHX_ PerlIO * f)
   510	          20    {
   511	          20        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   512	          20    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   513	          20    	if (s->var) {
   514	          14    	    return s->cnt;
   515				}
   516			    }
   517	           6        return 0;
   518			}
   519			
   520			Size_t
   521			PerlIOVia_bufsiz(pTHX_ PerlIO * f)
   522	      ######    {
   523	      ######        if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
   524	      ######    	PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   525	      ######    	if (s->var)
   526	      ######    	    return SvCUR(s->var);
   527			    }
   528	      ######        return 0;
   529			}
   530			
   531			void
   532			PerlIOVia_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
   533	          14    {
   534	          14        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   535	          14        s->cnt = cnt;
   536			}
   537			
   538			void
   539			PerlIOVia_setlinebuf(pTHX_ PerlIO * f)
   540	      ######    {
   541	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   542	      ######        PerlIOVia_method(aTHX_ f, MYMethod(SETLINEBUF), G_VOID, Nullsv);
   543	      ######        PerlIOBase_setlinebuf(aTHX_ f);
   544			}
   545			
   546			void
   547			PerlIOVia_clearerr(pTHX_ PerlIO * f)
   548	           1    {
   549	           1        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   550	           1        PerlIOVia_method(aTHX_ f, MYMethod(CLEARERR), G_VOID, Nullsv);
   551	           1        PerlIOBase_clearerr(aTHX_ f);
   552			}
   553			
   554			IV
   555			PerlIOVia_error(pTHX_ PerlIO * f)
   556	           6    {
   557	           6        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   558	           6        SV *result =
   559	           6    	PerlIOVia_method(aTHX_ f, "ERROR", &s->mERROR, G_SCALAR, Nullsv);
   560	           6        return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
   561			}
   562			
   563			IV
   564			PerlIOVia_eof(pTHX_ PerlIO * f)
   565	      ######    {
   566	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   567	      ######        SV *result =
   568	      ######    	PerlIOVia_method(aTHX_ f, "EOF", &s->mEOF, G_SCALAR, Nullsv);
   569	      ######        return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f);
   570			}
   571			
   572			SV *
   573			PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
   574	      ######    {
   575	      ######        PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
   576	      ######        return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
   577			}
   578			
   579			PerlIO *
   580			PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
   581				      int flags)
   582	      ######    {
   583	      ######        if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
   584				/* Most of the fields will lazily set themselves up as needed
   585				   stash and obj have been set up by the implied push
   586				 */
   587			    }
   588	      ######        return f;
   589			}
   590			
   591			
   592			
   593			PERLIO_FUNCS_DECL(PerlIO_object) = {
   594			 sizeof(PerlIO_funcs),
   595			 "via",
   596			 sizeof(PerlIOVia),
   597			 PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
   598			 PerlIOVia_pushed,
   599			 PerlIOVia_popped,
   600			 PerlIOVia_open, /* NULL, */
   601			 PerlIOVia_binmode, /* NULL, */
   602			 PerlIOVia_getarg,
   603			 PerlIOVia_fileno,
   604			 PerlIOVia_dup,
   605			 PerlIOVia_read,
   606			 PerlIOVia_unread,
   607			 PerlIOVia_write,
   608			 PerlIOVia_seek,
   609			 PerlIOVia_tell,
   610			 PerlIOVia_close,
   611			 PerlIOVia_flush,
   612			 PerlIOVia_fill,
   613			 PerlIOVia_eof,
   614			 PerlIOVia_error,
   615			 PerlIOVia_clearerr,
   616			 PerlIOVia_setlinebuf,
   617			 PerlIOVia_get_base,
   618			 PerlIOVia_bufsiz,
   619			 PerlIOVia_get_ptr,
   620			 PerlIOVia_get_cnt,
   621			 PerlIOVia_set_ptrcnt,
   622			};
   623			
   624			
   625			#endif /* Layers available */
   626			
   627			MODULE = PerlIO::via	PACKAGE = PerlIO::via
   628			PROTOTYPES: ENABLE;
   629			
   630			BOOT:
   631			{
   632			#ifdef PERLIO_LAYERS
   633	           2     PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
   634			#endif
   635			}
   636			
   637			
   638			
   639			
   640			
   641