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