[p5sagit/p5-mst-13.2.git] / ext / FileHandle / FileHandle.xs

#include "EXTERN.h"
#define PERLIO_NOT_STDIO 1
#include "perl.h"
#include "XSUB.h"

typedef int SysRet;
typedef PerlIO * InputStream;
typedef PerlIO * OutputStream;

static int
not_here(s)
char *s;
{
    croak("FileHandle::%s not implemented on this architecture", s);
    return -1;
}

static bool
constant(name, pval)
char *name;
IV *pval;
{
    switch (*name) {
    case '_':
	if (strEQ(name, "_IOFBF"))
#ifdef _IOFBF
	    { *pval = _IOFBF; return TRUE; }
#else
	    return FALSE;
#endif
	if (strEQ(name, "_IOLBF"))
#ifdef _IOLBF
	    { *pval = _IOLBF; return TRUE; }
#else
	    return FALSE;
#endif
	if (strEQ(name, "_IONBF"))
#ifdef _IONBF
	    { *pval = _IONBF; return TRUE; }
#else
	    return FALSE;
#endif
	break;
    }

    return FALSE;
}


MODULE = FileHandle	PACKAGE = FileHandle	PREFIX = f

SV *
constant(name)
	char *		name
    CODE:
	IV i;
	if (constant(name, &i))
	    RETVAL = newSViv(i);
	else
	    RETVAL = &sv_undef;
    OUTPUT:
	RETVAL

SV *
fgetpos(handle)
	InputStream	handle
    CODE:
	if (handle) {
	    Fpos_t pos;
	    PerlIO_getpos(handle, &pos);
	    ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
	}
	else {
	    ST(0) = &sv_undef;
	    errno = EINVAL;
	}

SysRet
fsetpos(handle, pos)
	InputStream	handle
	SV *		pos
    CODE:
	if (handle)
	    RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
	else {
	    RETVAL = -1;
	    errno = EINVAL;
	}
    OUTPUT:
	RETVAL

int
ungetc(handle, c)
	InputStream	handle
	int		c
    CODE:
	if (handle)
	    RETVAL = PerlIO_ungetc(handle, c);
	else {
	    RETVAL = -1;
	    errno = EINVAL;
	}
    OUTPUT:
	RETVAL

OutputStream
new_tmpfile(packname = "FileHandle")
    char *		packname
    CODE:
	RETVAL = PerlIO_tmpfile();
    OUTPUT:
	RETVAL

int
ferror(handle)
	InputStream	handle
    CODE:
	if (handle)
	    RETVAL = PerlIO_error(handle);
	else {
	    RETVAL = -1;
	    errno = EINVAL;
	}
    OUTPUT:
	RETVAL

SysRet
fflush(handle)
	OutputStream	handle
    CODE:
	if (handle)
	    RETVAL = PerlIO_flush(handle);
	else {
	    RETVAL = -1;
	    errno = EINVAL;
	}
    OUTPUT:
	RETVAL

void
setbuf(handle, buf)
	OutputStream	handle
	char *		buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
    CODE:
#ifdef PERLIO_IS_STDIO
	if (handle)
	    setbuf(handle, buf);
#else
	not_here("setbuf");
#endif


SysRet
setvbuf(handle, buf, type, size)
	OutputStream	handle
	char *		buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
	int		type
	int		size
    CODE:
#ifdef PERLIO_IS_STDIO
#ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
	if (handle)
	    RETVAL = setvbuf(handle, buf, type, size);
	else {
	    RETVAL = -1;
	    errno = EINVAL;
	}
#else
	    RETVAL = (SysRet) not_here("setvbuf");
#endif /* _IOFBF */
#else
	RETVAL = (SysRet) not_here("setvbuf");
#endif
    OUTPUT:
	RETVAL
Commit	Line	Data
c07a80fd	1	#include "EXTERN.h"
760ac839	2	#define PERLIO_NOT_STDIO 1
c07a80fd	3	#include "perl.h"
c07a80fd	4	#include "XSUB.h"
c07a80fd	5
c07a80fd	6	typedef int SysRet;
760ac839	7	typedef PerlIO * InputStream;
760ac839	8	typedef PerlIO * OutputStream;
c07a80fd	9
80368503	10	static int
	11	not_here(s)
	12	char *s;
	13	{
	14	croak("FileHandle::%s not implemented on this architecture", s);
	15	return -1;
	16	}
	17
c07a80fd	18	static bool
	19	constant(name, pval)
	20	char *name;
	21	IV *pval;
	22	{
	23	switch (*name) {
	24	case '_':
	25	if (strEQ(name, "_IOFBF"))
	26	#ifdef _IOFBF
	27	{ *pval = _IOFBF; return TRUE; }
	28	#else
	29	return FALSE;
	30	#endif
	31	if (strEQ(name, "_IOLBF"))
	32	#ifdef _IOLBF
	33	{ *pval = _IOLBF; return TRUE; }
	34	#else
	35	return FALSE;
	36	#endif
	37	if (strEQ(name, "_IONBF"))
	38	#ifdef _IONBF
	39	{ *pval = _IONBF; return TRUE; }
	40	#else
	41	return FALSE;
	42	#endif
	43	break;
	44	}
	45
	46	return FALSE;
	47	}
	48
	49
	50	MODULE = FileHandle PACKAGE = FileHandle PREFIX = f
	51
	52	SV *
	53	constant(name)
	54	char * name
	55	CODE:
	56	IV i;
	57	if (constant(name, &i))
	58	RETVAL = newSViv(i);
	59	else
	60	RETVAL = &sv_undef;
	61	OUTPUT:
	62	RETVAL
	63
	64	SV *
	65	fgetpos(handle)
	66	InputStream handle
	67	CODE:
	68	if (handle) {
	69	Fpos_t pos;
760ac839	70	PerlIO_getpos(handle, &pos);
c07a80fd	71	ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
	72	}
	73	else {
	74	ST(0) = &sv_undef;
	75	errno = EINVAL;
	76	}
	77
	78	SysRet
	79	fsetpos(handle, pos)
	80	InputStream handle
	81	SV * pos
	82	CODE:
	83	if (handle)
760ac839	84	RETVAL = PerlIO_setpos(handle, (Fpos_t*)SvPVX(pos));
c07a80fd	85	else {
	86	RETVAL = -1;
	87	errno = EINVAL;
	88	}
	89	OUTPUT:
	90	RETVAL
	91
	92	int
	93	ungetc(handle, c)
	94	InputStream handle
	95	int c
	96	CODE:
	97	if (handle)
760ac839	98	RETVAL = PerlIO_ungetc(handle, c);
c07a80fd	99	else {
	100	RETVAL = -1;
	101	errno = EINVAL;
	102	}
	103	OUTPUT:
	104	RETVAL
	105
	106	OutputStream
	107	new_tmpfile(packname = "FileHandle")
	108	char * packname
	109	CODE:
760ac839	110	RETVAL = PerlIO_tmpfile();
c07a80fd	111	OUTPUT:
	112	RETVAL
	113
	114	int
	115	ferror(handle)
	116	InputStream handle
	117	CODE:
	118	if (handle)
760ac839	119	RETVAL = PerlIO_error(handle);
c07a80fd	120	else {
	121	RETVAL = -1;
	122	errno = EINVAL;
	123	}
	124	OUTPUT:
	125	RETVAL
	126
	127	SysRet
	128	fflush(handle)
	129	OutputStream handle
	130	CODE:
	131	if (handle)
760ac839	132	RETVAL = PerlIO_flush(handle);
c07a80fd	133	else {
	134	RETVAL = -1;
	135	errno = EINVAL;
	136	}
	137	OUTPUT:
	138	RETVAL
	139
	140	void
	141	setbuf(handle, buf)
	142	OutputStream handle
	143	char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0;
	144	CODE:
760ac839	145	#ifdef PERLIO_IS_STDIO
c07a80fd	146	if (handle)
c07a80fd	147	setbuf(handle, buf);
760ac839	148	#else
	149	not_here("setbuf");
	150	#endif
c07a80fd	151
c07a80fd	152
	153	SysRet
	154	setvbuf(handle, buf, type, size)
	155	OutputStream handle
	156	char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0;
	157	int type
	158	int size
	159	CODE:
760ac839	160	#ifdef PERLIO_IS_STDIO
80368503	161	#ifdef _IOFBF /* Should be HAS_SETVBUF once Configure tests for that */
c07a80fd	162	if (handle)
	163	RETVAL = setvbuf(handle, buf, type, size);
	164	else {
	165	RETVAL = -1;
	166	errno = EINVAL;
	167	}
80368503	168	#else
	169	RETVAL = (SysRet) not_here("setvbuf");
	170	#endif /* _IOFBF */
760ac839	171	#else
	172	RETVAL = (SysRet) not_here("setvbuf");
	173	#endif
c07a80fd	174	OUTPUT:
	175	RETVAL
	176