This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement:
[perl5.git] / ext / PerlIO / Scalar / Scalar.xs
CommitLineData
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
9typedef struct
10{
11 struct _PerlIO base; /* Base "class" info */
12 SV * var;
13 Off_t posn;
14} PerlIOScalar;
15
16IV
17PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
18{
19 PerlIOScalar *b = PerlIOSelf(f,PerlIOScalar);
20 return PerlIOBase_pushed(f,mode,arg);
21}
22
23IV
24PerlIOScalar_popped(PerlIO *f)
25{
26 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
27 if (s->var)
28 {
29 dTHX;
30 SvREFCNT_dec(s->var);
31 s->var = Nullsv;
32 }
33 return 0;
34}
35
36IV
37PerlIOScalar_close(PerlIO *f)
38{
39 dTHX;
40 IV code = PerlIOBase_close(f);
41 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
42 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
43 return code;
44}
45
46IV
47PerlIOScalar_fileno(PerlIO *f)
48{
49 return -1;
50}
51
52IV
53PerlIOScalar_seek(PerlIO *f, Off_t offset, int whence)
54{
55 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
56 switch(whence)
57 {
58 case 0:
59 s->posn = offset;
60 break;
61 case 1:
62 s->posn = offset + s->posn;
63 break;
64 case 2:
65 s->posn = offset + SvCUR(s->var);
66 break;
67 }
68 if (s->posn > SvCUR(s->var))
69 {
70 dTHX;
71 (void) SvGROW(s->var,s->posn);
72 }
73 return 0;
74}
75
76Off_t
77PerlIOScalar_tell(PerlIO *f)
78{
79 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
80 return s->posn;
81}
82
83SSize_t
84PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count)
85{
86 dTHX;
87 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
88 char *dst = SvGROW(s->var,s->posn+count);
89 Move(vbuf,dst,count,char);
90 s->posn += count;
91 SvCUR_set(s->var,s->posn);
92 SvPOK_on(s->var);
93 return count;
94}
95
96SSize_t
97PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count)
98{
99 if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
100 {
101 return PerlIOScalar_unread(f,vbuf,count);
102 }
103 return 0;
104}
105
106IV
107PerlIOScalar_fill(PerlIO *f)
108{
109 return -1;
110}
111
112IV
113PerlIOScalar_flush(PerlIO *f)
114{
115 return 0;
116}
117
118STDCHAR *
119PerlIOScalar_get_base(PerlIO *f)
120{
121 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
122 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
123 {
124 dTHX;
125 return (STDCHAR *)SvPV_nolen(s->var);
126 }
127}
128
129STDCHAR *
130PerlIOScalar_get_ptr(PerlIO *f)
131{
132 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
133 {
134 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
135 return PerlIOScalar_get_base(f)+s->posn;
136 }
137 return (STDCHAR *) Nullch;
138}
139
140SSize_t
141PerlIOScalar_get_cnt(PerlIO *f)
142{
143 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
144 {
145 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
146 return SvCUR(s->var) - s->posn;
147 }
148 return 0;
149}
150
151Size_t
152PerlIOScalar_bufsiz(PerlIO *f)
153{
154 if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
155 {
156 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
157 return SvCUR(s->var);
158 }
159 return 0;
160}
161
162void
163PerlIOScalar_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
164{
165 PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
166 s->posn = SvCUR(s->var)-cnt;
167}
168
169PerlIO *
170PerlIOScalar_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
171{
172 PerlIOScalar *s;
173 if (narg > 0)
174 {
175 SV *ref = *args;
176 if (SvROK(ref))
177 {
178 SV *var = SvRV(ref);
179 sv_upgrade(var,SVt_PV);
180 f = PerlIO_allocate(aTHX);
181 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,PerlIOArg),PerlIOScalar);
182 s->var = SvREFCNT_inc(var);
183 s->posn = 0;
184 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
185 return f;
186 }
187 }
188 return NULL;
189}
190
191
192PerlIO_funcs PerlIO_scalar = {
193 "Scalar",
194 sizeof(PerlIOScalar),
195 PERLIO_K_BUFFERED,
196 PerlIOScalar_pushed,
197 PerlIOScalar_popped,
198 PerlIOScalar_open,
199 NULL,
200 PerlIOScalar_fileno,
201 PerlIOBase_read,
202 PerlIOScalar_unread,
203 PerlIOScalar_write,
204 PerlIOScalar_seek,
205 PerlIOScalar_tell,
206 PerlIOScalar_close,
207 PerlIOScalar_flush,
208 PerlIOScalar_fill,
209 PerlIOBase_eof,
210 PerlIOBase_error,
211 PerlIOBase_clearerr,
212 PerlIOBase_setlinebuf,
213 PerlIOScalar_get_base,
214 PerlIOScalar_bufsiz,
215 PerlIOScalar_get_ptr,
216 PerlIOScalar_get_cnt,
217 PerlIOScalar_set_ptrcnt,
218};
219
220
221#endif /* Layers available */
222
223MODULE = PerlIO::Scalar PACKAGE = PerlIO::Scalar
224
225BOOT:
226{
227#ifdef PERLIO_LAYERS
228 PerlIO_define_layer(aTHX_ &PerlIO_scalar);
229#endif
230}
231