1 #define PERL_NO_GET_CONTEXT
11 struct _PerlIO base; /* Base "class" info */
17 PerlIOScalar_pushed(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);
42 return PerlIOBase_pushed(f,mode,Nullsv);
46 PerlIOScalar_popped(PerlIO *f)
48 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
59 PerlIOScalar_close(PerlIO *f)
62 IV code = PerlIOBase_close(f);
63 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
64 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
69 PerlIOScalar_fileno(PerlIO *f)
75 PerlIOScalar_seek(PerlIO *f, Off_t offset, int whence)
77 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
84 s->posn = offset + s->posn;
87 s->posn = offset + SvCUR(s->var);
90 if (s->posn > SvCUR(s->var))
93 (void) SvGROW(s->var,s->posn);
99 PerlIOScalar_tell(PerlIO *f)
101 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
106 PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count)
109 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
110 char *dst = SvGROW(s->var,s->posn+count);
111 Move(vbuf,dst+s->posn,count,char);
113 SvCUR_set(s->var,s->posn);
119 PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count)
121 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
123 return PerlIOScalar_unread(f,vbuf,count);
129 PerlIOScalar_fill(PerlIO *f)
135 PerlIOScalar_flush(PerlIO *f)
141 PerlIOScalar_get_base(PerlIO *f)
143 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
144 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
147 return (STDCHAR *)SvPV_nolen(s->var);
149 return (STDCHAR *) Nullch;
153 PerlIOScalar_get_ptr(PerlIO *f)
155 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
157 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
158 return PerlIOScalar_get_base(f)+s->posn;
160 return (STDCHAR *) Nullch;
164 PerlIOScalar_get_cnt(PerlIO *f)
166 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
168 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
169 return SvCUR(s->var) - s->posn;
175 PerlIOScalar_bufsiz(PerlIO *f)
177 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
179 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
180 return SvCUR(s->var);
186 PerlIOScalar_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
188 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
189 s->posn = SvCUR(s->var)-cnt;
193 PerlIOScalar_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
196 SV *arg = (narg > 0) ? *args : PerlIOArg;
197 if (SvROK(arg) || SvPOK(arg))
199 f = PerlIO_allocate(aTHX);
200 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,arg),PerlIOScalar);
201 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
208 PerlIO_funcs PerlIO_scalar = {
210 sizeof(PerlIOScalar),
228 PerlIOBase_setlinebuf,
229 PerlIOScalar_get_base,
231 PerlIOScalar_get_ptr,
232 PerlIOScalar_get_cnt,
233 PerlIOScalar_set_ptrcnt,
237 #endif /* Layers available */
239 MODULE = PerlIO::Scalar PACKAGE = PerlIO::Scalar
246 PerlIO_define_layer(aTHX_ &PerlIO_scalar);