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