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.9 by root, Fri Mar 7 10:33:46 2008 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(scalar,mode=0) 49utf8 (SV *scalar, SV *mode = NO_INIT)
18 SV * scalar
19 SV * mode
20 PROTOTYPE: $;$
21 CODE: 50 CODE:
22 SvGETMAGIC (scalar); 51 SvGETMAGIC (scalar);
23 RETVAL = !!SvUTF8 (scalar); 52 RETVAL = !!SvUTF8 (scalar);
24 if (items > 1) 53 if (items > 1)
25 { 54 {
… …
32 } 61 }
33 OUTPUT: 62 OUTPUT:
34 RETVAL 63 RETVAL
35 64
36void 65void
37utf8_on(scalar) 66utf8_on (SV *scalar)
38 SV * scalar
39 PROTOTYPE: $
40 PPCODE: 67 PPCODE:
41 if (SvREADONLY (scalar)) 68 if (SvREADONLY (scalar))
42 croak ("Convert::Scalar::utf8_on called on read only scalar"); 69 croak ("Convert::Scalar::utf8_on called on read only scalar");
43 70
44 SvGETMAGIC (scalar); 71 SvGETMAGIC (scalar);
45 SvUTF8_on (scalar); 72 SvUTF8_on (scalar);
46 RETCOPY (scalar); 73 RETCOPY (scalar);
47 74
48void 75void
49utf8_off(scalar) 76utf8_off (SV *scalar)
50 SV * scalar
51 PROTOTYPE: $
52 PPCODE: 77 PPCODE:
53 if (SvREADONLY (scalar)) 78 if (SvREADONLY (scalar))
54 croak ("Convert::Scalar::utf8_off called on read only scalar"); 79 croak ("Convert::Scalar::utf8_off called on read only scalar");
55 80
56 SvGETMAGIC (scalar); 81 SvGETMAGIC (scalar);
57 SvUTF8_off (scalar); 82 SvUTF8_off (scalar);
58 RETCOPY (scalar); 83 RETCOPY (scalar);
59 84
60int 85int
61utf8_valid(scalar) 86utf8_valid (SV *scalar)
62 SV * scalar
63 PROTOTYPE: $
64 CODE: 87 CODE:
65 STRLEN len; 88 STRLEN len;
66 char *str = SvPV (scalar, len); 89 char *str = SvPV (scalar, len);
67 RETVAL = !!is_utf8_string (str, len); 90 RETVAL = !!is_utf8_string (str, len);
68 OUTPUT: 91 OUTPUT:
69 RETVAL 92 RETVAL
70 93
71void 94void
72utf8_upgrade(scalar) 95utf8_upgrade (SV *scalar)
73 SV * scalar
74 PROTOTYPE: $
75 PPCODE: 96 PPCODE:
76 if (SvREADONLY (scalar)) 97 if (SvREADONLY (scalar))
77 croak ("Convert::Scalar::utf8_upgrade called on read only scalar"); 98 croak ("Convert::Scalar::utf8_upgrade called on read only scalar");
78 99
79 sv_utf8_upgrade(scalar); 100 sv_utf8_upgrade(scalar);
80 RETCOPY (scalar); 101 RETCOPY (scalar);
81 102
82bool 103bool
83utf8_downgrade(scalar, fail_ok = 0) 104utf8_downgrade (SV *scalar, bool fail_ok = 0)
84 SV * scalar
85 bool fail_ok
86 PROTOTYPE: $;$
87 CODE: 105 CODE:
88 if (SvREADONLY (scalar)) 106 if (SvREADONLY (scalar))
89 croak ("Convert::Scalar::utf8_downgrade called on read only scalar"); 107 croak ("Convert::Scalar::utf8_downgrade called on read only scalar");
90 108
91 RETVAL = !!sv_utf8_downgrade (scalar, fail_ok); 109 RETVAL = !!sv_utf8_downgrade (scalar, fail_ok);
92 OUTPUT: 110 OUTPUT:
93 RETVAL 111 RETVAL
94 112
95void 113void
96utf8_encode(scalar) 114utf8_encode (SV *scalar)
97 SV * scalar
98 PROTOTYPE: $
99 PPCODE: 115 PPCODE:
100 if (SvREADONLY (scalar)) 116 if (SvREADONLY (scalar))
101 croak ("Convert::Scalar::utf8_encode called on read only scalar"); 117 croak ("Convert::Scalar::utf8_encode called on read only scalar");
102 118
103 sv_utf8_encode (scalar); 119 sv_utf8_encode (scalar);
104 RETCOPY (scalar); 120 RETCOPY (scalar);
105 121
106UV 122UV
107utf8_length(scalar) 123utf8_length (SV *scalar)
108 SV * scalar
109 PROTOTYPE: $
110 CODE: 124 CODE:
111 RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar)); 125 RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
112 OUTPUT: 126 OUTPUT:
113 RETVAL 127 RETVAL
114 128
129bool
130readonly (SV *scalar, SV *on = NO_INIT)
131 CODE:
132 RETVAL = SvREADONLY (scalar);
133 if (items > 1)
134 {
135 if (SvTRUE (on))
136 SvREADONLY_on (scalar);
137 else
138 SvREADONLY_off (scalar);
139 }
140 OUTPUT:
141 RETVAL
142
115void 143void
144readonly_on (SV *scalar)
145 CODE:
146 SvREADONLY_on (scalar);
147
148void
149readonly_off (SV *scalar)
150 CODE:
151 SvREADONLY_off (scalar);
152
153void
116unmagic(scalar, type) 154unmagic (SV *scalar, char type)
117 SV * scalar
118 char type
119 PROTOTYPE: $
120 CODE: 155 CODE:
121 sv_unmagic (scalar, type); 156 sv_unmagic (scalar, type);
122 157
123void 158void
124weaken(scalar) 159weaken (SV *scalar)
125 SV * scalar
126 PROTOTYPE: $
127 CODE: 160 CODE:
128 sv_rvweaken (scalar); 161 sv_rvweaken (scalar);
129 162
130void 163void
131taint(scalar) 164taint (SV *scalar)
132 SV * scalar
133 PROTOTYPE: $
134 CODE: 165 CODE:
135 SvTAINTED_on (scalar); 166 SvTAINTED_on (scalar);
136 167
137bool 168bool
138tainted(scalar) 169tainted (SV *scalar)
139 SV * scalar
140 PROTOTYPE: $
141 CODE: 170 CODE:
142 RETVAL = !!SvTAINTED (scalar); 171 RETVAL = !!SvTAINTED (scalar);
143 OUTPUT: 172 OUTPUT:
144 RETVAL 173 RETVAL
145 174
146void 175void
147untaint(scalar) 176untaint (SV *scalar)
148 SV * scalar
149 PROTOTYPE: $
150 CODE: 177 CODE:
151 SvTAINTED_off (scalar); 178 SvTAINTED_off (scalar);
152 179
180STRLEN
181len (SV *scalar)
182 CODE:
183 if (SvTYPE (scalar) < SVt_PV)
184 XSRETURN_UNDEF;
185 RETVAL = SvLEN (scalar);
186 OUTPUT:
187 RETVAL
188
153void 189void
154grow(scalar,newlen) 190grow (SV *scalar, STRLEN newlen)
155 SV * scalar
156 U32 newlen
157 PROTOTYPE: $$
158 PPCODE: 191 PPCODE:
159 sv_grow (scalar, newlen); 192 sv_grow (scalar, newlen);
160 if (GIMME_V != G_VOID) 193 if (GIMME_V != G_VOID)
161 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); 194 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
162 195
196void
197extend (SV *scalar, STRLEN addlen = 64)
198 PPCODE:
199{
200 extend (scalar, addlen);
201
202 if (GIMME_V != G_VOID)
203 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
204}
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
163int 294int
164refcnt(scalar,newrefcnt=0) 295refcnt (SV *scalar, U32 newrefcnt = NO_INIT)
165 SV * scalar
166 int newrefcnt
167 PROTOTYPE: $;$
168 ALIAS: 296 ALIAS:
169 refcnt_rv = 1 297 refcnt_rv = 1
170 CODE: 298 CODE:
171 if (ix) 299 if (ix)
172 { 300 {
… …
178 SvREFCNT (scalar) = newrefcnt; 306 SvREFCNT (scalar) = newrefcnt;
179 OUTPUT: 307 OUTPUT:
180 RETVAL 308 RETVAL
181 309
182void 310void
183refcnt_inc(scalar) 311refcnt_inc (SV *scalar)
184 SV * scalar
185 ALIAS: 312 ALIAS:
186 refcnt_inc_rv = 1 313 refcnt_inc_rv = 1
187 PROTOTYPE: $
188 CODE: 314 CODE:
189 if (ix) 315 if (ix)
190 { 316 {
191 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");
192 scalar = SvRV (scalar); 318 scalar = SvRV (scalar);
193 } 319 }
194 SvREFCNT_inc (scalar); 320 SvREFCNT_inc (scalar);
195 321
196void 322void
197refcnt_dec(scalar) 323refcnt_dec (SV *scalar)
198 SV * scalar
199 ALIAS: 324 ALIAS:
200 refcnt_dec_rv = 1 325 refcnt_dec_rv = 1
201 PROTOTYPE: $
202 CODE: 326 CODE:
203 if (ix) 327 if (ix)
204 { 328 {
205 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");
206 scalar = SvRV (scalar); 330 scalar = SvRV (scalar);
207 } 331 }
208 SvREFCNT_dec (scalar); 332 SvREFCNT_dec (scalar);
209 333
210bool 334bool
211ok(scalar) 335ok (SV *scalar)
212 SV * scalar
213 PROTOTYPE: $
214 CODE: 336 CODE:
215 RETVAL = !!SvOK (scalar); 337 RETVAL = !!SvOK (scalar);
216 OUTPUT: 338 OUTPUT:
217 RETVAL 339 RETVAL
218 340
219bool 341bool
220uok(scalar) 342uok (SV *scalar)
221 SV * scalar
222 PROTOTYPE: $
223 CODE: 343 CODE:
224 RETVAL = !!SvUOK (scalar); 344 RETVAL = !!SvUOK (scalar);
225 OUTPUT: 345 OUTPUT:
226 RETVAL 346 RETVAL
227 347
228bool 348bool
229rok(scalar) 349rok (SV *scalar)
230 SV * scalar
231 PROTOTYPE: $
232 CODE: 350 CODE:
233 RETVAL = !!SvROK (scalar); 351 RETVAL = !!SvROK (scalar);
234 OUTPUT: 352 OUTPUT:
235 RETVAL 353 RETVAL
236 354
237bool 355bool
238pok(scalar) 356pok (SV *scalar)
239 SV * scalar
240 PROTOTYPE: $
241 CODE: 357 CODE:
242 RETVAL = !!SvPOK (scalar); 358 RETVAL = !!SvPOK (scalar);
243 OUTPUT: 359 OUTPUT:
244 RETVAL 360 RETVAL
245 361
246bool 362bool
247nok(scalar) 363nok (SV *scalar)
248 SV * scalar
249 PROTOTYPE: $
250 CODE: 364 CODE:
251 RETVAL = !!SvNOK (scalar); 365 RETVAL = !!SvNOK (scalar);
252 OUTPUT: 366 OUTPUT:
253 RETVAL 367 RETVAL
254 368
255bool 369bool
256niok(scalar) 370niok (SV *scalar)
257 SV * scalar
258 PROTOTYPE: $
259 CODE: 371 CODE:
260 RETVAL = !!SvNIOK (scalar); 372 RETVAL = !!SvNIOK (scalar);
261 OUTPUT: 373 OUTPUT:
262 RETVAL 374 RETVAL
263 375

Diff Legend

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