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