ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-Scalar/Scalar.xs
(Generate patch)

Comparing Convert-Scalar/Scalar.xs (file contents):
Revision 1.11 by root, Mon Feb 3 03:32:13 2014 UTC vs.
Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC

… …
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
14static void
15extend (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
14MODULE = Convert::Scalar PACKAGE = Convert::Scalar 40MODULE = Convert::Scalar PACKAGE = Convert::Scalar
15 41
42TYPEMAP: <<EOF
43SSize_t T_UV
44EOF
45
46PROTOTYPES: ENABLE
47
16bool 48bool
17utf8 (SV *scalar, SV *mode = NO_INIT) 49utf8 (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
34void 65void
35utf8_on (SV *scalar) 66utf8_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
45void 75void
46utf8_off (SV *scalar) 76utf8_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
56int 85int
57utf8_valid (SV *scalar) 86utf8_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
66void 94void
67utf8_upgrade (SV *scalar) 95utf8_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
76bool 103bool
77utf8_downgrade (SV *scalar, bool fail_ok = 0) 104utf8_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
87void 113void
88utf8_encode (SV *scalar) 114utf8_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
97UV 122UV
98utf8_length (SV *scalar) 123utf8_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
105bool 129bool
106readonly (SV *scalar, SV *on = NO_INIT) 130readonly (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
120void 143void
121readonly_on (SV *scalar) 144readonly_on (SV *scalar)
122 PROTOTYPE: $
123 CODE: 145 CODE:
124 SvREADONLY_on (scalar); 146 SvREADONLY_on (scalar);
125 147
126void 148void
127readonly_off (SV *scalar) 149readonly_off (SV *scalar)
128 PROTOTYPE: $
129 CODE: 150 CODE:
130 SvREADONLY_off (scalar); 151 SvREADONLY_off (scalar);
131 152
132void 153void
133unmagic (SV *scalar, char type) 154unmagic (SV *scalar, char type)
134 PROTOTYPE: $$
135 CODE: 155 CODE:
136 sv_unmagic (scalar, type); 156 sv_unmagic (scalar, type);
137 157
138void 158void
139weaken (SV *scalar) 159weaken (SV *scalar)
140 PROTOTYPE: $
141 CODE: 160 CODE:
142 sv_rvweaken (scalar); 161 sv_rvweaken (scalar);
143 162
144void 163void
145taint (SV *scalar) 164taint (SV *scalar)
146 PROTOTYPE: $
147 CODE: 165 CODE:
148 SvTAINTED_on (scalar); 166 SvTAINTED_on (scalar);
149 167
150bool 168bool
151tainted (SV *scalar) 169tainted (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
158void 175void
159untaint (SV *scalar) 176untaint (SV *scalar)
160 PROTOTYPE: $
161 CODE: 177 CODE:
162 SvTAINTED_off (scalar); 178 SvTAINTED_off (scalar);
163 179
164STRLEN 180STRLEN
165len (SV *scalar) 181len (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
174void 189void
175grow (SV *scalar, STRLEN newlen) 190grow (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
182void 196void
183extend (SV *scalar, STRLEN addlen) 197extend (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
206SSize_t
207extend_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
225SSize_t
226read_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
264SSize_t
265write_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
213int 294int
214refcnt (SV *scalar, U32 newrefcnt = NO_INIT) 295refcnt (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
230void 310void
231refcnt_inc (SV *scalar) 311refcnt_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
243void 322void
244refcnt_dec (SV *scalar) 323refcnt_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
256bool 334bool
257ok (SV *scalar) 335ok (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
264bool 341bool
265uok (SV *scalar) 342uok (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
272bool 348bool
273rok (SV *scalar) 349rok (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
280bool 355bool
281pok (SV *scalar) 356pok (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
288bool 362bool
289nok (SV *scalar) 363nok (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
296bool 369bool
297niok (SV *scalar) 370niok (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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines