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
CommitLineData
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
9typedef 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 36 CV *mEOF;
86e05cf2 37 CV *BINMODE;
802588c3 38 CV *UTF8;
e7a1fdd7
NIS
39} PerlIOVia;
40
41#define MYMethod(x) #x,&s->x
42
43CV *
fc040538 44PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
e7a1fdd7 45{
fc040538 46 GV *gv = gv_fetchmeth(s->stash, method, strlen(method), 0);
e7a1fdd7 47#if 0
bfcb3514 48 Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME_get(s->stash), method, gv);
e7a1fdd7 49#endif
fc040538
NIS
50 if (gv) {
51 return *save = GvCV(gv);
52 }
53 else {
54 return *save = (CV *) - 1;
55 }
e7a1fdd7
NIS
56}
57
d9dac8cd
NIS
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
e7a1fdd7 66SV *
fc040538
NIS
67PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
68 ...)
e7a1fdd7 69{
fc040538
NIS
70 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
71 CV *cv =
72 (*save) ? *save : PerlIOVia_fetchmethod(aTHX_ s, method, save);
73 SV *result = Nullsv;
74 va_list ap;
75 va_start(ap, flags);
76 if (cv != (CV *) - 1) {
77 IV count;
78 dSP;
79 SV *arg;
80 PUSHSTACKi(PERLSI_MAGIC);
81 ENTER;
82 SPAGAIN;
83 PUSHMARK(sp);
84 XPUSHs(s->obj);
85 while ((arg = va_arg(ap, SV *))) {
86 XPUSHs(arg);
87 }
88 if (*PerlIONext(f)) {
89 if (!s->fh) {
bfcb3514 90 GV *gv = newGVgen(HvNAME_get(s->stash));
fc040538
NIS
91 GvIOp(gv) = newIO();
92 s->fh = newRV_noinc((SV *) gv);
93 s->io = GvIOp(gv);
94 }
95 IoIFP(s->io) = PerlIONext(f);
96 IoOFP(s->io) = PerlIONext(f);
97 XPUSHs(s->fh);
98 }
99 else {
100 PerlIO_debug("No next\n");
30ef3321 101 /* FIXME: How should this work for OPEN etc? */
fc040538
NIS
102 }
103 PUTBACK;
104 count = call_sv((SV *) cv, flags);
105 if (count) {
106 SPAGAIN;
107 result = POPs;
108 PUTBACK;
109 }
110 else {
111 result = &PL_sv_undef;
112 }
113 LEAVE;
114 POPSTACK;
e7a1fdd7 115 }
fc040538
NIS
116 va_end(ap);
117 return result;
e7a1fdd7
NIS
118}
119
120IV
fc040538
NIS
121PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
122 PerlIO_funcs * tab)
e7a1fdd7 123{
fc040538
NIS
124 IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
125 if (code == 0) {
126 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
127 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 STRLEN pkglen = 0;
7248df0a 136 const char *pkg = SvPV(arg, pkglen);
fc040538 137 s->obj = SvREFCNT_inc(arg);
da51bb9b 138 s->stash = gv_stashpvn(pkg, pkglen, 0);
fc040538 139 if (!s->stash) {
3904eff9 140 SvREFCNT_dec(s->obj);
fc040538 141 s->obj =
e934609f 142 newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg),
fc040538 143 pkglen + 13);
da51bb9b 144 s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, 0);
fc040538
NIS
145 }
146 if (s->stash) {
abc0a015
NIS
147 char lmode[8];
148 SV *modesv;
149 SV *result;
150 if (!mode) {
151 /* binmode() passes NULL - so find out what mode is */
152 mode = PerlIO_modestr(f,lmode);
153 }
154 modesv = sv_2mortal(newSVpvn(mode, strlen(mode)));
155 result = PerlIOVia_method(aTHX_ f, MYMethod(PUSHED), G_SCALAR,
fc040538
NIS
156 modesv, Nullsv);
157 if (result) {
158 if (sv_isobject(result)) {
3904eff9 159 SvREFCNT_dec(s->obj);
fc040538 160 s->obj = SvREFCNT_inc(result);
fc040538
NIS
161 }
162 else if (SvIV(result) != 0)
163 return SvIV(result);
164 }
4f776d34
RC
165 else {
166 goto push_failed;
167 }
802588c3
NIS
168 modesv = (*PerlIONext(f) && (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_UTF8))
169 ? &PL_sv_yes : &PL_sv_no;
170 result = PerlIOVia_method(aTHX_ f, MYMethod(UTF8), G_SCALAR, modesv, Nullsv);
171 if (result && SvTRUE(result)) {
7248df0a 172 PerlIOBase(f)->flags |= PERLIO_F_UTF8;
802588c3
NIS
173 }
174 else {
175 PerlIOBase(f)->flags &= ~PERLIO_F_UTF8;
176 }
fc040538
NIS
177 if (PerlIOVia_fetchmethod(aTHX_ s, MYMethod(FILL)) ==
178 (CV *) - 1)
179 PerlIOBase(f)->flags &= ~PERLIO_F_FASTGETS;
180 else
181 PerlIOBase(f)->flags |= PERLIO_F_FASTGETS;
182 }
183 else {
184 if (ckWARN(WARN_LAYER))
185 Perl_warner(aTHX_ packWARN(WARN_LAYER),
186 "Cannot find package '%.*s'", (int) pkglen,
187 pkg);
4f776d34 188push_failed:
267cbce7 189#ifdef ENOSYS
fc040538 190 errno = ENOSYS;
267cbce7
NIS
191#else
192#ifdef ENOENT
fc040538 193 errno = ENOENT;
267cbce7
NIS
194#endif
195#endif
fc040538
NIS
196 code = -1;
197 }
198 }
e7a1fdd7 199 }
fc040538 200 return code;
e7a1fdd7
NIS
201}
202
203PerlIO *
fc040538
NIS
204PerlIOVia_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)
e7a1fdd7 207{
fc040538
NIS
208 if (!f) {
209 f = PerlIO_push(aTHX_ PerlIO_allocate(aTHX), self, mode,
210 PerlIOArg);
e7a1fdd7 211 }
fc040538
NIS
212 else {
213 /* Reopen */
214 if (!PerlIO_push(aTHX_ f, self, mode, PerlIOArg))
215 return NULL;
e7a1fdd7 216 }
fc040538
NIS
217 if (f) {
218 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
219 SV *result = Nullsv;
220 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 else if (narg > 0) {
227 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 result =
236 PerlIOVia_method(aTHX_ f, MYMethod(OPEN), G_SCALAR,
237 *args, Nullsv);
d9dac8cd 238 }
d9dac8cd 239 }
fc040538
NIS
240 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 PerlIO_funcs *tab = NULL;
d26d6e72 250 IV m = n - 1;
fc040538
NIS
251 while (m >= 0) {
252 PerlIO_funcs *t =
253 PerlIO_layer_fetch(aTHX_ layers, m, NULL);
254 if (t && t->Open) {
255 tab = t;
256 break;
257 }
d26d6e72 258 m--;
fc040538
NIS
259 }
260 if (tab) {
261 if ((*tab->Open) (aTHX_ tab, layers, m, mode, fd, imode,
262 perm, PerlIONext(f), narg, args)) {
263 PerlIO_debug("Opened with %s => %p->%p\n", tab->name,
264 PerlIONext(f), *PerlIONext(f));
265 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 }
d9dac8cd 277 }
30ef3321 278 /* FIXME - Call an OPENED method here ? */
fc040538
NIS
279 return f;
280 }
281 else {
30ef3321
NIS
282 PerlIO_debug("Open fail %s => %p->%p\n", tab->name,
283 PerlIONext(f), *PerlIONext(f));
fc040538 284 /* Sub-layer open failed */
d9dac8cd 285 }
d9dac8cd
NIS
286 }
287 else {
30ef3321 288 PerlIO_debug("Nothing to open with");
fc040538 289 /* Nothing to do the open */
d9dac8cd 290 }
30ef3321 291 PerlIO_pop(aTHX_ f);
fc040538 292 return NULL;
d9dac8cd 293 }
d9dac8cd 294 }
fc040538 295 return f;
e7a1fdd7
NIS
296}
297
298IV
fc040538 299PerlIOVia_popped(pTHX_ PerlIO * f)
e7a1fdd7 300{
fc040538
NIS
301 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
302 PerlIOVia_method(aTHX_ f, MYMethod(POPPED), G_VOID, Nullsv);
303 if (s->var) {
304 SvREFCNT_dec(s->var);
305 s->var = Nullsv;
306 }
307
308 if (s->io) {
309 IoIFP(s->io) = NULL;
310 IoOFP(s->io) = NULL;
311 }
312 if (s->fh) {
313 SvREFCNT_dec(s->fh);
314 s->fh = Nullsv;
315 s->io = NULL;
316 }
317 if (s->obj) {
318 SvREFCNT_dec(s->obj);
319 s->obj = Nullsv;
320 }
321 return 0;
e7a1fdd7
NIS
322}
323
324IV
fc040538 325PerlIOVia_close(pTHX_ PerlIO * f)
e7a1fdd7 326{
fc040538
NIS
327 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
328 IV code = PerlIOBase_close(aTHX_ f);
329 SV *result =
330 PerlIOVia_method(aTHX_ f, MYMethod(CLOSE), G_SCALAR, Nullsv);
331 if (result && SvIV(result) != 0)
332 code = SvIV(result);
333 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
334 return code;
e7a1fdd7
NIS
335}
336
337IV
fc040538 338PerlIOVia_fileno(pTHX_ PerlIO * f)
e7a1fdd7 339{
fc040538
NIS
340 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
341 SV *result =
342 PerlIOVia_method(aTHX_ f, MYMethod(FILENO), G_SCALAR, Nullsv);
343 return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
e7a1fdd7
NIS
344}
345
346IV
fc040538 347PerlIOVia_binmode(pTHX_ PerlIO * f)
86e05cf2 348{
fc040538
NIS
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);
86e05cf2
NIS
357}
358
6efa4722 359IV
fc040538 360PerlIOVia_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
e7a1fdd7 361{
fc040538 362 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
4a9d6100
GS
363 SV *offsv = sv_2mortal(sizeof(Off_t) > sizeof(IV)
364 ? newSVnv((NV)offset) : newSViv((IV)offset));
fc040538
NIS
365 SV *whsv = sv_2mortal(newSViv(whence));
366 SV *result =
367 PerlIOVia_method(aTHX_ f, MYMethod(SEEK), G_SCALAR, offsv, whsv,
368 Nullsv);
b6290011
JH
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
fc040538 375 return (result) ? SvIV(result) : -1;
b6290011 376#endif
e7a1fdd7
NIS
377}
378
379Off_t
fc040538 380PerlIOVia_tell(pTHX_ PerlIO * f)
e7a1fdd7 381{
fc040538
NIS
382 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
383 SV *result =
384 PerlIOVia_method(aTHX_ f, MYMethod(TELL), G_SCALAR, Nullsv);
4a9d6100
GS
385 return (result)
386 ? (SvNOK(result) ? (Off_t)SvNV(result) : (Off_t)SvIV(result))
387 : (Off_t) - 1;
e7a1fdd7
NIS
388}
389
390SSize_t
fc040538 391PerlIOVia_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
e7a1fdd7 392{
fc040538
NIS
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 }
e7a1fdd7
NIS
402}
403
404SSize_t
fc040538 405PerlIOVia_read(pTHX_ PerlIO * f, void *vbuf, Size_t count)
e7a1fdd7 406{
fc040538
NIS
407 SSize_t rd = 0;
408 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
409 if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
410 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 }
e7a1fdd7 425 }
fc040538 426 return rd;
e7a1fdd7
NIS
427}
428
429SSize_t
fc040538 430PerlIOVia_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
e7a1fdd7 431{
fc040538
NIS
432 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
433 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
434 SV *buf = newSVpvn((char *) vbuf, count);
435 SV *result =
436 PerlIOVia_method(aTHX_ f, MYMethod(WRITE), G_SCALAR, buf,
437 Nullsv);
438 SvREFCNT_dec(buf);
439 if (result)
440 return (SSize_t) SvIV(result);
441 return -1;
442 }
443 return 0;
e7a1fdd7
NIS
444}
445
446IV
fc040538 447PerlIOVia_fill(pTHX_ PerlIO * f)
e7a1fdd7 448{
fc040538
NIS
449 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
450 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
451 SV *result =
452 PerlIOVia_method(aTHX_ f, MYMethod(FILL), G_SCALAR, Nullsv);
453 if (s->var) {
454 SvREFCNT_dec(s->var);
455 s->var = Nullsv;
456 }
457 if (result && SvOK(result)) {
458 STRLEN len = 0;
7248df0a 459 const char *p = SvPV(result, len);
fc040538
NIS
460 s->var = newSVpvn(p, len);
461 s->cnt = SvCUR(s->var);
462 return 0;
463 }
464 else
465 PerlIOBase(f)->flags |= PERLIO_F_EOF;
e7a1fdd7 466 }
fc040538 467 return -1;
e7a1fdd7
NIS
468}
469
470IV
fc040538 471PerlIOVia_flush(pTHX_ PerlIO * f)
e7a1fdd7 472{
fc040538
NIS
473 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
474 SV *result =
475 PerlIOVia_method(aTHX_ f, MYMethod(FLUSH), G_SCALAR, Nullsv);
476 if (s->var && s->cnt > 0) {
477 SvREFCNT_dec(s->var);
478 s->var = Nullsv;
479 }
480 return (result) ? SvIV(result) : 0;
e7a1fdd7
NIS
481}
482
483STDCHAR *
fc040538 484PerlIOVia_get_base(pTHX_ PerlIO * f)
e7a1fdd7 485{
fc040538
NIS
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 }
e7a1fdd7 491 }
fc040538 492 return (STDCHAR *) Nullch;
e7a1fdd7
NIS
493}
494
495STDCHAR *
fc040538 496PerlIOVia_get_ptr(pTHX_ PerlIO * f)
e7a1fdd7 497{
fc040538
NIS
498 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
499 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
500 if (s->var) {
501 STDCHAR *p = (STDCHAR *) (SvEND(s->var) - s->cnt);
502 return p;
503 }
e7a1fdd7 504 }
fc040538 505 return (STDCHAR *) Nullch;
e7a1fdd7
NIS
506}
507
508SSize_t
fc040538 509PerlIOVia_get_cnt(pTHX_ PerlIO * f)
e7a1fdd7 510{
fc040538
NIS
511 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
512 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
513 if (s->var) {
514 return s->cnt;
515 }
e7a1fdd7 516 }
fc040538 517 return 0;
e7a1fdd7
NIS
518}
519
520Size_t
fc040538 521PerlIOVia_bufsiz(pTHX_ PerlIO * f)
e7a1fdd7 522{
fc040538
NIS
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;
e7a1fdd7
NIS
529}
530
531void
fc040538 532PerlIOVia_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
e7a1fdd7 533{
fc040538
NIS
534 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
535 s->cnt = cnt;
e7a1fdd7
NIS
536}
537
538void
fc040538 539PerlIOVia_setlinebuf(pTHX_ PerlIO * f)
e7a1fdd7 540{
fc040538
NIS
541 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
542 PerlIOVia_method(aTHX_ f, MYMethod(SETLINEBUF), G_VOID, Nullsv);
543 PerlIOBase_setlinebuf(aTHX_ f);
e7a1fdd7
NIS
544}
545
546void
fc040538 547PerlIOVia_clearerr(pTHX_ PerlIO * f)
e7a1fdd7 548{
fc040538
NIS
549 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
550 PerlIOVia_method(aTHX_ f, MYMethod(CLEARERR), G_VOID, Nullsv);
551 PerlIOBase_clearerr(aTHX_ f);
e7a1fdd7
NIS
552}
553
c7997937 554IV
fc040538 555PerlIOVia_error(pTHX_ PerlIO * f)
e7a1fdd7 556{
fc040538
NIS
557 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
558 SV *result =
559 PerlIOVia_method(aTHX_ f, "ERROR", &s->mERROR, G_SCALAR, Nullsv);
560 return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
e7a1fdd7
NIS
561}
562
563IV
fc040538 564PerlIOVia_eof(pTHX_ PerlIO * f)
e7a1fdd7 565{
fc040538
NIS
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);
e7a1fdd7
NIS
570}
571
ecdeb87c 572SV *
fc040538 573PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
ecdeb87c 574{
fc040538
NIS
575 PerlIOVia *s = PerlIOSelf(f, PerlIOVia);
576 return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv);
ecdeb87c
NIS
577}
578
8cf8f3d1 579PerlIO *
fc040538
NIS
580PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
581 int flags)
8cf8f3d1 582{
fc040538
NIS
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;
8cf8f3d1
NIS
589}
590
fc040538
NIS
591
592
27da23d5 593PERLIO_FUNCS_DECL(PerlIO_object) = {
2dc2558e 594 sizeof(PerlIO_funcs),
e934609f 595 "via",
e7a1fdd7
NIS
596 sizeof(PerlIOVia),
597 PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
598 PerlIOVia_pushed,
599 PerlIOVia_popped,
d9dac8cd 600 PerlIOVia_open, /* NULL, */
86e05cf2 601 PerlIOVia_binmode, /* NULL, */
e7a1fdd7
NIS
602 PerlIOVia_getarg,
603 PerlIOVia_fileno,
8cf8f3d1 604 PerlIOVia_dup,
e7a1fdd7
NIS
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
e934609f 627MODULE = PerlIO::via PACKAGE = PerlIO::via
e7a1fdd7
NIS
628PROTOTYPES: ENABLE;
629
630BOOT:
631{
632#ifdef PERLIO_LAYERS
27da23d5 633 PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object));
e7a1fdd7
NIS
634#endif
635}
636
fc040538 637
30ef3321
NIS
638
639
640