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