Commit | Line | Data |
---|---|---|
cf7fe8a2 GS |
1 | /* |
2 | * Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. | |
3 | * This program is free software; you can redistribute it and/or | |
4 | * modify it under the same terms as Perl itself. | |
5 | */ | |
6 | ||
6e22d046 JH |
7 | #define PERL_EXT_IO |
8 | ||
c5be433b | 9 | #define PERL_NO_GET_CONTEXT |
8add82fc | 10 | #include "EXTERN.h" |
760ac839 | 11 | #define PERLIO_NOT_STDIO 1 |
8add82fc | 12 | #include "perl.h" |
13 | #include "XSUB.h" | |
cf7fe8a2 | 14 | #include "poll.h" |
8add82fc | 15 | #ifdef I_UNISTD |
16 | # include <unistd.h> | |
17 | #endif | |
cf7fe8a2 | 18 | #if defined(I_FCNTL) || defined(HAS_FCNTL) |
760ac839 LW |
19 | # include <fcntl.h> |
20 | #endif | |
8add82fc | 21 | |
63a347c7 JH |
22 | #ifndef SIOCATMARK |
23 | # ifdef I_SYS_SOCKIO | |
24 | # include <sys/sockio.h> | |
25 | # endif | |
26 | #endif | |
27 | ||
2a0cf753 | 28 | #ifdef PerlIO |
eb44fba6 | 29 | #if defined(MACOS_TRADITIONAL) && defined(USE_SFIO) |
824215e2 JH |
30 | #define PERLIO_IS_STDIO 1 |
31 | #undef setbuf | |
32 | #undef setvbuf | |
33 | #define setvbuf _stdsetvbuf | |
34 | #define setbuf(f,b) ( __sf_setbuf(f,b) ) | |
35 | #endif | |
8add82fc | 36 | typedef int SysRet; |
760ac839 LW |
37 | typedef PerlIO * InputStream; |
38 | typedef PerlIO * OutputStream; | |
2a0cf753 | 39 | #else |
40 | #define PERLIO_IS_STDIO 1 | |
41 | typedef int SysRet; | |
42 | typedef FILE * InputStream; | |
43 | typedef FILE * OutputStream; | |
44 | #endif | |
8add82fc | 45 | |
cceca5ed | 46 | #define MY_start_subparse(fmt,flags) start_subparse(fmt,flags) |
cf7fe8a2 GS |
47 | |
48 | #ifndef gv_stashpvn | |
49 | #define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) | |
50 | #endif | |
51 | ||
35a60386 RGS |
52 | #ifndef __attribute__noreturn__ |
53 | # define __attribute__noreturn__ | |
54 | #endif | |
55 | ||
56 | #ifndef NORETURN_FUNCTION_END | |
57 | # define NORETURN_FUNCTION_END /* NOT REACHED */ return 0 | |
58 | #endif | |
59 | ||
986a805c FC |
60 | #ifndef dVAR |
61 | # define dVAR dNOOP | |
62 | #endif | |
63 | ||
e6dae479 FC |
64 | #ifndef OpSIBLING |
65 | # define OpSIBLING(o) (o)->op_sibling | |
5a3da92c FC |
66 | #endif |
67 | ||
7698c435 | 68 | static int not_here(const char *s) __attribute__noreturn__; |
8add82fc | 69 | static int |
7698c435 | 70 | not_here(const char *s) |
8add82fc | 71 | { |
72 | croak("%s not implemented on this architecture", s); | |
c38693a5 | 73 | NORETURN_FUNCTION_END; |
8add82fc | 74 | } |
75 | ||
6ed60307 KW |
76 | #ifndef UVCHR_IS_INVARIANT /* For use with Perls without this macro */ |
77 | # if ('A' == 65) | |
78 | # define UVCHR_IS_INVARIANT(cp) ((cp) < 128) | |
79 | # elif (defined(NATIVE_IS_INVARIANT)) /* EBCDIC on old Perl */ | |
80 | # define UVCHR_IS_INVARIANT(cp) ((cp) < 256 && NATIVE_IS_INVARIANT(cp)) | |
81 | # elif defined(isASCII) /* EBCDIC on very old Perl */ | |
82 | /* In EBCDIC, the invariants are the code points corresponding to ASCII, | |
83 | * plus all the controls. All but one EBCDIC control is below SPACE; it | |
84 | * varies depending on the code page, determined by the ord of '^' */ | |
85 | # define UVCHR_IS_INVARIANT(cp) (isASCII(cp) \ | |
86 | || (cp) < ' ' \ | |
87 | || (('^' == 106) /* POSIX-BC */ \ | |
88 | ? (cp) == 95 \ | |
89 | : (cp) == 0xFF)) /* 1047 or 037 */ | |
90 | # else /* EBCDIC on very very old Perl */ | |
91 | /* This assumes isascii() is available, but that could be fixed by | |
92 | * having the macro test for each printable ASCII char */ | |
93 | # define UVCHR_IS_INVARIANT(cp) (isascii(cp) \ | |
94 | || (cp) < ' ' \ | |
95 | || (('^' == 106) /* POSIX-BC */ \ | |
96 | ? (cp) == 95 \ | |
97 | : (cp) == 0xFF)) /* 1047 or 037 */ | |
98 | # endif | |
99 | #endif | |
100 | ||
cf7fe8a2 GS |
101 | |
102 | #ifndef PerlIO | |
103 | #define PerlIO_fileno(f) fileno(f) | |
8add82fc | 104 | #endif |
cf7fe8a2 GS |
105 | |
106 | static int | |
e87a358a | 107 | io_blocking(pTHX_ InputStream f, int block) |
cf7fe8a2 | 108 | { |
375ed12a | 109 | int fd = -1; |
91f3b821 | 110 | #if defined(HAS_FCNTL) |
cf7fe8a2 | 111 | int RETVAL; |
375ed12a | 112 | if (!f) { |
cf7fe8a2 GS |
113 | errno = EBADF; |
114 | return -1; | |
115 | } | |
375ed12a JH |
116 | fd = PerlIO_fileno(f); |
117 | if (fd < 0) { | |
118 | errno = EBADF; | |
119 | return -1; | |
120 | } | |
121 | RETVAL = fcntl(fd, F_GETFL, 0); | |
cf7fe8a2 GS |
122 | if (RETVAL >= 0) { |
123 | int mode = RETVAL; | |
3b2f3eeb | 124 | int newmode = mode; |
cf7fe8a2 | 125 | #ifdef O_NONBLOCK |
766a733e | 126 | /* POSIX style */ |
cf7fe8a2 | 127 | |
3b2f3eeb BD |
128 | # ifndef O_NDELAY |
129 | # define O_NDELAY O_NONBLOCK | |
130 | # endif | |
131 | /* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY | |
6fd254a4 JH |
132 | * after a successful F_SETFL of an O_NONBLOCK. */ |
133 | RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1; | |
134 | ||
3b2f3eeb BD |
135 | if (block == 0) { |
136 | newmode &= ~O_NDELAY; | |
137 | newmode |= O_NONBLOCK; | |
138 | } else if (block > 0) { | |
139 | newmode &= ~(O_NDELAY|O_NONBLOCK); | |
cf7fe8a2 | 140 | } |
8add82fc | 141 | #else |
cf7fe8a2 GS |
142 | /* Not POSIX - better have O_NDELAY or we can't cope. |
143 | * for BSD-ish machines this is an acceptable alternative | |
766a733e | 144 | * for SysV we can't tell "would block" from EOF but that is |
cf7fe8a2 GS |
145 | * the way SysV is... |
146 | */ | |
147 | RETVAL = RETVAL & O_NDELAY ? 0 : 1; | |
148 | ||
3b2f3eeb BD |
149 | if (block == 0) { |
150 | newmode |= O_NDELAY; | |
151 | } else if (block > 0) { | |
152 | newmode &= ~O_NDELAY; | |
153 | } | |
154 | #endif | |
155 | if (newmode != mode) { | |
375ed12a | 156 | const int ret = fcntl(fd, F_SETFL, newmode); |
3b2f3eeb | 157 | if (ret < 0) |
cf7fe8a2 | 158 | RETVAL = ret; |
3b2f3eeb | 159 | } |
cf7fe8a2 GS |
160 | } |
161 | return RETVAL; | |
8add82fc | 162 | #else |
20caf59d | 163 | # ifdef WIN32 |
f5458e3a | 164 | if (block >= 0) { |
1320cbfc | 165 | unsigned long flags = !block; |
f5458e3a | 166 | /* ioctl claims to take char* but really needs a u_long sized buffer */ |
375ed12a | 167 | const int ret = ioctl(fd, FIONBIO, (char*)&flags); |
f5458e3a SO |
168 | if (ret != 0) |
169 | return -1; | |
170 | /* Win32 has no way to get the current blocking status of a socket. | |
171 | * However, we don't want to just return undef, because there's no way | |
172 | * to tell that the ioctl succeeded. | |
173 | */ | |
174 | return flags; | |
175 | } | |
176 | /* TODO: Perhaps set $! to ENOTSUP? */ | |
177 | return -1; | |
20caf59d | 178 | # else |
91f3b821 | 179 | return -1; |
20caf59d | 180 | # endif |
8add82fc | 181 | #endif |
8add82fc | 182 | } |
183 | ||
986a805c FC |
184 | static OP * |
185 | io_pp_nextstate(pTHX) | |
186 | { | |
187 | dVAR; | |
188 | COP *old_curcop = PL_curcop; | |
189 | OP *next = PL_ppaddr[PL_op->op_type](aTHX); | |
190 | PL_curcop = old_curcop; | |
191 | return next; | |
192 | } | |
193 | ||
194 | static OP * | |
195 | io_ck_lineseq(pTHX_ OP *o) | |
196 | { | |
197 | OP *kid = cBINOPo->op_first; | |
e6dae479 | 198 | for (; kid; kid = OpSIBLING(kid)) |
986a805c FC |
199 | if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) |
200 | kid->op_ppaddr = io_pp_nextstate; | |
201 | return o; | |
202 | } | |
203 | ||
204 | ||
8add82fc | 205 | MODULE = IO PACKAGE = IO::Seekable PREFIX = f |
206 | ||
8063af02 | 207 | void |
8add82fc | 208 | fgetpos(handle) |
209 | InputStream handle | |
210 | CODE: | |
8add82fc | 211 | if (handle) { |
2a0cf753 | 212 | #ifdef PerlIO |
35a60386 | 213 | #if PERL_VERSION < 8 |
86413ec0 SH |
214 | Fpos_t pos; |
215 | ST(0) = sv_newmortal(); | |
35a60386 RGS |
216 | if (PerlIO_getpos(handle, &pos) != 0) { |
217 | ST(0) = &PL_sv_undef; | |
218 | } | |
219 | else { | |
220 | sv_setpvn(ST(0), (char *)&pos, sizeof(Fpos_t)); | |
221 | } | |
222 | #else | |
86413ec0 | 223 | ST(0) = sv_newmortal(); |
766a733e NIS |
224 | if (PerlIO_getpos(handle, ST(0)) != 0) { |
225 | ST(0) = &PL_sv_undef; | |
226 | } | |
35a60386 | 227 | #endif |
2a0cf753 | 228 | #else |
35a60386 | 229 | Fpos_t pos; |
766a733e | 230 | if (fgetpos(handle, &pos)) { |
a6a714bd NC |
231 | ST(0) = &PL_sv_undef; |
232 | } else { | |
c7cffa0b NC |
233 | # if PERL_VERSION >= 11 |
234 | ST(0) = newSVpvn_flags((char*)&pos, sizeof(Fpos_t), SVs_TEMP); | |
235 | # else | |
35a60386 | 236 | ST(0) = sv_2mortal(newSVpvn((char*)&pos, sizeof(Fpos_t))); |
c7cffa0b | 237 | # endif |
a6a714bd | 238 | } |
766a733e | 239 | #endif |
8add82fc | 240 | } |
241 | else { | |
8add82fc | 242 | errno = EINVAL; |
35a60386 | 243 | ST(0) = &PL_sv_undef; |
8add82fc | 244 | } |
8add82fc | 245 | |
246 | SysRet | |
247 | fsetpos(handle, pos) | |
248 | InputStream handle | |
249 | SV * pos | |
250 | CODE: | |
766a733e | 251 | if (handle) { |
2a0cf753 | 252 | #ifdef PerlIO |
35a60386 RGS |
253 | #if PERL_VERSION < 8 |
254 | char *p; | |
255 | STRLEN len; | |
256 | if (SvOK(pos) && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) { | |
257 | RETVAL = PerlIO_setpos(handle, (Fpos_t*)p); | |
258 | } | |
259 | else { | |
260 | RETVAL = -1; | |
261 | errno = EINVAL; | |
262 | } | |
263 | #else | |
766a733e | 264 | RETVAL = PerlIO_setpos(handle, pos); |
35a60386 | 265 | #endif |
2a0cf753 | 266 | #else |
766a733e NIS |
267 | char *p; |
268 | STRLEN len; | |
269 | if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) { | |
270 | RETVAL = fsetpos(handle, (Fpos_t*)p); | |
271 | } | |
272 | else { | |
273 | RETVAL = -1; | |
274 | errno = EINVAL; | |
275 | } | |
2a0cf753 | 276 | #endif |
766a733e | 277 | } |
8add82fc | 278 | else { |
279 | RETVAL = -1; | |
280 | errno = EINVAL; | |
281 | } | |
8add82fc | 282 | OUTPUT: |
283 | RETVAL | |
284 | ||
285 | MODULE = IO PACKAGE = IO::File PREFIX = f | |
286 | ||
8063af02 | 287 | void |
8add82fc | 288 | new_tmpfile(packname = "IO::File") |
3e946625 | 289 | const char * packname |
a375a877 GB |
290 | PREINIT: |
291 | OutputStream fp; | |
292 | GV *gv; | |
8add82fc | 293 | CODE: |
2a0cf753 | 294 | #ifdef PerlIO |
a375a877 | 295 | fp = PerlIO_tmpfile(); |
2a0cf753 | 296 | #else |
a375a877 | 297 | fp = tmpfile(); |
2a0cf753 | 298 | #endif |
a375a877 | 299 | gv = (GV*)SvREFCNT_inc(newGVgen(packname)); |
71cd1c3f | 300 | if (gv) |
c33e8be1 | 301 | (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD); |
71cd1c3f | 302 | if (gv && do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) { |
6d5cdeed | 303 | ST(0) = sv_2mortal(newRV((SV*)gv)); |
a375a877 | 304 | sv_bless(ST(0), gv_stashpv(packname, TRUE)); |
cf7fe8a2 | 305 | SvREFCNT_dec(gv); /* undo increment in newRV() */ |
a375a877 GB |
306 | } |
307 | else { | |
a1ea39dc | 308 | ST(0) = &PL_sv_undef; |
a375a877 GB |
309 | SvREFCNT_dec(gv); |
310 | } | |
8add82fc | 311 | |
cf7fe8a2 GS |
312 | MODULE = IO PACKAGE = IO::Poll |
313 | ||
766a733e | 314 | void |
cf7fe8a2 GS |
315 | _poll(timeout,...) |
316 | int timeout; | |
317 | PPCODE: | |
318 | { | |
319 | #ifdef HAS_POLL | |
7698c435 | 320 | const int nfd = (items - 1) / 2; |
cf7fe8a2 GS |
321 | SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd)); |
322 | struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv); | |
323 | int i,j,ret; | |
324 | for(i=1, j=0 ; j < nfd ; j++) { | |
325 | fds[j].fd = SvIV(ST(i)); | |
326 | i++; | |
7c436af3 | 327 | fds[j].events = (short)SvIV(ST(i)); |
cf7fe8a2 GS |
328 | i++; |
329 | fds[j].revents = 0; | |
330 | } | |
331 | if((ret = poll(fds,nfd,timeout)) >= 0) { | |
332 | for(i=1, j=0 ; j < nfd ; j++) { | |
333 | sv_setiv(ST(i), fds[j].fd); i++; | |
334 | sv_setiv(ST(i), fds[j].revents); i++; | |
335 | } | |
336 | } | |
337 | SvREFCNT_dec(tmpsv); | |
338 | XSRETURN_IV(ret); | |
339 | #else | |
340 | not_here("IO::Poll::poll"); | |
341 | #endif | |
342 | } | |
343 | ||
344 | MODULE = IO PACKAGE = IO::Handle PREFIX = io_ | |
345 | ||
346 | void | |
347 | io_blocking(handle,blk=-1) | |
348 | InputStream handle | |
349 | int blk | |
350 | PROTOTYPE: $;$ | |
351 | CODE: | |
352 | { | |
7698c435 | 353 | const int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0); |
cf7fe8a2 GS |
354 | if(ret >= 0) |
355 | XSRETURN_IV(ret); | |
356 | else | |
357 | XSRETURN_UNDEF; | |
358 | } | |
359 | ||
8add82fc | 360 | MODULE = IO PACKAGE = IO::Handle PREFIX = f |
361 | ||
8add82fc | 362 | int |
363 | ungetc(handle, c) | |
364 | InputStream handle | |
10e621bc | 365 | SV * c |
8add82fc | 366 | CODE: |
10e621bc | 367 | if (handle) { |
2a0cf753 | 368 | #ifdef PerlIO |
10e621bc CH |
369 | UV v; |
370 | ||
371 | if ((SvIOK_notUV(c) && SvIV(c) < 0) || (SvNOK(c) && SvNV(c) < 0.0)) | |
372 | croak("Negative character number in ungetc()"); | |
373 | ||
374 | v = SvUV(c); | |
6f2d5cbc | 375 | if (UVCHR_IS_INVARIANT(v) || (v <= 0xFF && !PerlIO_isutf8(handle))) |
10e621bc CH |
376 | RETVAL = PerlIO_ungetc(handle, (int)v); |
377 | else { | |
378 | U8 buf[UTF8_MAXBYTES + 1], *end; | |
379 | Size_t len; | |
380 | ||
381 | if (!PerlIO_isutf8(handle)) | |
382 | croak("Wide character number in ungetc()"); | |
383 | ||
384 | /* This doesn't warn for non-chars, surrogate, and | |
385 | * above-Unicodes */ | |
386 | end = uvchr_to_utf8_flags(buf, v, 0); | |
387 | len = end - buf; | |
13142853 | 388 | if ((Size_t)PerlIO_unread(handle, &buf, len) == len) |
10e621bc CH |
389 | XSRETURN_UV(v); |
390 | else | |
391 | RETVAL = EOF; | |
392 | } | |
2a0cf753 | 393 | #else |
10e621bc | 394 | RETVAL = ungetc((int)SvIV(c), handle); |
2a0cf753 | 395 | #endif |
10e621bc | 396 | } |
8add82fc | 397 | else { |
398 | RETVAL = -1; | |
399 | errno = EINVAL; | |
400 | } | |
401 | OUTPUT: | |
402 | RETVAL | |
403 | ||
404 | int | |
405 | ferror(handle) | |
406 | InputStream handle | |
407 | CODE: | |
408 | if (handle) | |
2a0cf753 | 409 | #ifdef PerlIO |
760ac839 | 410 | RETVAL = PerlIO_error(handle); |
2a0cf753 | 411 | #else |
412 | RETVAL = ferror(handle); | |
413 | #endif | |
414 | else { | |
415 | RETVAL = -1; | |
416 | errno = EINVAL; | |
417 | } | |
418 | OUTPUT: | |
419 | RETVAL | |
420 | ||
421 | int | |
422 | clearerr(handle) | |
423 | InputStream handle | |
424 | CODE: | |
425 | if (handle) { | |
426 | #ifdef PerlIO | |
427 | PerlIO_clearerr(handle); | |
428 | #else | |
429 | clearerr(handle); | |
430 | #endif | |
431 | RETVAL = 0; | |
432 | } | |
8add82fc | 433 | else { |
434 | RETVAL = -1; | |
59629a13 RR |
435 | errno = EINVAL; |
436 | } | |
437 | OUTPUT: | |
438 | RETVAL | |
439 | ||
440 | int | |
441 | untaint(handle) | |
442 | SV * handle | |
443 | CODE: | |
7a4c00b4 | 444 | #ifdef IOf_UNTAINT |
59629a13 RR |
445 | IO * io; |
446 | io = sv_2io(handle); | |
447 | if (io) { | |
448 | IoFLAGS(io) |= IOf_UNTAINT; | |
449 | RETVAL = 0; | |
450 | } | |
451 | else { | |
7a4c00b4 | 452 | #endif |
59629a13 | 453 | RETVAL = -1; |
8add82fc | 454 | errno = EINVAL; |
7a4c00b4 | 455 | #ifdef IOf_UNTAINT |
8add82fc | 456 | } |
7a4c00b4 | 457 | #endif |
8add82fc | 458 | OUTPUT: |
459 | RETVAL | |
460 | ||
461 | SysRet | |
462 | fflush(handle) | |
463 | OutputStream handle | |
464 | CODE: | |
465 | if (handle) | |
2a0cf753 | 466 | #ifdef PerlIO |
760ac839 | 467 | RETVAL = PerlIO_flush(handle); |
2a0cf753 | 468 | #else |
469 | RETVAL = Fflush(handle); | |
470 | #endif | |
8add82fc | 471 | else { |
472 | RETVAL = -1; | |
473 | errno = EINVAL; | |
474 | } | |
475 | OUTPUT: | |
476 | RETVAL | |
477 | ||
478 | void | |
c46a0ec2 | 479 | setbuf(handle, ...) |
8add82fc | 480 | OutputStream handle |
8add82fc | 481 | CODE: |
482 | if (handle) | |
760ac839 | 483 | #ifdef PERLIO_IS_STDIO |
c46a0ec2 JH |
484 | { |
485 | char *buf = items == 2 && SvPOK(ST(1)) ? | |
486 | sv_grow(ST(1), BUFSIZ) : 0; | |
8add82fc | 487 | setbuf(handle, buf); |
c46a0ec2 | 488 | } |
760ac839 LW |
489 | #else |
490 | not_here("IO::Handle::setbuf"); | |
491 | #endif | |
8add82fc | 492 | |
493 | SysRet | |
c46a0ec2 | 494 | setvbuf(...) |
8add82fc | 495 | CODE: |
c46a0ec2 JH |
496 | if (items != 4) |
497 | Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)"); | |
1eeb0f31 | 498 | #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF) |
c46a0ec2 JH |
499 | { |
500 | OutputStream handle = 0; | |
501 | char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; | |
502 | int type; | |
503 | int size; | |
504 | ||
505 | if (items == 4) { | |
506 | handle = IoOFP(sv_2io(ST(0))); | |
507 | buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; | |
508 | type = (int)SvIV(ST(2)); | |
509 | size = (int)SvIV(ST(3)); | |
510 | } | |
d924de76 IZ |
511 | if (!handle) /* Try input stream. */ |
512 | handle = IoIFP(sv_2io(ST(0))); | |
c46a0ec2 | 513 | if (items == 4 && handle) |
8add82fc | 514 | RETVAL = setvbuf(handle, buf, type, size); |
515 | else { | |
516 | RETVAL = -1; | |
517 | errno = EINVAL; | |
518 | } | |
c46a0ec2 | 519 | } |
8add82fc | 520 | #else |
61839fa9 | 521 | RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); |
760ac839 | 522 | #endif |
8add82fc | 523 | OUTPUT: |
524 | RETVAL | |
525 | ||
526 | ||
cf7fe8a2 | 527 | SysRet |
2ba489e6 EM |
528 | fsync(arg) |
529 | SV * arg | |
530 | PREINIT: | |
531 | OutputStream handle = NULL; | |
cf7fe8a2 GS |
532 | CODE: |
533 | #ifdef HAS_FSYNC | |
2ba489e6 EM |
534 | handle = IoOFP(sv_2io(arg)); |
535 | if (!handle) | |
536 | handle = IoIFP(sv_2io(arg)); | |
375ed12a JH |
537 | if (handle) { |
538 | int fd = PerlIO_fileno(handle); | |
539 | if (fd >= 0) { | |
540 | RETVAL = fsync(fd); | |
541 | } else { | |
542 | RETVAL = -1; | |
543 | errno = EBADF; | |
544 | } | |
545 | } else { | |
cf7fe8a2 GS |
546 | RETVAL = -1; |
547 | errno = EINVAL; | |
548 | } | |
549 | #else | |
550 | RETVAL = (SysRet) not_here("IO::Handle::sync"); | |
551 | #endif | |
552 | OUTPUT: | |
553 | RETVAL | |
554 | ||
986a805c FC |
555 | SV * |
556 | _create_getline_subs(const char *code) | |
986a805c FC |
557 | CODE: |
558 | OP *(*io_old_ck_lineseq)(pTHX_ OP *) = PL_check[OP_LINESEQ]; | |
559 | PL_check[OP_LINESEQ] = io_ck_lineseq; | |
560 | RETVAL = SvREFCNT_inc(eval_pv(code,FALSE)); | |
561 | PL_check[OP_LINESEQ] = io_old_ck_lineseq; | |
562 | OUTPUT: | |
563 | RETVAL | |
564 | ||
cf7fe8a2 | 565 | |
63a347c7 JH |
566 | MODULE = IO PACKAGE = IO::Socket |
567 | ||
568 | SysRet | |
569 | sockatmark (sock) | |
570 | InputStream sock | |
571 | PROTOTYPE: $ | |
572 | PREINIT: | |
9ae155c4 | 573 | int fd; |
63a347c7 | 574 | CODE: |
9ae155c4 | 575 | fd = PerlIO_fileno(sock); |
375ed12a JH |
576 | if (fd < 0) { |
577 | errno = EBADF; | |
578 | RETVAL = -1; | |
9ae155c4 JH |
579 | } |
580 | #ifdef HAS_SOCKATMARK | |
581 | else { | |
375ed12a JH |
582 | RETVAL = sockatmark(fd); |
583 | } | |
63a347c7 | 584 | #else |
fa9804ae | 585 | else { |
06c912bc | 586 | int flag = 0; |
6d087280 | 587 | # ifdef SIOCATMARK |
6e22d046 | 588 | # if defined(NETWARE) || defined(WIN32) |
2c2a0333 | 589 | if (ioctl(fd, SIOCATMARK, (char*)&flag) != 0) |
f754b6e0 GS |
590 | # else |
591 | if (ioctl(fd, SIOCATMARK, &flag) != 0) | |
592 | # endif | |
06c912bc | 593 | XSRETURN_UNDEF; |
63a347c7 | 594 | # else |
06c912bc JH |
595 | not_here("IO::Socket::atmark"); |
596 | # endif | |
597 | RETVAL = flag; | |
598 | } | |
63a347c7 | 599 | #endif |
63a347c7 JH |
600 | OUTPUT: |
601 | RETVAL | |
602 | ||
cf7fe8a2 GS |
603 | BOOT: |
604 | { | |
605 | HV *stash; | |
606 | /* | |
607 | * constant subs for IO::Poll | |
608 | */ | |
609 | stash = gv_stashpvn("IO::Poll", 8, TRUE); | |
610 | #ifdef POLLIN | |
611 | newCONSTSUB(stash,"POLLIN",newSViv(POLLIN)); | |
612 | #endif | |
613 | #ifdef POLLPRI | |
614 | newCONSTSUB(stash,"POLLPRI", newSViv(POLLPRI)); | |
615 | #endif | |
616 | #ifdef POLLOUT | |
617 | newCONSTSUB(stash,"POLLOUT", newSViv(POLLOUT)); | |
618 | #endif | |
619 | #ifdef POLLRDNORM | |
620 | newCONSTSUB(stash,"POLLRDNORM", newSViv(POLLRDNORM)); | |
621 | #endif | |
622 | #ifdef POLLWRNORM | |
623 | newCONSTSUB(stash,"POLLWRNORM", newSViv(POLLWRNORM)); | |
624 | #endif | |
625 | #ifdef POLLRDBAND | |
626 | newCONSTSUB(stash,"POLLRDBAND", newSViv(POLLRDBAND)); | |
627 | #endif | |
628 | #ifdef POLLWRBAND | |
629 | newCONSTSUB(stash,"POLLWRBAND", newSViv(POLLWRBAND)); | |
630 | #endif | |
631 | #ifdef POLLNORM | |
632 | newCONSTSUB(stash,"POLLNORM", newSViv(POLLNORM)); | |
633 | #endif | |
634 | #ifdef POLLERR | |
635 | newCONSTSUB(stash,"POLLERR", newSViv(POLLERR)); | |
636 | #endif | |
637 | #ifdef POLLHUP | |
638 | newCONSTSUB(stash,"POLLHUP", newSViv(POLLHUP)); | |
639 | #endif | |
640 | #ifdef POLLNVAL | |
641 | newCONSTSUB(stash,"POLLNVAL", newSViv(POLLNVAL)); | |
642 | #endif | |
643 | /* | |
644 | * constant subs for IO::Handle | |
645 | */ | |
646 | stash = gv_stashpvn("IO::Handle", 10, TRUE); | |
647 | #ifdef _IOFBF | |
648 | newCONSTSUB(stash,"_IOFBF", newSViv(_IOFBF)); | |
649 | #endif | |
650 | #ifdef _IOLBF | |
651 | newCONSTSUB(stash,"_IOLBF", newSViv(_IOLBF)); | |
652 | #endif | |
653 | #ifdef _IONBF | |
654 | newCONSTSUB(stash,"_IONBF", newSViv(_IONBF)); | |
655 | #endif | |
656 | #ifdef SEEK_SET | |
657 | newCONSTSUB(stash,"SEEK_SET", newSViv(SEEK_SET)); | |
658 | #endif | |
659 | #ifdef SEEK_CUR | |
660 | newCONSTSUB(stash,"SEEK_CUR", newSViv(SEEK_CUR)); | |
661 | #endif | |
662 | #ifdef SEEK_END | |
663 | newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END)); | |
664 | #endif | |
cf7fe8a2 | 665 | } |
63a347c7 | 666 |