1 #define PERL_NO_GET_CONTEXT
11 struct _PerlIO base; /* Base "class" info */
17 PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
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
29 s->var = SvREFCNT_inc(SvRV(arg));
33 s->var = SvREFCNT_inc(perl_get_sv(SvPV_nolen(arg),GV_ADD|GV_ADDMULTI));
38 s->var = newSVpvn("",0);
40 sv_upgrade(s->var,SVt_PV);
41 code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
42 if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
44 if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
45 s->posn = SvCUR(s->var);
52 PerlIOScalar_popped(pTHX_ PerlIO *f)
54 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
64 PerlIOScalar_close(pTHX_ PerlIO *f)
66 IV code = PerlIOBase_close(aTHX_ f);
67 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
72 PerlIOScalar_fileno(pTHX_ PerlIO *f)
78 PerlIOScalar_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
80 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
87 s->posn = offset + s->posn;
90 s->posn = offset + SvCUR(s->var);
93 if ((STRLEN)s->posn > SvCUR(s->var))
95 (void) SvGROW(s->var,(STRLEN)s->posn);
101 PerlIOScalar_tell(pTHX_ PerlIO *f)
103 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
108 PerlIOScalar_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
110 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
111 char *dst = SvGROW(s->var,s->posn+count);
112 Move(vbuf,dst+s->posn,count,char);
114 SvCUR_set(s->var,s->posn);
120 PerlIOScalar_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
122 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
125 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
128 if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
130 dst = SvGROW(sv,SvCUR(sv)+count);
132 s->posn = offset+count;
136 if ((s->posn+count) > SvCUR(sv))
137 dst = SvGROW(sv,s->posn+count);
139 dst = SvPV_nolen(sv);
143 Move(vbuf,dst+offset,count,char);
144 if ((STRLEN)s->posn > SvCUR(sv))
145 SvCUR_set(sv,s->posn);
154 PerlIOScalar_fill(pTHX_ PerlIO *f)
160 PerlIOScalar_flush(pTHX_ PerlIO *f)
166 PerlIOScalar_get_base(pTHX_ PerlIO *f)
168 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
169 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
171 return (STDCHAR *)SvPV_nolen(s->var);
173 return (STDCHAR *) Nullch;
177 PerlIOScalar_get_ptr(pTHX_ PerlIO *f)
179 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
181 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
182 return PerlIOScalar_get_base(aTHX_ f)+s->posn;
184 return (STDCHAR *) Nullch;
188 PerlIOScalar_get_cnt(pTHX_ PerlIO *f)
190 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
192 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
193 if (SvCUR(s->var) > (STRLEN)s->posn)
194 return SvCUR(s->var) - s->posn;
202 PerlIOScalar_bufsiz(pTHX_ PerlIO *f)
204 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
206 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
207 return SvCUR(s->var);
213 PerlIOScalar_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
215 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
216 s->posn = SvCUR(s->var)-cnt;
220 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)
222 SV *arg = (narg > 0) ? *args : PerlIOArg;
223 if (SvROK(arg) || SvPOK(arg))
225 f = PerlIO_allocate(aTHX);
226 (void)PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,arg),PerlIOScalar);
227 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
234 PerlIOScalar_arg(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
236 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
238 if (flags & PERLIO_DUP_CLONE)
239 var = PerlIO_sv_dup(aTHX_ var, param);
240 else if (flags & PERLIO_DUP_FD)
242 /* Equivalent (guesses NI-S) of dup() is to create a new scalar */
247 var = SvREFCNT_inc(var);
249 return newRV_noinc(var);
253 PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
255 if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags)))
257 PerlIOScalar *fs = PerlIOSelf(f,PerlIOScalar);
258 PerlIOScalar *os = PerlIOSelf(o,PerlIOScalar);
259 /* var has been set by implicit push */
265 PerlIO_funcs PerlIO_scalar = {
267 sizeof(PerlIOScalar),
286 PerlIOBase_setlinebuf,
287 PerlIOScalar_get_base,
289 PerlIOScalar_get_ptr,
290 PerlIOScalar_get_cnt,
291 PerlIOScalar_set_ptrcnt,
295 #endif /* Layers available */
297 MODULE = PerlIO::Scalar PACKAGE = PerlIO::Scalar
304 PerlIO_define_layer(aTHX_ &PerlIO_scalar);