[perl5.git] / ext / PerlIO-scalar / scalar.xs

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef PERLIO_LAYERS

#include "perliol.h"

typedef struct {
    struct _PerlIO base;	/* Base "class" info */
    SV *var;
    Off_t posn;
} PerlIOScalar;

IV
PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
		    PerlIO_funcs * tab)
{
    IV code;
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    /* If called (normally) via open() then arg is ref to scalar we are
     * using, otherwise arg (from binmode presumably) is either NULL
     * or the _name_ of the scalar
     */
    if (arg) {
	if (SvROK(arg)) {
	    if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
		if (ckWARN(WARN_LAYER))
		    Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify);
		SETERRNO(EINVAL, SS_IVCHAN);
		return -1;
	    }
	    s->var = SvREFCNT_inc(SvRV(arg));
	    SvGETMAGIC(s->var);
	    if (!SvPOK(s->var) && SvOK(s->var))
		(void)SvPV_nomg_const_nolen(s->var);
	}
	else {
	    s->var =
		SvREFCNT_inc(perl_get_sv
			     (SvPV_nolen(arg), GV_ADD | GV_ADDMULTI));
	}
    }
    else {
	s->var = newSVpvn("", 0);
    }
    SvUPGRADE(s->var, SVt_PV);
    code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
    if (!SvOK(s->var) || (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
    {
	sv_force_normal(s->var);
	SvCUR_set(s->var, 0);
    }
    if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
    {
	sv_force_normal(s->var);
	s->posn = SvCUR(s->var);
    }
    else
	s->posn = 0;
    SvSETMAGIC(s->var);
    return code;
}

IV
PerlIOScalar_popped(pTHX_ PerlIO * f)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    if (s->var) {
	SvREFCNT_dec(s->var);
	s->var = Nullsv;
    }
    return 0;
}

IV
PerlIOScalar_close(pTHX_ PerlIO * f)
{
    IV code = PerlIOBase_close(aTHX_ f);
    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
    return code;
}

IV
PerlIOScalar_fileno(pTHX_ PerlIO * f)
{
    return -1;
}

IV
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    STRLEN oldcur;
    STRLEN newlen;

    SvGETMAGIC(s->var);
    oldcur = SvCUR(s->var);

    switch (whence) {
    case SEEK_SET:
	s->posn = offset;
	break;
    case SEEK_CUR:
	s->posn = offset + s->posn;
	break;
    case SEEK_END:
	s->posn = offset + SvCUR(s->var);
	break;
    }
    if (s->posn < 0) {
        if (ckWARN(WARN_LAYER))
	    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
	SETERRNO(EINVAL, SS_IVCHAN);
	return -1;
    }
    newlen = (STRLEN) s->posn;
    if (newlen > oldcur) {
	(void) SvGROW(s->var, newlen);
	Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
	/* No SvCUR_set(), though.  This is just a seek, not a write. */
    }
    else if (!SvPVX(s->var)) {
	/* ensure there's always a character buffer */
	(void)SvGROW(s->var,1);
    }
    SvPOK_on(s->var);
    return 0;
}

Off_t
PerlIOScalar_tell(pTHX_ PerlIO * f)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    return s->posn;
}


SSize_t
PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
    if (!f)
	return 0;
    if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
	PerlIOBase(f)->flags |= PERLIO_F_ERROR;
	SETERRNO(EBADF, SS_IVCHAN);
	return 0;
    }
    {
	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	SV *sv = s->var;
	char *p;
	STRLEN len, got;
	p = SvPV(sv, len);
	got = len - (STRLEN)(s->posn);
	if (got <= 0)
	    return 0;
	if (got > (STRLEN)count)
	    got = (STRLEN)count;
	Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
	s->posn += (Off_t)got;
	return (SSize_t)got;
    }
}

SSize_t
PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
    if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
	Off_t offset;
	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	SV *sv = s->var;
	char *dst;
	SvGETMAGIC(sv);
	sv_force_normal(sv);
	if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
	    dst = SvGROW(sv, SvCUR(sv) + count);
	    offset = SvCUR(sv);
	    s->posn = offset + count;
	}
	else {
	    if ((s->posn + count) > SvCUR(sv))
		dst = SvGROW(sv, (STRLEN)s->posn + count);
	    else
		dst = SvPVX(sv);
	    offset = s->posn;
	    s->posn += count;
	}
	Move(vbuf, dst + offset, count, char);
	if ((STRLEN) s->posn > SvCUR(sv))
	    SvCUR_set(sv, (STRLEN)s->posn);
	SvPOK_on(sv);
	SvSETMAGIC(sv);
	return count;
    }
    else
	return 0;
}

IV
PerlIOScalar_fill(pTHX_ PerlIO * f)
{
    return -1;
}

IV
PerlIOScalar_flush(pTHX_ PerlIO * f)
{
    return 0;
}

STDCHAR *
PerlIOScalar_get_base(pTHX_ PerlIO * f)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
	SvGETMAGIC(s->var);
	return (STDCHAR *) SvPV_nolen(s->var);
    }
    return (STDCHAR *) NULL;
}

STDCHAR *
PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
{
    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	return PerlIOScalar_get_base(aTHX_ f) + s->posn;
    }
    return (STDCHAR *) NULL;
}

SSize_t
PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
{
    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	SvGETMAGIC(s->var);
	if (SvCUR(s->var) > (STRLEN) s->posn)
	    return SvCUR(s->var) - (STRLEN)s->posn;
	else
	    return 0;
    }
    return 0;
}

Size_t
PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
{
    if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	SvGETMAGIC(s->var);
	return SvCUR(s->var);
    }
    return 0;
}

void
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    SvGETMAGIC(s->var);
    s->posn = SvCUR(s->var) - cnt;
}

PerlIO *
PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
		  const char *mode, int fd, int imode, int perm,
		  PerlIO * f, int narg, SV ** args)
{
    SV *arg = (narg > 0) ? *args : PerlIOArg;
    if (SvROK(arg) || SvPOK(arg)) {
	if (!f) {
	    f = PerlIO_allocate(aTHX);
	}
	if ( (f = PerlIO_push(aTHX_ f, self, mode, arg)) ) {
	    PerlIOBase(f)->flags |= PERLIO_F_OPEN;
	}
	return f;
    }
    return NULL;
}

SV *
PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
{
    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
    SV *var = s->var;
    if (flags & PERLIO_DUP_CLONE)
	var = PerlIO_sv_dup(aTHX_ var, param);
    else if (flags & PERLIO_DUP_FD) {
	/* Equivalent (guesses NI-S) of dup() is to create a new scalar */
	var = newSVsv(var);
    }
    else {
	var = SvREFCNT_inc(var);
    }
    return newRV_noinc(var);
}

PerlIO *
PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
		 int flags)
{
    if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
	PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
	PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
	/* var has been set by implicit push */
	fs->posn = os->posn;
    }
    return f;
}

PERLIO_FUNCS_DECL(PerlIO_scalar) = {
    sizeof(PerlIO_funcs),
    "scalar",
    sizeof(PerlIOScalar),
    PERLIO_K_BUFFERED | PERLIO_K_RAW,
    PerlIOScalar_pushed,
    PerlIOScalar_popped,
    PerlIOScalar_open,
    PerlIOBase_binmode,
    PerlIOScalar_arg,
    PerlIOScalar_fileno,
    PerlIOScalar_dup,
    PerlIOScalar_read,
    NULL, /* unread */
    PerlIOScalar_write,
    PerlIOScalar_seek,
    PerlIOScalar_tell,
    PerlIOScalar_close,
    PerlIOScalar_flush,
    PerlIOScalar_fill,
    PerlIOBase_eof,
    PerlIOBase_error,
    PerlIOBase_clearerr,
    PerlIOBase_setlinebuf,
    PerlIOScalar_get_base,
    PerlIOScalar_bufsiz,
    PerlIOScalar_get_ptr,
    PerlIOScalar_get_cnt,
    PerlIOScalar_set_ptrcnt,
};


#endif /* Layers available */

MODULE = PerlIO::scalar	PACKAGE = PerlIO::scalar

PROTOTYPES: ENABLE

BOOT:
{
#ifdef PERLIO_LAYERS
 PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
#endif
}
Commit	Line	Data
f6c77cf1 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
14d89041 NIS	9	typedef struct {
	10	struct _PerlIO base; /* Base "class" info */
	11	SV *var;
	12	Off_t posn;
f6c77cf1 NIS	13	} PerlIOScalar;
	14
	15	IV
14d89041 NIS	16	PerlIOScalar_pushed(pTHX_ PerlIO * f, const char mode, SV arg,
14d89041 NIS	17	PerlIO_funcs * tab)
f6c77cf1	18	{
14d89041 NIS	19	IV code;
	20	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	21	/* If called (normally) via open() then arg is ref to scalar we are
	22	* using, otherwise arg (from binmode presumably) is either NULL
	23	* or the _name_ of the scalar
	24	*/
	25	if (arg) {
cba44c14	26	if (SvROK(arg)) {
b35bc0c6 RGS	27	if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
b35bc0c6 RGS	28	if (ckWARN(WARN_LAYER))
76c6a213	29	Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify);
42bc49da	30	SETERRNO(EINVAL, SS_IVCHAN);
b35bc0c6 RGS	31	return -1;
b35bc0c6 RGS	32	}
14d89041	33	s->var = SvREFCNT_inc(SvRV(arg));
22ccb26d BM	34	SvGETMAGIC(s->var);
	35	if (!SvPOK(s->var) && SvOK(s->var))
	36	(void)SvPV_nomg_const_nolen(s->var);
14d89041 NIS	37	}
	38	else {
	39	s->var =
	40	SvREFCNT_inc(perl_get_sv
	41	(SvPV_nolen(arg), GV_ADD \| GV_ADDMULTI));
	42	}
564dc057	43	}
14d89041 NIS	44	else {
14d89041 NIS	45	s->var = newSVpvn("", 0);
564dc057	46	}
c5b94a97	47	SvUPGRADE(s->var, SVt_PV);
14d89041	48	code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
47cc46ee	49	if (!SvOK(s->var) \|\| (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
526fd1b4 FC	50	{
526fd1b4 FC	51	sv_force_normal(s->var);
b162af07	52	SvCUR_set(s->var, 0);
526fd1b4	53	}
14d89041	54	if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
526fd1b4 FC	55	{
526fd1b4 FC	56	sv_force_normal(s->var);
14d89041	57	s->posn = SvCUR(s->var);
526fd1b4	58	}
14d89041 NIS	59	else
14d89041 NIS	60	s->posn = 0;
ffe0bb5a	61	SvSETMAGIC(s->var);
14d89041	62	return code;
f6c77cf1 NIS	63	}
	64
	65	IV
14d89041	66	PerlIOScalar_popped(pTHX_ PerlIO * f)
f6c77cf1	67	{
14d89041 NIS	68	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	69	if (s->var) {
	70	SvREFCNT_dec(s->var);
	71	s->var = Nullsv;
	72	}
	73	return 0;
f6c77cf1 NIS	74	}
	75
	76	IV
14d89041	77	PerlIOScalar_close(pTHX_ PerlIO * f)
f6c77cf1	78	{
14d89041 NIS	79	IV code = PerlIOBase_close(aTHX_ f);
	80	PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF \| PERLIO_F_WRBUF);
	81	return code;
f6c77cf1 NIS	82	}
	83
	84	IV
14d89041	85	PerlIOScalar_fileno(pTHX_ PerlIO * f)
f6c77cf1	86	{
14d89041	87	return -1;
f6c77cf1 NIS	88	}
	89
	90	IV
14d89041	91	PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
f6c77cf1	92	{
14d89041	93	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
e94207f0	94	STRLEN oldcur;
42bc49da	95	STRLEN newlen;
e94207f0 NC	96
	97	SvGETMAGIC(s->var);
	98	oldcur = SvCUR(s->var);
	99
14d89041	100	switch (whence) {
42bc49da	101	case SEEK_SET:
14d89041 NIS	102	s->posn = offset;
14d89041 NIS	103	break;
42bc49da	104	case SEEK_CUR:
14d89041 NIS	105	s->posn = offset + s->posn;
14d89041 NIS	106	break;
42bc49da	107	case SEEK_END:
14d89041 NIS	108	s->posn = offset + SvCUR(s->var);
	109	break;
	110	}
42bc49da JH	111	if (s->posn < 0) {
	112	if (ckWARN(WARN_LAYER))
	113	Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
	114	SETERRNO(EINVAL, SS_IVCHAN);
	115	return -1;
14d89041	116	}
42bc49da JH	117	newlen = (STRLEN) s->posn;
	118	if (newlen > oldcur) {
	119	(void) SvGROW(s->var, newlen);
	120	Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
	121	/* No SvCUR_set(), though. This is just a seek, not a write. */
	122	}
8b8eea96 RGS	123	else if (!SvPVX(s->var)) {
	124	/* ensure there's always a character buffer */
	125	(void)SvGROW(s->var,1);
	126	}
42bc49da	127	SvPOK_on(s->var);
14d89041	128	return 0;
f6c77cf1 NIS	129	}
	130
	131	Off_t
14d89041	132	PerlIOScalar_tell(pTHX_ PerlIO * f)
f6c77cf1	133	{
14d89041 NIS	134	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
14d89041 NIS	135	return s->posn;
f6c77cf1 NIS	136	}
f6c77cf1 NIS	137
ffe0bb5a DM	138
	139	SSize_t
	140	PerlIOScalar_read(pTHX_ PerlIO f, void vbuf, Size_t count)
	141	{
	142	if (!f)
	143	return 0;
	144	if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
	145	PerlIOBase(f)->flags \|= PERLIO_F_ERROR;
	146	SETERRNO(EBADF, SS_IVCHAN);
	147	return 0;
	148	}
	149	{
	150	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	151	SV *sv = s->var;
	152	char *p;
	153	STRLEN len, got;
	154	p = SvPV(sv, len);
	155	got = len - (STRLEN)(s->posn);
	156	if (got <= 0)
	157	return 0;
	158	if (got > (STRLEN)count)
	159	got = (STRLEN)count;
	160	Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
	161	s->posn += (Off_t)got;
	162	return (SSize_t)got;
	163	}
	164	}
	165
f6c77cf1	166	SSize_t
14d89041	167	PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
f6c77cf1	168	{
14d89041 NIS	169	if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
	170	Off_t offset;
	171	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	172	SV *sv = s->var;
	173	char *dst;
ffe0bb5a	174	SvGETMAGIC(sv);
526fd1b4	175	sv_force_normal(sv);
14d89041 NIS	176	if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
	177	dst = SvGROW(sv, SvCUR(sv) + count);
	178	offset = SvCUR(sv);
	179	s->posn = offset + count;
	180	}
	181	else {
	182	if ((s->posn + count) > SvCUR(sv))
4a9d6100	183	dst = SvGROW(sv, (STRLEN)s->posn + count);
14d89041	184	else
ffe0bb5a	185	dst = SvPVX(sv);
14d89041 NIS	186	offset = s->posn;
	187	s->posn += count;
	188	}
	189	Move(vbuf, dst + offset, count, char);
	190	if ((STRLEN) s->posn > SvCUR(sv))
4a9d6100	191	SvCUR_set(sv, (STRLEN)s->posn);
ffe0bb5a DM	192	SvPOK_on(sv);
ffe0bb5a DM	193	SvSETMAGIC(sv);
14d89041	194	return count;
09bf542c	195	}
14d89041 NIS	196	else
14d89041 NIS	197	return 0;
f6c77cf1 NIS	198	}
	199
	200	IV
14d89041	201	PerlIOScalar_fill(pTHX_ PerlIO * f)
f6c77cf1	202	{
14d89041	203	return -1;
f6c77cf1 NIS	204	}
	205
	206	IV
14d89041	207	PerlIOScalar_flush(pTHX_ PerlIO * f)
f6c77cf1	208	{
14d89041	209	return 0;
f6c77cf1 NIS	210	}
	211
	212	STDCHAR *
14d89041	213	PerlIOScalar_get_base(pTHX_ PerlIO * f)
f6c77cf1	214	{
14d89041 NIS	215	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
14d89041 NIS	216	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
ffe0bb5a	217	SvGETMAGIC(s->var);
14d89041 NIS	218	return (STDCHAR *) SvPV_nolen(s->var);
14d89041 NIS	219	}
9849c14c	220	return (STDCHAR *) NULL;
f6c77cf1 NIS	221	}
	222
	223	STDCHAR *
14d89041	224	PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
f6c77cf1	225	{
14d89041 NIS	226	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
	227	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	228	return PerlIOScalar_get_base(aTHX_ f) + s->posn;
	229	}
9849c14c	230	return (STDCHAR *) NULL;
f6c77cf1 NIS	231	}
	232
	233	SSize_t
14d89041	234	PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
f6c77cf1	235	{
14d89041 NIS	236	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
14d89041 NIS	237	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
ffe0bb5a	238	SvGETMAGIC(s->var);
14d89041	239	if (SvCUR(s->var) > (STRLEN) s->posn)
4a9d6100	240	return SvCUR(s->var) - (STRLEN)s->posn;
14d89041 NIS	241	else
	242	return 0;
	243	}
75effbe0	244	return 0;
f6c77cf1 NIS	245	}
	246
	247	Size_t
14d89041	248	PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
f6c77cf1	249	{
14d89041 NIS	250	if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
14d89041 NIS	251	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
ffe0bb5a	252	SvGETMAGIC(s->var);
14d89041 NIS	253	return SvCUR(s->var);
	254	}
	255	return 0;
f6c77cf1 NIS	256	}
	257
	258	void
14d89041	259	PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
f6c77cf1	260	{
14d89041	261	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
ffe0bb5a	262	SvGETMAGIC(s->var);
14d89041	263	s->posn = SvCUR(s->var) - cnt;
f6c77cf1 NIS	264	}
	265
	266	PerlIO *
14d89041 NIS	267	PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
	268	const char *mode, int fd, int imode, int perm,
	269	PerlIO * f, int narg, SV ** args)
f6c77cf1	270	{
14d89041 NIS	271	SV arg = (narg > 0) ? args : PerlIOArg;
	272	if (SvROK(arg) \|\| SvPOK(arg)) {
	273	if (!f) {
	274	f = PerlIO_allocate(aTHX);
	275	}
e3feee4e	276	if ( (f = PerlIO_push(aTHX_ f, self, mode, arg)) ) {
14d89041 NIS	277	PerlIOBase(f)->flags \|= PERLIO_F_OPEN;
	278	}
	279	return f;
	280	}
	281	return NULL;
f6c77cf1 NIS	282	}
f6c77cf1 NIS	283
ecdeb87c	284	SV *
14d89041	285	PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
ecdeb87c	286	{
14d89041 NIS	287	PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
	288	SV *var = s->var;
	289	if (flags & PERLIO_DUP_CLONE)
	290	var = PerlIO_sv_dup(aTHX_ var, param);
	291	else if (flags & PERLIO_DUP_FD) {
	292	/* Equivalent (guesses NI-S) of dup() is to create a new scalar */
	293	var = newSVsv(var);
	294	}
	295	else {
	296	var = SvREFCNT_inc(var);
	297	}
	298	return newRV_noinc(var);
ecdeb87c NIS	299	}
ecdeb87c NIS	300
8cf8f3d1	301	PerlIO *
14d89041 NIS	302	PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
14d89041 NIS	303	int flags)
8cf8f3d1	304	{
14d89041 NIS	305	if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
	306	PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
	307	PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
	308	/* var has been set by implicit push */
	309	fs->posn = os->posn;
	310	}
	311	return f;
8cf8f3d1	312	}
f6c77cf1	313
27da23d5	314	PERLIO_FUNCS_DECL(PerlIO_scalar) = {
14d89041 NIS	315	sizeof(PerlIO_funcs),
	316	"scalar",
	317	sizeof(PerlIOScalar),
	318	PERLIO_K_BUFFERED \| PERLIO_K_RAW,
	319	PerlIOScalar_pushed,
	320	PerlIOScalar_popped,
	321	PerlIOScalar_open,
	322	PerlIOBase_binmode,
	323	PerlIOScalar_arg,
	324	PerlIOScalar_fileno,
	325	PerlIOScalar_dup,
ffe0bb5a	326	PerlIOScalar_read,
3ff3a8b6	327	NULL, /* unread */
14d89041 NIS	328	PerlIOScalar_write,
	329	PerlIOScalar_seek,
	330	PerlIOScalar_tell,
	331	PerlIOScalar_close,
	332	PerlIOScalar_flush,
	333	PerlIOScalar_fill,
	334	PerlIOBase_eof,
	335	PerlIOBase_error,
	336	PerlIOBase_clearerr,
	337	PerlIOBase_setlinebuf,
	338	PerlIOScalar_get_base,
	339	PerlIOScalar_bufsiz,
	340	PerlIOScalar_get_ptr,
	341	PerlIOScalar_get_cnt,
	342	PerlIOScalar_set_ptrcnt,
f6c77cf1 NIS	343	};
	344
	345
	346	#endif /* Layers available */
	347
e934609f	348	MODULE = PerlIO::scalar PACKAGE = PerlIO::scalar
f6c77cf1	349
acf4de66 A	350	PROTOTYPES: ENABLE
acf4de66 A	351
f6c77cf1 NIS	352	BOOT:
	353	{
	354	#ifdef PERLIO_LAYERS
27da23d5	355	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
f6c77cf1 NIS	356	#endif
	357	}
	358