File Coverage

ext/PerlIO-via/via.xs
Criterion Covered Total %
statement 197 283 69.6
branch n/a
condition n/a
subroutine n/a
total 197 283 69.6


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