… | |
… | |
2 | #include "perl.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
3 | #include "XSUB.h" |
4 | |
4 | |
5 | #define RETCOPY(sv) \ |
5 | #define RETCOPY(sv) \ |
6 | if (GIMME_V != G_VOID) \ |
6 | if (GIMME_V != G_VOID) \ |
7 | { \ |
7 | { \ |
8 | dXSTARG; \ |
8 | dXSTARG; \ |
9 | sv_setsv (TARG, (sv)); \ |
9 | sv_setsv (TARG, (sv)); \ |
10 | EXTEND (SP, 1); \ |
10 | EXTEND (SP, 1); \ |
11 | PUSHs (TARG); \ |
11 | PUSHs (TARG); \ |
12 | } |
12 | } |
13 | |
13 | |
|
|
14 | static void |
|
|
15 | extend (SV *scalar, STRLEN addlen) |
|
|
16 | { |
|
|
17 | SvUPGRADE (scalar, SVt_PV); |
|
|
18 | |
|
|
19 | STRLEN cur = SvCUR (scalar); |
|
|
20 | STRLEN len = SvLEN (scalar); |
|
|
21 | |
|
|
22 | if (cur + addlen < len) |
|
|
23 | return; |
|
|
24 | |
|
|
25 | STRLEN l = len; |
|
|
26 | STRLEN o = cur + addlen >= 4096 ? sizeof (void *) * 4 : 0; |
|
|
27 | |
|
|
28 | if (l < 64) |
|
|
29 | l = 64; |
|
|
30 | |
|
|
31 | /* for big sizes, leave a bit of space for malloc management, and assume 4kb or smaller pages */ |
|
|
32 | addlen += o; |
|
|
33 | |
|
|
34 | while (cur + addlen >= l) |
|
|
35 | l <<= 1; |
|
|
36 | |
|
|
37 | sv_grow (scalar, l - o); |
|
|
38 | } |
|
|
39 | |
14 | MODULE = Convert::Scalar PACKAGE = Convert::Scalar |
40 | MODULE = Convert::Scalar PACKAGE = Convert::Scalar |
15 | |
41 | |
|
|
42 | TYPEMAP: <<EOF |
|
|
43 | SSize_t T_UV |
|
|
44 | EOF |
|
|
45 | |
|
|
46 | PROTOTYPES: ENABLE |
|
|
47 | |
16 | bool |
48 | bool |
17 | utf8 (SV *scalar, SV *mode = NO_INIT) |
49 | utf8 (SV *scalar, SV *mode = NO_INIT) |
18 | PROTOTYPE: $;$ |
|
|
19 | CODE: |
50 | CODE: |
20 | SvGETMAGIC (scalar); |
51 | SvGETMAGIC (scalar); |
21 | RETVAL = !!SvUTF8 (scalar); |
52 | RETVAL = !!SvUTF8 (scalar); |
22 | if (items > 1) |
53 | if (items > 1) |
23 | { |
54 | { |
… | |
… | |
31 | OUTPUT: |
62 | OUTPUT: |
32 | RETVAL |
63 | RETVAL |
33 | |
64 | |
34 | void |
65 | void |
35 | utf8_on (SV *scalar) |
66 | utf8_on (SV *scalar) |
36 | PROTOTYPE: $ |
|
|
37 | PPCODE: |
67 | PPCODE: |
38 | if (SvREADONLY (scalar)) |
68 | if (SvREADONLY (scalar)) |
39 | croak ("Convert::Scalar::utf8_on called on read only scalar"); |
69 | croak ("Convert::Scalar::utf8_on called on read only scalar"); |
40 | |
70 | |
41 | SvGETMAGIC (scalar); |
71 | SvGETMAGIC (scalar); |
42 | SvUTF8_on (scalar); |
72 | SvUTF8_on (scalar); |
43 | RETCOPY (scalar); |
73 | RETCOPY (scalar); |
44 | |
74 | |
45 | void |
75 | void |
46 | utf8_off (SV *scalar) |
76 | utf8_off (SV *scalar) |
47 | PROTOTYPE: $ |
|
|
48 | PPCODE: |
77 | PPCODE: |
49 | if (SvREADONLY (scalar)) |
78 | if (SvREADONLY (scalar)) |
50 | croak ("Convert::Scalar::utf8_off called on read only scalar"); |
79 | croak ("Convert::Scalar::utf8_off called on read only scalar"); |
51 | |
80 | |
52 | SvGETMAGIC (scalar); |
81 | SvGETMAGIC (scalar); |
53 | SvUTF8_off (scalar); |
82 | SvUTF8_off (scalar); |
54 | RETCOPY (scalar); |
83 | RETCOPY (scalar); |
55 | |
84 | |
56 | int |
85 | int |
57 | utf8_valid (SV *scalar) |
86 | utf8_valid (SV *scalar) |
58 | PROTOTYPE: $ |
|
|
59 | CODE: |
87 | CODE: |
60 | STRLEN len; |
88 | STRLEN len; |
61 | char *str = SvPV (scalar, len); |
89 | char *str = SvPV (scalar, len); |
62 | RETVAL = !!is_utf8_string (str, len); |
90 | RETVAL = !!is_utf8_string (str, len); |
63 | OUTPUT: |
91 | OUTPUT: |
64 | RETVAL |
92 | RETVAL |
65 | |
93 | |
66 | void |
94 | void |
67 | utf8_upgrade (SV *scalar) |
95 | utf8_upgrade (SV *scalar) |
68 | PROTOTYPE: $ |
|
|
69 | PPCODE: |
96 | PPCODE: |
70 | if (SvREADONLY (scalar)) |
97 | if (SvREADONLY (scalar)) |
71 | croak ("Convert::Scalar::utf8_upgrade called on read only scalar"); |
98 | croak ("Convert::Scalar::utf8_upgrade called on read only scalar"); |
72 | |
99 | |
73 | sv_utf8_upgrade(scalar); |
100 | sv_utf8_upgrade(scalar); |
74 | RETCOPY (scalar); |
101 | RETCOPY (scalar); |
75 | |
102 | |
76 | bool |
103 | bool |
77 | utf8_downgrade (SV *scalar, bool fail_ok = 0) |
104 | utf8_downgrade (SV *scalar, bool fail_ok = 0) |
78 | PROTOTYPE: $;$ |
|
|
79 | CODE: |
105 | CODE: |
80 | if (SvREADONLY (scalar)) |
106 | if (SvREADONLY (scalar)) |
81 | croak ("Convert::Scalar::utf8_downgrade called on read only scalar"); |
107 | croak ("Convert::Scalar::utf8_downgrade called on read only scalar"); |
82 | |
108 | |
83 | RETVAL = !!sv_utf8_downgrade (scalar, fail_ok); |
109 | RETVAL = !!sv_utf8_downgrade (scalar, fail_ok); |
84 | OUTPUT: |
110 | OUTPUT: |
85 | RETVAL |
111 | RETVAL |
86 | |
112 | |
87 | void |
113 | void |
88 | utf8_encode (SV *scalar) |
114 | utf8_encode (SV *scalar) |
89 | PROTOTYPE: $ |
|
|
90 | PPCODE: |
115 | PPCODE: |
91 | if (SvREADONLY (scalar)) |
116 | if (SvREADONLY (scalar)) |
92 | croak ("Convert::Scalar::utf8_encode called on read only scalar"); |
117 | croak ("Convert::Scalar::utf8_encode called on read only scalar"); |
93 | |
118 | |
94 | sv_utf8_encode (scalar); |
119 | sv_utf8_encode (scalar); |
95 | RETCOPY (scalar); |
120 | RETCOPY (scalar); |
96 | |
121 | |
97 | UV |
122 | UV |
98 | utf8_length (SV *scalar) |
123 | utf8_length (SV *scalar) |
99 | PROTOTYPE: $ |
|
|
100 | CODE: |
124 | CODE: |
101 | RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar)); |
125 | RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar)); |
102 | OUTPUT: |
126 | OUTPUT: |
103 | RETVAL |
127 | RETVAL |
104 | |
128 | |
105 | bool |
129 | bool |
106 | readonly (SV *scalar, SV *on = NO_INIT) |
130 | readonly (SV *scalar, SV *on = NO_INIT) |
107 | PROTOTYPE: $;$ |
|
|
108 | CODE: |
131 | CODE: |
109 | RETVAL = SvREADONLY (scalar); |
132 | RETVAL = SvREADONLY (scalar); |
110 | if (items > 1) |
133 | if (items > 1) |
111 | { |
134 | { |
112 | if (SvTRUE (on)) |
135 | if (SvTRUE (on)) |
… | |
… | |
117 | OUTPUT: |
140 | OUTPUT: |
118 | RETVAL |
141 | RETVAL |
119 | |
142 | |
120 | void |
143 | void |
121 | readonly_on (SV *scalar) |
144 | readonly_on (SV *scalar) |
122 | PROTOTYPE: $ |
|
|
123 | CODE: |
145 | CODE: |
124 | SvREADONLY_on (scalar); |
146 | SvREADONLY_on (scalar); |
125 | |
147 | |
126 | void |
148 | void |
127 | readonly_off (SV *scalar) |
149 | readonly_off (SV *scalar) |
128 | PROTOTYPE: $ |
|
|
129 | CODE: |
150 | CODE: |
130 | SvREADONLY_off (scalar); |
151 | SvREADONLY_off (scalar); |
131 | |
152 | |
132 | void |
153 | void |
133 | unmagic (SV *scalar, char type) |
154 | unmagic (SV *scalar, char type) |
134 | PROTOTYPE: $$ |
|
|
135 | CODE: |
155 | CODE: |
136 | sv_unmagic (scalar, type); |
156 | sv_unmagic (scalar, type); |
137 | |
157 | |
138 | void |
158 | void |
139 | weaken (SV *scalar) |
159 | weaken (SV *scalar) |
140 | PROTOTYPE: $ |
|
|
141 | CODE: |
160 | CODE: |
142 | sv_rvweaken (scalar); |
161 | sv_rvweaken (scalar); |
143 | |
162 | |
144 | void |
163 | void |
145 | taint (SV *scalar) |
164 | taint (SV *scalar) |
146 | PROTOTYPE: $ |
|
|
147 | CODE: |
165 | CODE: |
148 | SvTAINTED_on (scalar); |
166 | SvTAINTED_on (scalar); |
149 | |
167 | |
150 | bool |
168 | bool |
151 | tainted (SV *scalar) |
169 | tainted (SV *scalar) |
152 | PROTOTYPE: $ |
|
|
153 | CODE: |
170 | CODE: |
154 | RETVAL = !!SvTAINTED (scalar); |
171 | RETVAL = !!SvTAINTED (scalar); |
155 | OUTPUT: |
172 | OUTPUT: |
156 | RETVAL |
173 | RETVAL |
157 | |
174 | |
158 | void |
175 | void |
159 | untaint (SV *scalar) |
176 | untaint (SV *scalar) |
160 | PROTOTYPE: $ |
|
|
161 | CODE: |
177 | CODE: |
162 | SvTAINTED_off (scalar); |
178 | SvTAINTED_off (scalar); |
163 | |
179 | |
164 | STRLEN |
180 | STRLEN |
165 | len (SV *scalar) |
181 | len (SV *scalar) |
166 | PROTOTYPE: $ |
|
|
167 | CODE: |
182 | CODE: |
168 | if (SvTYPE (scalar) < SVt_PV) |
183 | if (SvTYPE (scalar) < SVt_PV) |
169 | XSRETURN_UNDEF; |
184 | XSRETURN_UNDEF; |
170 | RETVAL = SvLEN (scalar); |
185 | RETVAL = SvLEN (scalar); |
171 | OUTPUT: |
186 | OUTPUT: |
172 | RETVAL |
187 | RETVAL |
173 | |
188 | |
174 | void |
189 | void |
175 | grow (SV *scalar, STRLEN newlen) |
190 | grow (SV *scalar, STRLEN newlen) |
176 | PROTOTYPE: $$ |
|
|
177 | PPCODE: |
191 | PPCODE: |
178 | sv_grow (scalar, newlen); |
192 | sv_grow (scalar, newlen); |
179 | if (GIMME_V != G_VOID) |
193 | if (GIMME_V != G_VOID) |
180 | XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); |
194 | XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); |
181 | |
195 | |
182 | void |
196 | void |
183 | extend (SV *scalar, STRLEN addlen) |
197 | extend (SV *scalar, STRLEN addlen = 64) |
184 | PROTOTYPE: $$ |
|
|
185 | PPCODE: |
198 | PPCODE: |
186 | { |
199 | { |
187 | if (SvTYPE (scalar) < SVt_PV) |
200 | extend (scalar, addlen); |
188 | sv_upgrade (scalar, SVt_PV); |
|
|
189 | |
|
|
190 | if (SvCUR (scalar) + addlen >= SvLEN (scalar)) |
|
|
191 | { |
|
|
192 | STRLEN l = SvLEN (scalar); |
|
|
193 | STRLEN o = SvCUR (scalar) + addlen >= 4096 ? sizeof (void *) * 4 : 0; |
|
|
194 | |
|
|
195 | if (l < 64) |
|
|
196 | l = 64; |
|
|
197 | |
|
|
198 | /* for big sizes, leave a bit of space for malloc management, and assume 4kb or smaller pages */ |
|
|
199 | addlen += o; |
|
|
200 | |
|
|
201 | while (SvCUR (scalar) + addlen >= l) |
|
|
202 | l <<= 1; |
|
|
203 | |
|
|
204 | l -= o; |
|
|
205 | |
|
|
206 | sv_grow (scalar, l); |
|
|
207 | } |
|
|
208 | |
201 | |
209 | if (GIMME_V != G_VOID) |
202 | if (GIMME_V != G_VOID) |
210 | XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); |
203 | XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); |
211 | } |
204 | } |
212 | |
205 | |
|
|
206 | SSize_t |
|
|
207 | extend_read (PerlIO *fh, SV *scalar, STRLEN addlen = 64) |
|
|
208 | CODE: |
|
|
209 | { |
|
|
210 | if (SvUTF8 (scalar)) |
|
|
211 | sv_utf8_downgrade (scalar, 0); |
|
|
212 | |
|
|
213 | extend (scalar, addlen); |
|
|
214 | |
|
|
215 | RETVAL = PerlLIO_read (PerlIO_fileno (fh), SvEND (scalar), SvLEN (scalar) - SvCUR (scalar)); |
|
|
216 | |
|
|
217 | if (RETVAL < 0) |
|
|
218 | XSRETURN_UNDEF; |
|
|
219 | |
|
|
220 | SvPOK_only (scalar); |
|
|
221 | SvCUR_set (scalar, SvCUR (scalar) + RETVAL); |
|
|
222 | } |
|
|
223 | OUTPUT: RETVAL |
|
|
224 | |
|
|
225 | SSize_t |
|
|
226 | read_all (PerlIO *fh, SV *scalar, STRLEN count) |
|
|
227 | CODE: |
|
|
228 | { |
|
|
229 | SvUPGRADE (scalar, SVt_PV); |
|
|
230 | if (SvUTF8 (scalar)) |
|
|
231 | sv_utf8_downgrade (scalar, 0); |
|
|
232 | |
|
|
233 | SvPOK_only (scalar); |
|
|
234 | |
|
|
235 | int fd = PerlIO_fileno (fh); |
|
|
236 | RETVAL = 0; |
|
|
237 | |
|
|
238 | SvGROW (scalar, count); |
|
|
239 | |
|
|
240 | for (;;) |
|
|
241 | { |
|
|
242 | STRLEN rem = count - RETVAL; |
|
|
243 | |
|
|
244 | if (!rem) |
|
|
245 | break; |
|
|
246 | |
|
|
247 | STRLEN got = PerlLIO_read (fd, SvPVX (scalar) + RETVAL, rem); |
|
|
248 | |
|
|
249 | if (got == 0) |
|
|
250 | break; |
|
|
251 | else if (got < 0) |
|
|
252 | if (RETVAL) |
|
|
253 | break; |
|
|
254 | else |
|
|
255 | XSRETURN_UNDEF; |
|
|
256 | |
|
|
257 | RETVAL += got; |
|
|
258 | } |
|
|
259 | |
|
|
260 | SvCUR_set (scalar, RETVAL); |
|
|
261 | } |
|
|
262 | OUTPUT: RETVAL |
|
|
263 | |
|
|
264 | SSize_t |
|
|
265 | write_all (PerlIO *fh, SV *scalar) |
|
|
266 | CODE: |
|
|
267 | { |
|
|
268 | STRLEN count; |
|
|
269 | char *ptr = SvPVbyte (scalar, count); |
|
|
270 | |
|
|
271 | int fd = PerlIO_fileno (fh); |
|
|
272 | RETVAL = 0; |
|
|
273 | |
|
|
274 | for (;;) |
|
|
275 | { |
|
|
276 | STRLEN rem = count - RETVAL; |
|
|
277 | |
|
|
278 | if (!rem) |
|
|
279 | break; |
|
|
280 | |
|
|
281 | STRLEN got = PerlLIO_write (fd, ptr + RETVAL, rem); |
|
|
282 | |
|
|
283 | if (got < 0) |
|
|
284 | if (RETVAL) |
|
|
285 | break; |
|
|
286 | else |
|
|
287 | XSRETURN_UNDEF; |
|
|
288 | |
|
|
289 | RETVAL += got; |
|
|
290 | } |
|
|
291 | } |
|
|
292 | OUTPUT: RETVAL |
|
|
293 | |
213 | int |
294 | int |
214 | refcnt (SV *scalar, U32 newrefcnt = NO_INIT) |
295 | refcnt (SV *scalar, U32 newrefcnt = NO_INIT) |
215 | PROTOTYPE: $;$ |
|
|
216 | ALIAS: |
296 | ALIAS: |
217 | refcnt_rv = 1 |
297 | refcnt_rv = 1 |
218 | CODE: |
298 | CODE: |
219 | if (ix) |
299 | if (ix) |
220 | { |
300 | { |
… | |
… | |
229 | |
309 | |
230 | void |
310 | void |
231 | refcnt_inc (SV *scalar) |
311 | refcnt_inc (SV *scalar) |
232 | ALIAS: |
312 | ALIAS: |
233 | refcnt_inc_rv = 1 |
313 | refcnt_inc_rv = 1 |
234 | PROTOTYPE: $ |
|
|
235 | CODE: |
314 | CODE: |
236 | if (ix) |
315 | if (ix) |
237 | { |
316 | { |
238 | if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument"); |
317 | if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument"); |
239 | scalar = SvRV (scalar); |
318 | scalar = SvRV (scalar); |
… | |
… | |
242 | |
321 | |
243 | void |
322 | void |
244 | refcnt_dec (SV *scalar) |
323 | refcnt_dec (SV *scalar) |
245 | ALIAS: |
324 | ALIAS: |
246 | refcnt_dec_rv = 1 |
325 | refcnt_dec_rv = 1 |
247 | PROTOTYPE: $ |
|
|
248 | CODE: |
326 | CODE: |
249 | if (ix) |
327 | if (ix) |
250 | { |
328 | { |
251 | if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument"); |
329 | if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument"); |
252 | scalar = SvRV (scalar); |
330 | scalar = SvRV (scalar); |
253 | } |
331 | } |
254 | SvREFCNT_dec (scalar); |
332 | SvREFCNT_dec (scalar); |
255 | |
333 | |
256 | bool |
334 | bool |
257 | ok (SV *scalar) |
335 | ok (SV *scalar) |
258 | PROTOTYPE: $ |
|
|
259 | CODE: |
336 | CODE: |
260 | RETVAL = !!SvOK (scalar); |
337 | RETVAL = !!SvOK (scalar); |
261 | OUTPUT: |
338 | OUTPUT: |
262 | RETVAL |
339 | RETVAL |
263 | |
340 | |
264 | bool |
341 | bool |
265 | uok (SV *scalar) |
342 | uok (SV *scalar) |
266 | PROTOTYPE: $ |
|
|
267 | CODE: |
343 | CODE: |
268 | RETVAL = !!SvUOK (scalar); |
344 | RETVAL = !!SvUOK (scalar); |
269 | OUTPUT: |
345 | OUTPUT: |
270 | RETVAL |
346 | RETVAL |
271 | |
347 | |
272 | bool |
348 | bool |
273 | rok (SV *scalar) |
349 | rok (SV *scalar) |
274 | PROTOTYPE: $ |
|
|
275 | CODE: |
350 | CODE: |
276 | RETVAL = !!SvROK (scalar); |
351 | RETVAL = !!SvROK (scalar); |
277 | OUTPUT: |
352 | OUTPUT: |
278 | RETVAL |
353 | RETVAL |
279 | |
354 | |
280 | bool |
355 | bool |
281 | pok (SV *scalar) |
356 | pok (SV *scalar) |
282 | PROTOTYPE: $ |
|
|
283 | CODE: |
357 | CODE: |
284 | RETVAL = !!SvPOK (scalar); |
358 | RETVAL = !!SvPOK (scalar); |
285 | OUTPUT: |
359 | OUTPUT: |
286 | RETVAL |
360 | RETVAL |
287 | |
361 | |
288 | bool |
362 | bool |
289 | nok (SV *scalar) |
363 | nok (SV *scalar) |
290 | PROTOTYPE: $ |
|
|
291 | CODE: |
364 | CODE: |
292 | RETVAL = !!SvNOK (scalar); |
365 | RETVAL = !!SvNOK (scalar); |
293 | OUTPUT: |
366 | OUTPUT: |
294 | RETVAL |
367 | RETVAL |
295 | |
368 | |
296 | bool |
369 | bool |
297 | niok (SV *scalar) |
370 | niok (SV *scalar) |
298 | PROTOTYPE: $ |
|
|
299 | CODE: |
371 | CODE: |
300 | RETVAL = !!SvNIOK (scalar); |
372 | RETVAL = !!SvNIOK (scalar); |
301 | OUTPUT: |
373 | OUTPUT: |
302 | RETVAL |
374 | RETVAL |
303 | |
375 | |