1*0Sstevel@tonic-gate #define PERL_NO_GET_CONTEXT
2*0Sstevel@tonic-gate #include "EXTERN.h"
3*0Sstevel@tonic-gate #include "perl.h"
4*0Sstevel@tonic-gate #include "XSUB.h"
5*0Sstevel@tonic-gate #ifdef PERLIO_LAYERS
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gate #include "perliol.h"
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gate typedef struct {
10*0Sstevel@tonic-gate struct _PerlIO base; /* Base "class" info */
11*0Sstevel@tonic-gate SV *var;
12*0Sstevel@tonic-gate Off_t posn;
13*0Sstevel@tonic-gate } PerlIOScalar;
14*0Sstevel@tonic-gate
15*0Sstevel@tonic-gate IV
PerlIOScalar_pushed(pTHX_ PerlIO * f,const char * mode,SV * arg,PerlIO_funcs * tab)16*0Sstevel@tonic-gate PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
17*0Sstevel@tonic-gate PerlIO_funcs * tab)
18*0Sstevel@tonic-gate {
19*0Sstevel@tonic-gate IV code;
20*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
21*0Sstevel@tonic-gate /* If called (normally) via open() then arg is ref to scalar we are
22*0Sstevel@tonic-gate * using, otherwise arg (from binmode presumably) is either NULL
23*0Sstevel@tonic-gate * or the _name_ of the scalar
24*0Sstevel@tonic-gate */
25*0Sstevel@tonic-gate if (arg) {
26*0Sstevel@tonic-gate if (SvROK(arg)) {
27*0Sstevel@tonic-gate s->var = SvREFCNT_inc(SvRV(arg));
28*0Sstevel@tonic-gate if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
29*0Sstevel@tonic-gate (void)SvPV_nolen(s->var);
30*0Sstevel@tonic-gate }
31*0Sstevel@tonic-gate else {
32*0Sstevel@tonic-gate s->var =
33*0Sstevel@tonic-gate SvREFCNT_inc(perl_get_sv
34*0Sstevel@tonic-gate (SvPV_nolen(arg), GV_ADD | GV_ADDMULTI));
35*0Sstevel@tonic-gate }
36*0Sstevel@tonic-gate }
37*0Sstevel@tonic-gate else {
38*0Sstevel@tonic-gate s->var = newSVpvn("", 0);
39*0Sstevel@tonic-gate }
40*0Sstevel@tonic-gate SvUPGRADE(s->var, SVt_PV);
41*0Sstevel@tonic-gate code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
42*0Sstevel@tonic-gate if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
43*0Sstevel@tonic-gate SvCUR(s->var) = 0;
44*0Sstevel@tonic-gate if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
45*0Sstevel@tonic-gate s->posn = SvCUR(s->var);
46*0Sstevel@tonic-gate else
47*0Sstevel@tonic-gate s->posn = 0;
48*0Sstevel@tonic-gate return code;
49*0Sstevel@tonic-gate }
50*0Sstevel@tonic-gate
51*0Sstevel@tonic-gate IV
PerlIOScalar_popped(pTHX_ PerlIO * f)52*0Sstevel@tonic-gate PerlIOScalar_popped(pTHX_ PerlIO * f)
53*0Sstevel@tonic-gate {
54*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
55*0Sstevel@tonic-gate if (s->var) {
56*0Sstevel@tonic-gate SvREFCNT_dec(s->var);
57*0Sstevel@tonic-gate s->var = Nullsv;
58*0Sstevel@tonic-gate }
59*0Sstevel@tonic-gate return 0;
60*0Sstevel@tonic-gate }
61*0Sstevel@tonic-gate
62*0Sstevel@tonic-gate IV
PerlIOScalar_close(pTHX_ PerlIO * f)63*0Sstevel@tonic-gate PerlIOScalar_close(pTHX_ PerlIO * f)
64*0Sstevel@tonic-gate {
65*0Sstevel@tonic-gate IV code = PerlIOBase_close(aTHX_ f);
66*0Sstevel@tonic-gate PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
67*0Sstevel@tonic-gate return code;
68*0Sstevel@tonic-gate }
69*0Sstevel@tonic-gate
70*0Sstevel@tonic-gate IV
PerlIOScalar_fileno(pTHX_ PerlIO * f)71*0Sstevel@tonic-gate PerlIOScalar_fileno(pTHX_ PerlIO * f)
72*0Sstevel@tonic-gate {
73*0Sstevel@tonic-gate return -1;
74*0Sstevel@tonic-gate }
75*0Sstevel@tonic-gate
76*0Sstevel@tonic-gate IV
PerlIOScalar_seek(pTHX_ PerlIO * f,Off_t offset,int whence)77*0Sstevel@tonic-gate PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
78*0Sstevel@tonic-gate {
79*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
80*0Sstevel@tonic-gate switch (whence) {
81*0Sstevel@tonic-gate case 0:
82*0Sstevel@tonic-gate s->posn = offset;
83*0Sstevel@tonic-gate break;
84*0Sstevel@tonic-gate case 1:
85*0Sstevel@tonic-gate s->posn = offset + s->posn;
86*0Sstevel@tonic-gate break;
87*0Sstevel@tonic-gate case 2:
88*0Sstevel@tonic-gate s->posn = offset + SvCUR(s->var);
89*0Sstevel@tonic-gate break;
90*0Sstevel@tonic-gate }
91*0Sstevel@tonic-gate if ((STRLEN) s->posn > SvCUR(s->var)) {
92*0Sstevel@tonic-gate (void) SvGROW(s->var, (STRLEN) s->posn);
93*0Sstevel@tonic-gate }
94*0Sstevel@tonic-gate return 0;
95*0Sstevel@tonic-gate }
96*0Sstevel@tonic-gate
97*0Sstevel@tonic-gate Off_t
PerlIOScalar_tell(pTHX_ PerlIO * f)98*0Sstevel@tonic-gate PerlIOScalar_tell(pTHX_ PerlIO * f)
99*0Sstevel@tonic-gate {
100*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
101*0Sstevel@tonic-gate return s->posn;
102*0Sstevel@tonic-gate }
103*0Sstevel@tonic-gate
104*0Sstevel@tonic-gate SSize_t
PerlIOScalar_unread(pTHX_ PerlIO * f,const void * vbuf,Size_t count)105*0Sstevel@tonic-gate PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
106*0Sstevel@tonic-gate {
107*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
108*0Sstevel@tonic-gate char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
109*0Sstevel@tonic-gate Move(vbuf, dst + s->posn, count, char);
110*0Sstevel@tonic-gate s->posn += count;
111*0Sstevel@tonic-gate SvCUR_set(s->var, (STRLEN)s->posn);
112*0Sstevel@tonic-gate SvPOK_on(s->var);
113*0Sstevel@tonic-gate return count;
114*0Sstevel@tonic-gate }
115*0Sstevel@tonic-gate
116*0Sstevel@tonic-gate SSize_t
PerlIOScalar_write(pTHX_ PerlIO * f,const void * vbuf,Size_t count)117*0Sstevel@tonic-gate PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
118*0Sstevel@tonic-gate {
119*0Sstevel@tonic-gate if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
120*0Sstevel@tonic-gate Off_t offset;
121*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
122*0Sstevel@tonic-gate SV *sv = s->var;
123*0Sstevel@tonic-gate char *dst;
124*0Sstevel@tonic-gate if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
125*0Sstevel@tonic-gate dst = SvGROW(sv, SvCUR(sv) + count);
126*0Sstevel@tonic-gate offset = SvCUR(sv);
127*0Sstevel@tonic-gate s->posn = offset + count;
128*0Sstevel@tonic-gate }
129*0Sstevel@tonic-gate else {
130*0Sstevel@tonic-gate if ((s->posn + count) > SvCUR(sv))
131*0Sstevel@tonic-gate dst = SvGROW(sv, (STRLEN)s->posn + count);
132*0Sstevel@tonic-gate else
133*0Sstevel@tonic-gate dst = SvPV_nolen(sv);
134*0Sstevel@tonic-gate offset = s->posn;
135*0Sstevel@tonic-gate s->posn += count;
136*0Sstevel@tonic-gate }
137*0Sstevel@tonic-gate Move(vbuf, dst + offset, count, char);
138*0Sstevel@tonic-gate if ((STRLEN) s->posn > SvCUR(sv))
139*0Sstevel@tonic-gate SvCUR_set(sv, (STRLEN)s->posn);
140*0Sstevel@tonic-gate SvPOK_on(s->var);
141*0Sstevel@tonic-gate return count;
142*0Sstevel@tonic-gate }
143*0Sstevel@tonic-gate else
144*0Sstevel@tonic-gate return 0;
145*0Sstevel@tonic-gate }
146*0Sstevel@tonic-gate
147*0Sstevel@tonic-gate IV
PerlIOScalar_fill(pTHX_ PerlIO * f)148*0Sstevel@tonic-gate PerlIOScalar_fill(pTHX_ PerlIO * f)
149*0Sstevel@tonic-gate {
150*0Sstevel@tonic-gate return -1;
151*0Sstevel@tonic-gate }
152*0Sstevel@tonic-gate
153*0Sstevel@tonic-gate IV
PerlIOScalar_flush(pTHX_ PerlIO * f)154*0Sstevel@tonic-gate PerlIOScalar_flush(pTHX_ PerlIO * f)
155*0Sstevel@tonic-gate {
156*0Sstevel@tonic-gate return 0;
157*0Sstevel@tonic-gate }
158*0Sstevel@tonic-gate
159*0Sstevel@tonic-gate STDCHAR *
PerlIOScalar_get_base(pTHX_ PerlIO * f)160*0Sstevel@tonic-gate PerlIOScalar_get_base(pTHX_ PerlIO * f)
161*0Sstevel@tonic-gate {
162*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
163*0Sstevel@tonic-gate if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
164*0Sstevel@tonic-gate return (STDCHAR *) SvPV_nolen(s->var);
165*0Sstevel@tonic-gate }
166*0Sstevel@tonic-gate return (STDCHAR *) Nullch;
167*0Sstevel@tonic-gate }
168*0Sstevel@tonic-gate
169*0Sstevel@tonic-gate STDCHAR *
PerlIOScalar_get_ptr(pTHX_ PerlIO * f)170*0Sstevel@tonic-gate PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
171*0Sstevel@tonic-gate {
172*0Sstevel@tonic-gate if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
173*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
174*0Sstevel@tonic-gate return PerlIOScalar_get_base(aTHX_ f) + s->posn;
175*0Sstevel@tonic-gate }
176*0Sstevel@tonic-gate return (STDCHAR *) Nullch;
177*0Sstevel@tonic-gate }
178*0Sstevel@tonic-gate
179*0Sstevel@tonic-gate SSize_t
PerlIOScalar_get_cnt(pTHX_ PerlIO * f)180*0Sstevel@tonic-gate PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
181*0Sstevel@tonic-gate {
182*0Sstevel@tonic-gate if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
183*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
184*0Sstevel@tonic-gate if (SvCUR(s->var) > (STRLEN) s->posn)
185*0Sstevel@tonic-gate return SvCUR(s->var) - (STRLEN)s->posn;
186*0Sstevel@tonic-gate else
187*0Sstevel@tonic-gate return 0;
188*0Sstevel@tonic-gate }
189*0Sstevel@tonic-gate return 0;
190*0Sstevel@tonic-gate }
191*0Sstevel@tonic-gate
192*0Sstevel@tonic-gate Size_t
PerlIOScalar_bufsiz(pTHX_ PerlIO * f)193*0Sstevel@tonic-gate PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
194*0Sstevel@tonic-gate {
195*0Sstevel@tonic-gate if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
196*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
197*0Sstevel@tonic-gate return SvCUR(s->var);
198*0Sstevel@tonic-gate }
199*0Sstevel@tonic-gate return 0;
200*0Sstevel@tonic-gate }
201*0Sstevel@tonic-gate
202*0Sstevel@tonic-gate void
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f,STDCHAR * ptr,SSize_t cnt)203*0Sstevel@tonic-gate PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
204*0Sstevel@tonic-gate {
205*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
206*0Sstevel@tonic-gate s->posn = SvCUR(s->var) - cnt;
207*0Sstevel@tonic-gate }
208*0Sstevel@tonic-gate
209*0Sstevel@tonic-gate 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)210*0Sstevel@tonic-gate PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
211*0Sstevel@tonic-gate const char *mode, int fd, int imode, int perm,
212*0Sstevel@tonic-gate PerlIO * f, int narg, SV ** args)
213*0Sstevel@tonic-gate {
214*0Sstevel@tonic-gate SV *arg = (narg > 0) ? *args : PerlIOArg;
215*0Sstevel@tonic-gate if (SvROK(arg) || SvPOK(arg)) {
216*0Sstevel@tonic-gate if (!f) {
217*0Sstevel@tonic-gate f = PerlIO_allocate(aTHX);
218*0Sstevel@tonic-gate }
219*0Sstevel@tonic-gate if ( (f = PerlIO_push(aTHX_ f, self, mode, arg)) ) {
220*0Sstevel@tonic-gate PerlIOBase(f)->flags |= PERLIO_F_OPEN;
221*0Sstevel@tonic-gate }
222*0Sstevel@tonic-gate return f;
223*0Sstevel@tonic-gate }
224*0Sstevel@tonic-gate return NULL;
225*0Sstevel@tonic-gate }
226*0Sstevel@tonic-gate
227*0Sstevel@tonic-gate SV *
PerlIOScalar_arg(pTHX_ PerlIO * f,CLONE_PARAMS * param,int flags)228*0Sstevel@tonic-gate PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
229*0Sstevel@tonic-gate {
230*0Sstevel@tonic-gate PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
231*0Sstevel@tonic-gate SV *var = s->var;
232*0Sstevel@tonic-gate if (flags & PERLIO_DUP_CLONE)
233*0Sstevel@tonic-gate var = PerlIO_sv_dup(aTHX_ var, param);
234*0Sstevel@tonic-gate else if (flags & PERLIO_DUP_FD) {
235*0Sstevel@tonic-gate /* Equivalent (guesses NI-S) of dup() is to create a new scalar */
236*0Sstevel@tonic-gate var = newSVsv(var);
237*0Sstevel@tonic-gate }
238*0Sstevel@tonic-gate else {
239*0Sstevel@tonic-gate var = SvREFCNT_inc(var);
240*0Sstevel@tonic-gate }
241*0Sstevel@tonic-gate return newRV_noinc(var);
242*0Sstevel@tonic-gate }
243*0Sstevel@tonic-gate
244*0Sstevel@tonic-gate PerlIO *
PerlIOScalar_dup(pTHX_ PerlIO * f,PerlIO * o,CLONE_PARAMS * param,int flags)245*0Sstevel@tonic-gate PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
246*0Sstevel@tonic-gate int flags)
247*0Sstevel@tonic-gate {
248*0Sstevel@tonic-gate if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
249*0Sstevel@tonic-gate PerlIOScalar *fs = PerlIOSelf(f, PerlIOScalar);
250*0Sstevel@tonic-gate PerlIOScalar *os = PerlIOSelf(o, PerlIOScalar);
251*0Sstevel@tonic-gate /* var has been set by implicit push */
252*0Sstevel@tonic-gate fs->posn = os->posn;
253*0Sstevel@tonic-gate }
254*0Sstevel@tonic-gate return f;
255*0Sstevel@tonic-gate }
256*0Sstevel@tonic-gate
257*0Sstevel@tonic-gate PerlIO_funcs PerlIO_scalar = {
258*0Sstevel@tonic-gate sizeof(PerlIO_funcs),
259*0Sstevel@tonic-gate "scalar",
260*0Sstevel@tonic-gate sizeof(PerlIOScalar),
261*0Sstevel@tonic-gate PERLIO_K_BUFFERED | PERLIO_K_RAW,
262*0Sstevel@tonic-gate PerlIOScalar_pushed,
263*0Sstevel@tonic-gate PerlIOScalar_popped,
264*0Sstevel@tonic-gate PerlIOScalar_open,
265*0Sstevel@tonic-gate PerlIOBase_binmode,
266*0Sstevel@tonic-gate PerlIOScalar_arg,
267*0Sstevel@tonic-gate PerlIOScalar_fileno,
268*0Sstevel@tonic-gate PerlIOScalar_dup,
269*0Sstevel@tonic-gate PerlIOBase_read,
270*0Sstevel@tonic-gate PerlIOScalar_unread,
271*0Sstevel@tonic-gate PerlIOScalar_write,
272*0Sstevel@tonic-gate PerlIOScalar_seek,
273*0Sstevel@tonic-gate PerlIOScalar_tell,
274*0Sstevel@tonic-gate PerlIOScalar_close,
275*0Sstevel@tonic-gate PerlIOScalar_flush,
276*0Sstevel@tonic-gate PerlIOScalar_fill,
277*0Sstevel@tonic-gate PerlIOBase_eof,
278*0Sstevel@tonic-gate PerlIOBase_error,
279*0Sstevel@tonic-gate PerlIOBase_clearerr,
280*0Sstevel@tonic-gate PerlIOBase_setlinebuf,
281*0Sstevel@tonic-gate PerlIOScalar_get_base,
282*0Sstevel@tonic-gate PerlIOScalar_bufsiz,
283*0Sstevel@tonic-gate PerlIOScalar_get_ptr,
284*0Sstevel@tonic-gate PerlIOScalar_get_cnt,
285*0Sstevel@tonic-gate PerlIOScalar_set_ptrcnt,
286*0Sstevel@tonic-gate };
287*0Sstevel@tonic-gate
288*0Sstevel@tonic-gate
289*0Sstevel@tonic-gate #endif /* Layers available */
290*0Sstevel@tonic-gate
291*0Sstevel@tonic-gate MODULE = PerlIO::scalar PACKAGE = PerlIO::scalar
292*0Sstevel@tonic-gate
293*0Sstevel@tonic-gate PROTOTYPES: ENABLE
294*0Sstevel@tonic-gate
295*0Sstevel@tonic-gate BOOT:
296*0Sstevel@tonic-gate {
297*0Sstevel@tonic-gate #ifdef PERLIO_LAYERS
298*0Sstevel@tonic-gate PerlIO_define_layer(aTHX_ &PerlIO_scalar);
299*0Sstevel@tonic-gate #endif
300*0Sstevel@tonic-gate }
301*0Sstevel@tonic-gate
302