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; |
802588c3 | 38 | CV *UTF8; |
e7a1fdd7 NIS |
39 | } PerlIOVia; |
40 | ||
41 | #define MYMethod(x) #x,&s->x | |
42 | ||
43 | CV * | |
d3f5e399 | 44 | PerlIOVia_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 | 66 | SV * |
d3f5e399 | 67 | PerlIOVia_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() */ | |
c33e8be1 | 96 | (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD); |
8d06e08c | 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 | ||
124 | IV | |
fc040538 NIS |
125 | PerlIOVia_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); |
a681c2f1 RGS |
141 | s->obj = |
142 | newSVpvn(Perl_form(aTHX_ "PerlIO::via::%s", pkg), | |
143 | pkglen + 13); | |
144 | s->stash = gv_stashpvn(SvPVX_const(s->obj), pkglen + 13, 0); | |
fc040538 | 145 | if (!s->stash) { |
3904eff9 | 146 | SvREFCNT_dec(s->obj); |
a681c2f1 RGS |
147 | s->obj = SvREFCNT_inc(arg); |
148 | s->stash = gv_stashpvn(pkg, pkglen, 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 | } | |
d3d34884 | 158 | modesv = newSVpvn_flags(mode, strlen(mode), SVs_TEMP); |
abc0a015 | 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 | 192 | push_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 | ||
207 | PerlIO * | |
fc040538 NIS |
208 | 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) | |
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 | ||
302 | IV | |
fc040538 | 303 | PerlIOVia_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 | ||
328 | IV | |
fc040538 | 329 | PerlIOVia_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 | ||
341 | IV | |
fc040538 | 342 | PerlIOVia_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 | ||
350 | IV | |
fc040538 | 351 | PerlIOVia_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 | 363 | IV |
fc040538 | 364 | PerlIOVia_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 | ||
383 | Off_t | |
fc040538 | 384 | PerlIOVia_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 | ||
394 | SSize_t | |
fc040538 | 395 | PerlIOVia_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count) |
e7a1fdd7 | 396 | { |
fc040538 | 397 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
d3d34884 | 398 | SV *buf = newSVpvn_flags((char *) vbuf, count, SVs_TEMP); |
fc040538 NIS |
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 | ||
408 | SSize_t | |
fc040538 | 409 | PerlIOVia_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 | ||
433 | SSize_t | |
fc040538 | 434 | PerlIOVia_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 | ||
450 | IV | |
fc040538 | 451 | PerlIOVia_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 | ||
474 | IV | |
fc040538 | 475 | PerlIOVia_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 | ||
487 | STDCHAR * | |
fc040538 | 488 | PerlIOVia_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 | ||
499 | STDCHAR * | |
fc040538 | 500 | PerlIOVia_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 | ||
512 | SSize_t | |
fc040538 | 513 | PerlIOVia_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 | ||
524 | Size_t | |
fc040538 | 525 | PerlIOVia_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 | ||
535 | void | |
fc040538 | 536 | PerlIOVia_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt) |
e7a1fdd7 | 537 | { |
fc040538 | 538 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
c33e8be1 | 539 | PERL_UNUSED_ARG(ptr); |
fc040538 | 540 | s->cnt = cnt; |
e7a1fdd7 NIS |
541 | } |
542 | ||
543 | void | |
fc040538 | 544 | PerlIOVia_setlinebuf(pTHX_ PerlIO * f) |
e7a1fdd7 | 545 | { |
fc040538 NIS |
546 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
547 | PerlIOVia_method(aTHX_ f, MYMethod(SETLINEBUF), G_VOID, Nullsv); | |
548 | PerlIOBase_setlinebuf(aTHX_ f); | |
e7a1fdd7 NIS |
549 | } |
550 | ||
551 | void | |
fc040538 | 552 | PerlIOVia_clearerr(pTHX_ PerlIO * f) |
e7a1fdd7 | 553 | { |
fc040538 NIS |
554 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
555 | PerlIOVia_method(aTHX_ f, MYMethod(CLEARERR), G_VOID, Nullsv); | |
556 | PerlIOBase_clearerr(aTHX_ f); | |
e7a1fdd7 NIS |
557 | } |
558 | ||
c7997937 | 559 | IV |
fc040538 | 560 | PerlIOVia_error(pTHX_ PerlIO * f) |
e7a1fdd7 | 561 | { |
fc040538 NIS |
562 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
563 | SV *result = | |
564 | PerlIOVia_method(aTHX_ f, "ERROR", &s->mERROR, G_SCALAR, Nullsv); | |
565 | return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f); | |
e7a1fdd7 NIS |
566 | } |
567 | ||
568 | IV | |
fc040538 | 569 | PerlIOVia_eof(pTHX_ PerlIO * f) |
e7a1fdd7 | 570 | { |
fc040538 NIS |
571 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
572 | SV *result = | |
573 | PerlIOVia_method(aTHX_ f, "EOF", &s->mEOF, G_SCALAR, Nullsv); | |
574 | return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f); | |
e7a1fdd7 NIS |
575 | } |
576 | ||
ecdeb87c | 577 | SV * |
fc040538 | 578 | PerlIOVia_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) |
ecdeb87c | 579 | { |
fc040538 | 580 | PerlIOVia *s = PerlIOSelf(f, PerlIOVia); |
c33e8be1 Z |
581 | PERL_UNUSED_ARG(param); |
582 | PERL_UNUSED_ARG(flags); | |
fc040538 | 583 | return PerlIOVia_method(aTHX_ f, MYMethod(GETARG), G_SCALAR, Nullsv); |
ecdeb87c NIS |
584 | } |
585 | ||
8cf8f3d1 | 586 | PerlIO * |
fc040538 NIS |
587 | PerlIOVia_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param, |
588 | int flags) | |
8cf8f3d1 | 589 | { |
fc040538 NIS |
590 | 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 | return f; | |
8cf8f3d1 NIS |
596 | } |
597 | ||
fc040538 NIS |
598 | |
599 | ||
27da23d5 | 600 | PERLIO_FUNCS_DECL(PerlIO_object) = { |
2dc2558e | 601 | sizeof(PerlIO_funcs), |
e934609f | 602 | "via", |
e7a1fdd7 NIS |
603 | sizeof(PerlIOVia), |
604 | PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, | |
605 | PerlIOVia_pushed, | |
606 | PerlIOVia_popped, | |
d9dac8cd | 607 | PerlIOVia_open, /* NULL, */ |
86e05cf2 | 608 | PerlIOVia_binmode, /* NULL, */ |
e7a1fdd7 NIS |
609 | PerlIOVia_getarg, |
610 | PerlIOVia_fileno, | |
8cf8f3d1 | 611 | PerlIOVia_dup, |
e7a1fdd7 NIS |
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 | ||
e934609f | 634 | MODULE = PerlIO::via PACKAGE = PerlIO::via |
e7a1fdd7 NIS |
635 | PROTOTYPES: ENABLE; |
636 | ||
637 | BOOT: | |
638 | { | |
639 | #ifdef PERLIO_LAYERS | |
27da23d5 | 640 | PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_object)); |
e7a1fdd7 NIS |
641 | #endif |
642 | } | |
643 | ||
fc040538 | 644 | |
30ef3321 NIS |
645 | |
646 | ||
647 |