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.7 by root, Fri Nov 26 21:14:09 2004 UTC vs.
Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC

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

Diff Legend

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