This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change PerlIO_(get|set)pos to take SV *
[perl5.git] / ext / IO / IO.xs
CommitLineData
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
c5be433b 7#define PERL_NO_GET_CONTEXT
8add82fc 8#include "EXTERN.h"
760ac839 9#define PERLIO_NOT_STDIO 1
8add82fc
PP
10#include "perl.h"
11#include "XSUB.h"
cf7fe8a2 12#include "poll.h"
8add82fc
PP
13#ifdef I_UNISTD
14# include <unistd.h>
15#endif
cf7fe8a2 16#if defined(I_FCNTL) || defined(HAS_FCNTL)
760ac839
LW
17# include <fcntl.h>
18#endif
8add82fc 19
2a0cf753 20#ifdef PerlIO
8add82fc 21typedef int SysRet;
760ac839
LW
22typedef PerlIO * InputStream;
23typedef PerlIO * OutputStream;
2a0cf753
PP
24#else
25#define PERLIO_IS_STDIO 1
26typedef int SysRet;
27typedef FILE * InputStream;
28typedef FILE * OutputStream;
29#endif
8add82fc 30
cceca5ed 31#define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
cf7fe8a2
GS
32
33#ifndef gv_stashpvn
34#define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
35#endif
36
8add82fc 37static int
a1ea39dc 38not_here(char *s)
8add82fc
PP
39{
40 croak("%s not implemented on this architecture", s);
41 return -1;
42}
43
cf7fe8a2
GS
44
45#ifndef PerlIO
46#define PerlIO_fileno(f) fileno(f)
8add82fc 47#endif
cf7fe8a2
GS
48
49static int
a1ea39dc 50io_blocking(InputStream f, int block)
cf7fe8a2
GS
51{
52 int RETVAL;
53 if(!f) {
54 errno = EBADF;
55 return -1;
56 }
57#if defined(HAS_FCNTL)
58 RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
59 if (RETVAL >= 0) {
60 int mode = RETVAL;
61#ifdef O_NONBLOCK
766a733e 62 /* POSIX style */
cf7fe8a2 63#if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK
766a733e 64 /* Ooops has O_NDELAY too - make sure we don't
6fd254a4 65 * get SysV behaviour by mistake. */
cf7fe8a2 66
6fd254a4
JH
67 /* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
68 * after a successful F_SETFL of an O_NONBLOCK. */
69 RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1;
70
71 if (block >= 0) {
72 if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) {
73 int ret;
74 mode = (mode & ~O_NDELAY) | O_NONBLOCK;
75 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
76 if(ret < 0)
77 RETVAL = ret;
78 }
79 else
80 if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) {
81 int ret;
82 mode &= ~(O_NONBLOCK | O_NDELAY);
83 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
84 if(ret < 0)
85 RETVAL = ret;
86 }
cf7fe8a2 87 }
8add82fc 88#else
766a733e 89 /* Standard POSIX */
cf7fe8a2
GS
90 RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
91
92 if ((block == 0) && !(mode & O_NONBLOCK)) {
93 int ret;
94 mode |= O_NONBLOCK;
95 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
96 if(ret < 0)
97 RETVAL = ret;
98 }
99 else if ((block > 0) && (mode & O_NONBLOCK)) {
100 int ret;
101 mode &= ~O_NONBLOCK;
102 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
103 if(ret < 0)
104 RETVAL = ret;
105 }
766a733e 106#endif
8add82fc 107#else
cf7fe8a2
GS
108 /* Not POSIX - better have O_NDELAY or we can't cope.
109 * for BSD-ish machines this is an acceptable alternative
766a733e 110 * for SysV we can't tell "would block" from EOF but that is
cf7fe8a2
GS
111 * the way SysV is...
112 */
113 RETVAL = RETVAL & O_NDELAY ? 0 : 1;
114
115 if ((block == 0) && !(mode & O_NDELAY)) {
116 int ret;
117 mode |= O_NDELAY;
118 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
119 if(ret < 0)
120 RETVAL = ret;
121 }
122 else if ((block > 0) && (mode & O_NDELAY)) {
123 int ret;
124 mode &= ~O_NDELAY;
125 ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
126 if(ret < 0)
127 RETVAL = ret;
128 }
8add82fc 129#endif
cf7fe8a2
GS
130 }
131 return RETVAL;
8add82fc 132#else
cf7fe8a2 133 return -1;
8add82fc 134#endif
8add82fc
PP
135}
136
8add82fc
PP
137MODULE = IO PACKAGE = IO::Seekable PREFIX = f
138
139SV *
140fgetpos(handle)
141 InputStream handle
142 CODE:
8add82fc 143 if (handle) {
2a0cf753 144#ifdef PerlIO
766a733e
NIS
145 ST(0) = sv_2mortal(newSV(0));
146 if (PerlIO_getpos(handle, ST(0)) != 0) {
147 ST(0) = &PL_sv_undef;
148 }
2a0cf753 149#else
766a733e 150 if (fgetpos(handle, &pos)) {
a6a714bd
NC
151 ST(0) = &PL_sv_undef;
152 } else {
153 ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
154 }
766a733e 155#endif
8add82fc
PP
156 }
157 else {
a1ea39dc 158 ST(0) = &PL_sv_undef;
8add82fc
PP
159 errno = EINVAL;
160 }
8add82fc
PP
161
162SysRet
163fsetpos(handle, pos)
164 InputStream handle
165 SV * pos
166 CODE:
766a733e 167 if (handle) {
2a0cf753 168#ifdef PerlIO
766a733e 169 RETVAL = PerlIO_setpos(handle, pos);
2a0cf753 170#else
766a733e
NIS
171 char *p;
172 STRLEN len;
173 if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
174 RETVAL = fsetpos(handle, (Fpos_t*)p);
175 }
176 else {
177 RETVAL = -1;
178 errno = EINVAL;
179 }
2a0cf753 180#endif
766a733e 181 }
8add82fc
PP
182 else {
183 RETVAL = -1;
184 errno = EINVAL;
185 }
8add82fc
PP
186 OUTPUT:
187 RETVAL
188
189MODULE = IO PACKAGE = IO::File PREFIX = f
190
a375a877 191SV *
8add82fc
PP
192new_tmpfile(packname = "IO::File")
193 char * packname
a375a877
GB
194 PREINIT:
195 OutputStream fp;
196 GV *gv;
8add82fc 197 CODE:
2a0cf753 198#ifdef PerlIO
a375a877 199 fp = PerlIO_tmpfile();
2a0cf753 200#else
a375a877 201 fp = tmpfile();
2a0cf753 202#endif
a375a877
GB
203 gv = (GV*)SvREFCNT_inc(newGVgen(packname));
204 hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
205 if (do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) {
6d5cdeed 206 ST(0) = sv_2mortal(newRV((SV*)gv));
a375a877 207 sv_bless(ST(0), gv_stashpv(packname, TRUE));
cf7fe8a2 208 SvREFCNT_dec(gv); /* undo increment in newRV() */
a375a877
GB
209 }
210 else {
a1ea39dc 211 ST(0) = &PL_sv_undef;
a375a877
GB
212 SvREFCNT_dec(gv);
213 }
8add82fc 214
cf7fe8a2
GS
215MODULE = IO PACKAGE = IO::Poll
216
766a733e 217void
cf7fe8a2
GS
218_poll(timeout,...)
219 int timeout;
220PPCODE:
221{
222#ifdef HAS_POLL
223 int nfd = (items - 1) / 2;
224 SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
225 struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv);
226 int i,j,ret;
227 for(i=1, j=0 ; j < nfd ; j++) {
228 fds[j].fd = SvIV(ST(i));
229 i++;
230 fds[j].events = SvIV(ST(i));
231 i++;
232 fds[j].revents = 0;
233 }
234 if((ret = poll(fds,nfd,timeout)) >= 0) {
235 for(i=1, j=0 ; j < nfd ; j++) {
236 sv_setiv(ST(i), fds[j].fd); i++;
237 sv_setiv(ST(i), fds[j].revents); i++;
238 }
239 }
240 SvREFCNT_dec(tmpsv);
241 XSRETURN_IV(ret);
242#else
243 not_here("IO::Poll::poll");
244#endif
245}
246
247MODULE = IO PACKAGE = IO::Handle PREFIX = io_
248
249void
250io_blocking(handle,blk=-1)
251 InputStream handle
252 int blk
253PROTOTYPE: $;$
254CODE:
255{
256 int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0);
257 if(ret >= 0)
258 XSRETURN_IV(ret);
259 else
260 XSRETURN_UNDEF;
261}
262
8add82fc
PP
263MODULE = IO PACKAGE = IO::Handle PREFIX = f
264
8add82fc
PP
265
266int
267ungetc(handle, c)
268 InputStream handle
269 int c
270 CODE:
271 if (handle)
2a0cf753 272#ifdef PerlIO
760ac839 273 RETVAL = PerlIO_ungetc(handle, c);
2a0cf753
PP
274#else
275 RETVAL = ungetc(c, handle);
276#endif
8add82fc
PP
277 else {
278 RETVAL = -1;
279 errno = EINVAL;
280 }
281 OUTPUT:
282 RETVAL
283
284int
285ferror(handle)
286 InputStream handle
287 CODE:
288 if (handle)
2a0cf753 289#ifdef PerlIO
760ac839 290 RETVAL = PerlIO_error(handle);
2a0cf753
PP
291#else
292 RETVAL = ferror(handle);
293#endif
294 else {
295 RETVAL = -1;
296 errno = EINVAL;
297 }
298 OUTPUT:
299 RETVAL
300
301int
302clearerr(handle)
303 InputStream handle
304 CODE:
305 if (handle) {
306#ifdef PerlIO
307 PerlIO_clearerr(handle);
308#else
309 clearerr(handle);
310#endif
311 RETVAL = 0;
312 }
8add82fc
PP
313 else {
314 RETVAL = -1;
59629a13
RR
315 errno = EINVAL;
316 }
317 OUTPUT:
318 RETVAL
319
320int
321untaint(handle)
322 SV * handle
323 CODE:
7a4c00b4 324#ifdef IOf_UNTAINT
59629a13
RR
325 IO * io;
326 io = sv_2io(handle);
327 if (io) {
328 IoFLAGS(io) |= IOf_UNTAINT;
329 RETVAL = 0;
330 }
331 else {
7a4c00b4 332#endif
59629a13 333 RETVAL = -1;
8add82fc 334 errno = EINVAL;
7a4c00b4 335#ifdef IOf_UNTAINT
8add82fc 336 }
7a4c00b4 337#endif
8add82fc
PP
338 OUTPUT:
339 RETVAL
340
341SysRet
342fflush(handle)
343 OutputStream handle
344 CODE:
345 if (handle)
2a0cf753 346#ifdef PerlIO
760ac839 347 RETVAL = PerlIO_flush(handle);
2a0cf753
PP
348#else
349 RETVAL = Fflush(handle);
350#endif
8add82fc
PP
351 else {
352 RETVAL = -1;
353 errno = EINVAL;
354 }
355 OUTPUT:
356 RETVAL
357
358void
359setbuf(handle, buf)
360 OutputStream handle
361 char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
362 CODE:
363 if (handle)
760ac839 364#ifdef PERLIO_IS_STDIO
8add82fc 365 setbuf(handle, buf);
760ac839
LW
366#else
367 not_here("IO::Handle::setbuf");
368#endif
8add82fc
PP
369
370SysRet
371setvbuf(handle, buf, type, size)
372 OutputStream handle
373 char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
374 int type
375 int size
376 CODE:
1eeb0f31 377#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
d924de76
IZ
378 if (!handle) /* Try input stream. */
379 handle = IoIFP(sv_2io(ST(0)));
8add82fc
PP
380 if (handle)
381 RETVAL = setvbuf(handle, buf, type, size);
382 else {
383 RETVAL = -1;
384 errno = EINVAL;
385 }
386#else
61839fa9 387 RETVAL = (SysRet) not_here("IO::Handle::setvbuf");
760ac839 388#endif
8add82fc
PP
389 OUTPUT:
390 RETVAL
391
392
cf7fe8a2
GS
393SysRet
394fsync(handle)
395 OutputStream handle
396 CODE:
397#ifdef HAS_FSYNC
398 if(handle)
399 RETVAL = fsync(PerlIO_fileno(handle));
400 else {
401 RETVAL = -1;
402 errno = EINVAL;
403 }
404#else
405 RETVAL = (SysRet) not_here("IO::Handle::sync");
406#endif
407 OUTPUT:
408 RETVAL
409
410
411BOOT:
412{
413 HV *stash;
414 /*
415 * constant subs for IO::Poll
416 */
417 stash = gv_stashpvn("IO::Poll", 8, TRUE);
418#ifdef POLLIN
419 newCONSTSUB(stash,"POLLIN",newSViv(POLLIN));
420#endif
421#ifdef POLLPRI
422 newCONSTSUB(stash,"POLLPRI", newSViv(POLLPRI));
423#endif
424#ifdef POLLOUT
425 newCONSTSUB(stash,"POLLOUT", newSViv(POLLOUT));
426#endif
427#ifdef POLLRDNORM
428 newCONSTSUB(stash,"POLLRDNORM", newSViv(POLLRDNORM));
429#endif
430#ifdef POLLWRNORM
431 newCONSTSUB(stash,"POLLWRNORM", newSViv(POLLWRNORM));
432#endif
433#ifdef POLLRDBAND
434 newCONSTSUB(stash,"POLLRDBAND", newSViv(POLLRDBAND));
435#endif
436#ifdef POLLWRBAND
437 newCONSTSUB(stash,"POLLWRBAND", newSViv(POLLWRBAND));
438#endif
439#ifdef POLLNORM
440 newCONSTSUB(stash,"POLLNORM", newSViv(POLLNORM));
441#endif
442#ifdef POLLERR
443 newCONSTSUB(stash,"POLLERR", newSViv(POLLERR));
444#endif
445#ifdef POLLHUP
446 newCONSTSUB(stash,"POLLHUP", newSViv(POLLHUP));
447#endif
448#ifdef POLLNVAL
449 newCONSTSUB(stash,"POLLNVAL", newSViv(POLLNVAL));
450#endif
451 /*
452 * constant subs for IO::Handle
453 */
454 stash = gv_stashpvn("IO::Handle", 10, TRUE);
455#ifdef _IOFBF
456 newCONSTSUB(stash,"_IOFBF", newSViv(_IOFBF));
457#endif
458#ifdef _IOLBF
459 newCONSTSUB(stash,"_IOLBF", newSViv(_IOLBF));
460#endif
461#ifdef _IONBF
462 newCONSTSUB(stash,"_IONBF", newSViv(_IONBF));
463#endif
464#ifdef SEEK_SET
465 newCONSTSUB(stash,"SEEK_SET", newSViv(SEEK_SET));
466#endif
467#ifdef SEEK_CUR
468 newCONSTSUB(stash,"SEEK_CUR", newSViv(SEEK_CUR));
469#endif
470#ifdef SEEK_END
471 newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
472#endif
cf7fe8a2 473}