line |
stmt |
bran |
cond |
sub |
time |
code |
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
|
|
|
|
|
|
|
9
|
|
|
|
|
|
static const char code_point_warning[] = |
10
|
|
|
|
|
|
"Strings with code points over 0xFF may not be mapped into in-memory file handles\n"; |
11
|
|
|
|
|
|
|
12
|
|
|
|
|
|
typedef struct { |
13
|
|
|
|
|
|
struct _PerlIO base; /* Base "class" info */ |
14
|
|
|
|
|
|
SV *var; |
15
|
|
|
|
|
|
Off_t posn; |
16
|
|
|
|
|
|
} PerlIOScalar; |
17
|
|
|
|
|
|
|
18
|
|
|
|
|
|
IV |
19
|
4390
|
|
|
|
|
PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, |
20
|
|
|
|
|
|
PerlIO_funcs * tab) |
21
|
4386
|
|
|
|
|
{ |
22
|
|
|
|
|
|
IV code; |
23
|
4390
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
24
|
|
|
|
|
|
/* If called (normally) via open() then arg is ref to scalar we are |
25
|
|
|
|
|
|
* using, otherwise arg (from binmode presumably) is either NULL |
26
|
|
|
|
|
|
* or the _name_ of the scalar |
27
|
|
|
|
|
|
*/ |
28
|
4390
|
|
|
|
|
if (arg && SvOK(arg)) { |
29
|
8776
|
|
|
|
|
if (SvROK(arg)) { |
30
|
8780
|
|
|
|
|
if (SvREADONLY(SvRV(arg)) && !SvIsCOW(SvRV(arg)) |
31
|
4398
|
|
|
|
|
&& mode && *mode != 'r') { |
32
|
4
|
|
|
|
|
if (ckWARN(WARN_LAYER)) |
33
|
0
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify); |
34
|
4
|
|
|
|
|
SETERRNO(EINVAL, SS_IVCHAN); |
35
|
4
|
|
|
|
|
return -1; |
36
|
|
|
|
|
|
} |
37
|
8772
|
|
|
|
|
s->var = SvREFCNT_inc(SvRV(arg)); |
38
|
4394
|
|
|
|
|
SvGETMAGIC(s->var); |
39
|
4386
|
|
|
|
|
if (!SvPOK(s->var) && SvOK(s->var)) |
40
|
12
|
|
|
|
|
(void)SvPV_nomg_const_nolen(s->var); |
41
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
else { |
43
|
0
|
|
|
|
|
s->var = |
44
|
0
|
|
|
|
|
SvREFCNT_inc(perl_get_sv |
45
|
|
|
|
|
|
(SvPV_nolen(arg), GV_ADD | GV_ADDMULTI)); |
46
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
else { |
49
|
0
|
|
|
|
|
s->var = newSVpvn("", 0); |
50
|
|
|
|
|
|
} |
51
|
7998
|
|
|
|
|
SvUPGRADE(s->var, SVt_PV); |
52
|
4386
|
|
|
|
|
code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab); |
53
|
4386
|
|
|
|
|
if (!SvOK(s->var) || (PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE) |
54
|
|
|
|
|
|
{ |
55
|
3884
|
|
|
|
|
sv_force_normal(s->var); |
56
|
3884
|
|
|
|
|
SvCUR_set(s->var, 0); |
57
|
|
|
|
|
|
} |
58
|
4386
|
|
|
|
|
if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) { |
59
|
4
|
|
|
|
|
if (ckWARN(WARN_UTF8)) |
60
|
2
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); |
61
|
4
|
|
|
|
|
SETERRNO(EINVAL, SS_IVCHAN); |
62
|
4
|
|
|
|
|
SvREFCNT_dec(s->var); |
63
|
4
|
|
|
|
|
s->var = Nullsv; |
64
|
4
|
|
|
|
|
return -1; |
65
|
|
|
|
|
|
} |
66
|
4382
|
|
|
|
|
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) |
67
|
|
|
|
|
|
{ |
68
|
388
|
|
|
|
|
sv_force_normal(s->var); |
69
|
388
|
|
|
|
|
s->posn = SvCUR(s->var); |
70
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
else |
72
|
3994
|
|
|
|
|
s->posn = 0; |
73
|
4382
|
|
|
|
|
SvSETMAGIC(s->var); |
74
|
|
|
|
|
|
return code; |
75
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
77
|
|
|
|
|
|
IV |
78
|
4390
|
|
|
|
|
PerlIOScalar_popped(pTHX_ PerlIO * f) |
79
|
|
|
|
|
|
{ |
80
|
4390
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
81
|
4390
|
|
|
|
|
if (s->var) { |
82
|
4382
|
|
|
|
|
SvREFCNT_dec(s->var); |
83
|
4382
|
|
|
|
|
s->var = Nullsv; |
84
|
|
|
|
|
|
} |
85
|
4390
|
|
|
|
|
return 0; |
86
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
88
|
|
|
|
|
|
IV |
89
|
4386
|
|
|
|
|
PerlIOScalar_close(pTHX_ PerlIO * f) |
90
|
|
|
|
|
|
{ |
91
|
4386
|
|
|
|
|
IV code = PerlIOBase_close(aTHX_ f); |
92
|
4386
|
|
|
|
|
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); |
93
|
4386
|
|
|
|
|
return code; |
94
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
96
|
|
|
|
|
|
IV |
97
|
4440
|
|
|
|
|
PerlIOScalar_fileno(pTHX_ PerlIO * f) |
98
|
|
|
|
|
|
{ |
99
|
|
|
|
|
|
PERL_UNUSED_ARG(f); |
100
|
4440
|
|
|
|
|
return -1; |
101
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
103
|
|
|
|
|
|
IV |
104
|
112
|
|
|
|
|
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence) |
105
|
|
|
|
|
|
{ |
106
|
112
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
107
|
|
|
|
|
|
|
108
|
112
|
|
|
|
|
switch (whence) { |
109
|
|
|
|
|
|
case SEEK_SET: |
110
|
98
|
|
|
|
|
s->posn = offset; |
111
|
98
|
|
|
|
|
break; |
112
|
|
|
|
|
|
case SEEK_CUR: |
113
|
6
|
|
|
|
|
s->posn = offset + s->posn; |
114
|
6
|
|
|
|
|
break; |
115
|
|
|
|
|
|
case SEEK_END: |
116
|
|
|
|
|
|
{ |
117
|
|
|
|
|
|
STRLEN oldcur; |
118
|
8
|
|
|
|
|
(void)SvPV(s->var, oldcur); |
119
|
8
|
|
|
|
|
s->posn = offset + oldcur; |
120
|
8
|
|
|
|
|
break; |
121
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
} |
123
|
112
|
|
|
|
|
if (s->posn < 0) { |
124
|
6
|
|
|
|
|
if (ckWARN(WARN_LAYER)) |
125
|
0
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string"); |
126
|
6
|
|
|
|
|
SETERRNO(EINVAL, SS_IVCHAN); |
127
|
6
|
|
|
|
|
return -1; |
128
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
return 0; |
130
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
132
|
|
|
|
|
|
Off_t |
133
|
66
|
|
|
|
|
PerlIOScalar_tell(pTHX_ PerlIO * f) |
134
|
|
|
|
|
|
{ |
135
|
66
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
136
|
66
|
|
|
|
|
return s->posn; |
137
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
140
|
|
|
|
|
|
SSize_t |
141
|
148
|
|
|
|
|
PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) |
142
|
|
|
|
|
|
{ |
143
|
148
|
|
|
|
|
if (!f) |
144
|
|
|
|
|
|
return 0; |
145
|
148
|
|
|
|
|
if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) { |
146
|
0
|
|
|
|
|
PerlIOBase(f)->flags |= PERLIO_F_ERROR; |
147
|
0
|
|
|
|
|
SETERRNO(EBADF, SS_IVCHAN); |
148
|
0
|
|
|
|
|
return 0; |
149
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
{ |
151
|
148
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
152
|
148
|
|
|
|
|
SV *sv = s->var; |
153
|
|
|
|
|
|
char *p; |
154
|
|
|
|
|
|
STRLEN len; |
155
|
|
|
|
|
|
I32 got; |
156
|
148
|
|
|
|
|
p = SvPV(sv, len); |
157
|
148
|
|
|
|
|
if (SvUTF8(sv)) { |
158
|
6
|
|
|
|
|
if (sv_utf8_downgrade(sv, TRUE)) { |
159
|
2
|
|
|
|
|
p = SvPV_nomg(sv, len); |
160
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
else { |
162
|
4
|
|
|
|
|
if (ckWARN(WARN_UTF8)) |
163
|
2
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); |
164
|
4
|
|
|
|
|
SETERRNO(EINVAL, SS_IVCHAN); |
165
|
4
|
|
|
|
|
return -1; |
166
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
} |
168
|
144
|
|
|
|
|
got = len - (STRLEN)(s->posn); |
169
|
144
|
|
|
|
|
if (got <= 0) |
170
|
|
|
|
|
|
return 0; |
171
|
40
|
|
|
|
|
if ((STRLEN)got > (STRLEN)count) |
172
|
28
|
|
|
|
|
got = (STRLEN)count; |
173
|
40
|
|
|
|
|
Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR); |
174
|
40
|
|
|
|
|
s->posn += (Off_t)got; |
175
|
40
|
|
|
|
|
return (SSize_t)got; |
176
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
179
|
|
|
|
|
|
SSize_t |
180
|
79906
|
|
|
|
|
PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count) |
181
|
|
|
|
|
|
{ |
182
|
159806
|
|
|
|
|
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { |
183
|
|
|
|
|
|
Off_t offset; |
184
|
79900
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
185
|
79900
|
|
|
|
|
SV *sv = s->var; |
186
|
|
|
|
|
|
char *dst; |
187
|
79904
|
|
|
|
|
SvGETMAGIC(sv); |
188
|
79900
|
|
|
|
|
if (!SvROK(sv)) sv_force_normal(sv); |
189
|
79900
|
|
|
|
|
if (SvOK(sv)) SvPV_force_nomg_nolen(sv); |
190
|
79900
|
|
|
|
|
if (SvUTF8(sv) && !sv_utf8_downgrade(sv, TRUE)) { |
191
|
4
|
|
|
|
|
if (ckWARN(WARN_UTF8)) |
192
|
2
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_UTF8), code_point_warning); |
193
|
4
|
|
|
|
|
SETERRNO(EINVAL, SS_IVCHAN); |
194
|
4
|
|
|
|
|
return 0; |
195
|
|
|
|
|
|
} |
196
|
79896
|
|
|
|
|
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) { |
197
|
882
|
|
|
|
|
dst = SvGROW(sv, SvCUR(sv) + count + 1); |
198
|
882
|
|
|
|
|
offset = SvCUR(sv); |
199
|
882
|
|
|
|
|
s->posn = offset + count; |
200
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
else { |
202
|
79014
|
|
|
|
|
STRLEN const cur = SvCUR(sv); |
203
|
79014
|
|
|
|
|
if (s->posn > cur) { |
204
|
6
|
|
|
|
|
dst = SvGROW(sv, (STRLEN)s->posn + count + 1); |
205
|
6
|
|
|
|
|
Zero(SvPVX(sv) + cur, (STRLEN)s->posn - cur, char); |
206
|
|
|
|
|
|
} |
207
|
79008
|
|
|
|
|
else if ((s->posn + count) >= cur) |
208
|
79002
|
|
|
|
|
dst = SvGROW(sv, (STRLEN)s->posn + count + 1); |
209
|
|
|
|
|
|
else |
210
|
6
|
|
|
|
|
dst = SvPVX(sv); |
211
|
79014
|
|
|
|
|
offset = s->posn; |
212
|
79014
|
|
|
|
|
s->posn += count; |
213
|
|
|
|
|
|
} |
214
|
79896
|
|
|
|
|
Move(vbuf, dst + offset, count, char); |
215
|
79896
|
|
|
|
|
if ((STRLEN) s->posn > SvCUR(sv)) { |
216
|
79880
|
|
|
|
|
SvCUR_set(sv, (STRLEN)s->posn); |
217
|
79880
|
|
|
|
|
dst[(STRLEN) s->posn] = 0; |
218
|
|
|
|
|
|
} |
219
|
79896
|
|
|
|
|
SvPOK_on(sv); |
220
|
79896
|
|
|
|
|
SvSETMAGIC(sv); |
221
|
79896
|
|
|
|
|
return count; |
222
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
else |
224
|
|
|
|
|
|
return 0; |
225
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
227
|
|
|
|
|
|
IV |
228
|
6
|
|
|
|
|
PerlIOScalar_fill(pTHX_ PerlIO * f) |
229
|
|
|
|
|
|
{ |
230
|
|
|
|
|
|
PERL_UNUSED_ARG(f); |
231
|
6
|
|
|
|
|
return -1; |
232
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
234
|
|
|
|
|
|
IV |
235
|
4764
|
|
|
|
|
PerlIOScalar_flush(pTHX_ PerlIO * f) |
236
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
PERL_UNUSED_ARG(f); |
238
|
4764
|
|
|
|
|
return 0; |
239
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
241
|
|
|
|
|
|
STDCHAR * |
242
|
318
|
|
|
|
|
PerlIOScalar_get_base(pTHX_ PerlIO * f) |
243
|
|
|
|
|
|
{ |
244
|
318
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
245
|
636
|
|
|
|
|
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { |
246
|
322
|
|
|
|
|
SvGETMAGIC(s->var); |
247
|
318
|
|
|
|
|
return (STDCHAR *) SvPV_nolen(s->var); |
248
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
return (STDCHAR *) NULL; |
250
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
252
|
|
|
|
|
|
STDCHAR * |
253
|
318
|
|
|
|
|
PerlIOScalar_get_ptr(pTHX_ PerlIO * f) |
254
|
|
|
|
|
|
{ |
255
|
318
|
|
|
|
|
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { |
256
|
318
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
257
|
318
|
|
|
|
|
return PerlIOScalar_get_base(aTHX_ f) + s->posn; |
258
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
return (STDCHAR *) NULL; |
260
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
262
|
|
|
|
|
|
SSize_t |
263
|
350
|
|
|
|
|
PerlIOScalar_get_cnt(pTHX_ PerlIO * f) |
264
|
|
|
|
|
|
{ |
265
|
700
|
|
|
|
|
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { |
266
|
350
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
267
|
|
|
|
|
|
STRLEN len; |
268
|
354
|
|
|
|
|
SvGETMAGIC(s->var); |
269
|
350
|
|
|
|
|
if (isGV_with_GP(s->var)) |
270
|
8
|
|
|
|
|
(void)SvPV(s->var,len); |
271
|
342
|
|
|
|
|
else len = SvCUR(s->var); |
272
|
350
|
|
|
|
|
if (len > (STRLEN) s->posn) |
273
|
196
|
|
|
|
|
return len - (STRLEN)s->posn; |
274
|
|
|
|
|
|
else |
275
|
|
|
|
|
|
return 0; |
276
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
return 0; |
278
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
280
|
|
|
|
|
|
Size_t |
281
|
0
|
|
|
|
|
PerlIOScalar_bufsiz(pTHX_ PerlIO * f) |
282
|
|
|
|
|
|
{ |
283
|
0
|
|
|
|
|
if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { |
284
|
0
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
285
|
0
|
|
|
|
|
SvGETMAGIC(s->var); |
286
|
0
|
|
|
|
|
return SvCUR(s->var); |
287
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
return 0; |
289
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
291
|
|
|
|
|
|
void |
292
|
318
|
|
|
|
|
PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt) |
293
|
318
|
|
|
|
|
{ |
294
|
318
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
295
|
|
|
|
|
|
STRLEN len; |
296
|
|
|
|
|
|
PERL_UNUSED_ARG(ptr); |
297
|
322
|
|
|
|
|
SvGETMAGIC(s->var); |
298
|
318
|
|
|
|
|
if (isGV_with_GP(s->var)) (void)SvPV(s->var,len); |
299
|
310
|
|
|
|
|
else len = SvCUR(s->var); |
300
|
318
|
|
|
|
|
s->posn = len - cnt; |
301
|
318
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
303
|
|
|
|
|
|
PerlIO * |
304
|
4386
|
|
|
|
|
PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n, |
305
|
|
|
|
|
|
const char *mode, int fd, int imode, int perm, |
306
|
|
|
|
|
|
PerlIO * f, int narg, SV ** args) |
307
|
|
|
|
|
|
{ |
308
|
4386
|
|
|
|
|
SV *arg = (narg > 0) ? *args : PerlIOArg; |
309
|
|
|
|
|
|
PERL_UNUSED_ARG(fd); |
310
|
|
|
|
|
|
PERL_UNUSED_ARG(imode); |
311
|
|
|
|
|
|
PERL_UNUSED_ARG(perm); |
312
|
4386
|
|
|
|
|
if (SvROK(arg) || SvPOK(arg)) { |
313
|
4386
|
|
|
|
|
if (!f) { |
314
|
4386
|
|
|
|
|
f = PerlIO_allocate(aTHX); |
315
|
|
|
|
|
|
} |
316
|
4386
|
|
|
|
|
if ( (f = PerlIO_push(aTHX_ f, self, mode, arg)) ) { |
317
|
4378
|
|
|
|
|
PerlIOBase(f)->flags |= PERLIO_F_OPEN; |
318
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
return f; |
320
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
return NULL; |
322
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
324
|
|
|
|
|
|
SV * |
325
|
8
|
|
|
|
|
PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) |
326
|
|
|
|
|
|
{ |
327
|
8
|
|
|
|
|
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); |
328
|
8
|
|
|
|
|
SV *var = s->var; |
329
|
8
|
|
|
|
|
if (flags & PERLIO_DUP_CLONE) |
330
|
0
|
|
|
|
|
var = PerlIO_sv_dup(aTHX_ var, param); |
331
|
8
|
|
|
|
|
else if (flags & PERLIO_DUP_FD) { |
332
|
|
|
|
|
|
/* Equivalent (guesses NI-S) of dup() is to create a new scalar */ |
333
|
4
|
|
|
|
|
var = newSVsv(var); |
334
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
else { |
336
|
|
|
|
|
|
var = SvREFCNT_inc(var); |
337
|
|
|
|
|
|
} |
338
|
8
|
|
|
|
|
return newRV_noinc(var); |
339
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
341
|
|
|
|
|
|
PerlIO * |
342
|
4
|
|
|
|
|
PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param, |
343
|
|
|
|
|
|
int flags) |
344
|
|
|
|
|
|
{ |
345
|
|
|
|
|
|
/* Duplication causes the scalar layer to be pushed on to clone, caus- |
346
|
|
|
|
|
|
ing the cloned scalar to be set to the empty string by |
347
|
|
|
|
|
|
PerlIOScalar_pushed. So set aside our scalar temporarily. */ |
348
|
4
|
|
|
|
|
PerlIOScalar * const os = PerlIOSelf(o, PerlIOScalar); |
349
|
|
|
|
|
|
PerlIOScalar *fs; |
350
|
4
|
|
|
|
|
SV * const var = os->var; |
351
|
4
|
|
|
|
|
os->var = newSVpvs(""); |
352
|
4
|
|
|
|
|
if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) { |
353
|
4
|
|
|
|
|
fs = PerlIOSelf(f, PerlIOScalar); |
354
|
|
|
|
|
|
/* var has been set by implicit push, so replace it */ |
355
|
4
|
|
|
|
|
SvREFCNT_dec(fs->var); |
356
|
|
|
|
|
|
} |
357
|
4
|
|
|
|
|
SvREFCNT_dec(os->var); |
358
|
4
|
|
|
|
|
os->var = var; |
359
|
4
|
|
|
|
|
if (f) { |
360
|
4
|
|
|
|
|
SV * const rv = PerlIOScalar_arg(aTHX_ o, param, flags); |
361
|
8
|
|
|
|
|
fs->var = SvREFCNT_inc(SvRV(rv)); |
362
|
4
|
|
|
|
|
SvREFCNT_dec(rv); |
363
|
4
|
|
|
|
|
fs->posn = os->posn; |
364
|
|
|
|
|
|
} |
365
|
4
|
|
|
|
|
return f; |
366
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
368
|
|
|
|
|
|
PERLIO_FUNCS_DECL(PerlIO_scalar) = { |
369
|
|
|
|
|
|
sizeof(PerlIO_funcs), |
370
|
|
|
|
|
|
"scalar", |
371
|
|
|
|
|
|
sizeof(PerlIOScalar), |
372
|
|
|
|
|
|
PERLIO_K_BUFFERED | PERLIO_K_RAW, |
373
|
|
|
|
|
|
PerlIOScalar_pushed, |
374
|
|
|
|
|
|
PerlIOScalar_popped, |
375
|
|
|
|
|
|
PerlIOScalar_open, |
376
|
|
|
|
|
|
PerlIOBase_binmode, |
377
|
|
|
|
|
|
PerlIOScalar_arg, |
378
|
|
|
|
|
|
PerlIOScalar_fileno, |
379
|
|
|
|
|
|
PerlIOScalar_dup, |
380
|
|
|
|
|
|
PerlIOScalar_read, |
381
|
|
|
|
|
|
NULL, /* unread */ |
382
|
|
|
|
|
|
PerlIOScalar_write, |
383
|
|
|
|
|
|
PerlIOScalar_seek, |
384
|
|
|
|
|
|
PerlIOScalar_tell, |
385
|
|
|
|
|
|
PerlIOScalar_close, |
386
|
|
|
|
|
|
PerlIOScalar_flush, |
387
|
|
|
|
|
|
PerlIOScalar_fill, |
388
|
|
|
|
|
|
PerlIOBase_eof, |
389
|
|
|
|
|
|
PerlIOBase_error, |
390
|
|
|
|
|
|
PerlIOBase_clearerr, |
391
|
|
|
|
|
|
PerlIOBase_setlinebuf, |
392
|
|
|
|
|
|
PerlIOScalar_get_base, |
393
|
|
|
|
|
|
PerlIOScalar_bufsiz, |
394
|
|
|
|
|
|
PerlIOScalar_get_ptr, |
395
|
|
|
|
|
|
PerlIOScalar_get_cnt, |
396
|
|
|
|
|
|
PerlIOScalar_set_ptrcnt, |
397
|
|
|
|
|
|
}; |
398
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
400
|
|
|
|
|
|
#endif /* Layers available */ |
401
|
|
|
|
|
|
|
402
|
|
|
|
|
|
MODULE = PerlIO::scalar PACKAGE = PerlIO::scalar |
403
|
|
|
|
|
|
|
404
|
|
|
|
|
|
PROTOTYPES: ENABLE |
405
|
|
|
|
|
|
|
406
|
|
|
|
|
|
BOOT: |
407
|
|
|
|
|
|
{ |
408
|
|
|
|
|
|
#ifdef PERLIO_LAYERS |
409
|
130
|
|
|
|
|
PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar)); |
410
|
|
|
|
|
|
#endif |
411
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|