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.3 by root, Fri Jul 5 11:44:55 2002 UTC vs.
Revision 1.11 by root, Mon Feb 3 03:32:13 2014 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 5#define RETCOPY(sv) \
6# define is_utf8_string(s,l) (croak ("utf8_valid requires perl 5.7 or higher"), 0) 6 if (GIMME_V != G_VOID) \
7#endif 7 { \
8 dXSTARG; \
9 sv_setsv (TARG, (sv)); \
10 EXTEND (SP, 1); \
11 PUSHs (TARG); \
12 }
8 13
9MODULE = Convert::Scalar PACKAGE = Convert::Scalar 14MODULE = Convert::Scalar PACKAGE = Convert::Scalar
10 15
11int 16bool
12utf8(scalar,mode=0) 17utf8 (SV *scalar, SV *mode = NO_INIT)
13 SV * scalar
14 SV * mode
15 PROTOTYPE: $;$ 18 PROTOTYPE: $;$
16 CODE: 19 CODE:
17 SvGETMAGIC (scalar); 20 SvGETMAGIC (scalar);
18 RETVAL = !!SvUTF8 (scalar); 21 RETVAL = !!SvUTF8 (scalar);
19 if (items > 1) 22 if (items > 1)
… …
27 } 30 }
28 OUTPUT: 31 OUTPUT:
29 RETVAL 32 RETVAL
30 33
31void 34void
32utf8_on(scalar) 35utf8_on (SV *scalar)
33 SV * scalar
34 PROTOTYPE: $ 36 PROTOTYPE: $
35 PPCODE: 37 PPCODE:
36 if (SvREADONLY (scalar)) 38 if (SvREADONLY (scalar))
37 croak ("Convert::Scalar::utf8_on called on read only scalar"); 39 croak ("Convert::Scalar::utf8_on called on read only scalar");
38 40
39 SvGETMAGIC (scalar); 41 SvGETMAGIC (scalar);
40 SvUTF8_on (scalar); 42 SvUTF8_on (scalar);
41 if (GIMME_V != G_VOID) 43 RETCOPY (scalar);
42 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
43 44
44void 45void
45utf8_off(scalar) 46utf8_off (SV *scalar)
46 SV * scalar
47 PROTOTYPE: $ 47 PROTOTYPE: $
48 PPCODE: 48 PPCODE:
49 if (SvREADONLY (scalar)) 49 if (SvREADONLY (scalar))
50 croak ("Convert::Scalar::utf8_off called on read only scalar"); 50 croak ("Convert::Scalar::utf8_off called on read only scalar");
51 51
52 SvGETMAGIC (scalar); 52 SvGETMAGIC (scalar);
53 SvUTF8_off (scalar); 53 SvUTF8_off (scalar);
54 if (GIMME_V != G_VOID) 54 RETCOPY (scalar);
55 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
56 55
57int 56int
58utf8_valid(scalar) 57utf8_valid (SV *scalar)
59 SV * scalar
60 PROTOTYPE: $ 58 PROTOTYPE: $
61 CODE: 59 CODE:
62 STRLEN len; 60 STRLEN len;
63 char *str = SvPV (scalar, len); 61 char *str = SvPV (scalar, len);
64 RETVAL = !!is_utf8_string (str, len); 62 RETVAL = !!is_utf8_string (str, len);
65 OUTPUT: 63 OUTPUT:
66 RETVAL 64 RETVAL
67 65
68void 66void
69utf8_upgrade(scalar) 67utf8_upgrade (SV *scalar)
70 SV * scalar
71 PROTOTYPE: $ 68 PROTOTYPE: $
72 PPCODE: 69 PPCODE:
73 if (SvREADONLY (scalar)) 70 if (SvREADONLY (scalar))
74 croak ("Convert::Scalar::utf8_upgrade called on read only scalar"); 71 croak ("Convert::Scalar::utf8_upgrade called on read only scalar");
75 72
76 sv_utf8_upgrade(scalar); 73 sv_utf8_upgrade(scalar);
77 if (GIMME_V != G_VOID) 74 RETCOPY (scalar);
78 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
79 75
80bool 76bool
81utf8_downgrade(scalar, fail_ok = 0) 77utf8_downgrade (SV *scalar, bool fail_ok = 0)
82 SV * scalar
83 bool fail_ok
84 PROTOTYPE: $;$ 78 PROTOTYPE: $;$
85 CODE: 79 CODE:
86 if (SvREADONLY (scalar)) 80 if (SvREADONLY (scalar))
87 croak ("Convert::Scalar::utf8_downgrade called on read only scalar"); 81 croak ("Convert::Scalar::utf8_downgrade called on read only scalar");
88 82
89 RETVAL = sv_utf8_downgrade (scalar, fail_ok); 83 RETVAL = !!sv_utf8_downgrade (scalar, fail_ok);
90 OUTPUT: 84 OUTPUT:
91 RETVAL 85 RETVAL
92 86
93void 87void
94utf8_encode(scalar) 88utf8_encode (SV *scalar)
95 SV * scalar
96 PROTOTYPE: $ 89 PROTOTYPE: $
97 PPCODE: 90 PPCODE:
98 if (SvREADONLY (scalar)) 91 if (SvREADONLY (scalar))
99 croak ("Convert::Scalar::utf8_encode called on read only scalar"); 92 croak ("Convert::Scalar::utf8_encode called on read only scalar");
100 93
101 sv_utf8_encode (scalar); 94 sv_utf8_encode (scalar);
102 if (GIMME_V != G_VOID) 95 RETCOPY (scalar);
103 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
104 96
105UV 97UV
106utf8_length(scalar) 98utf8_length (SV *scalar)
107 SV * scalar
108 PROTOTYPE: $ 99 PROTOTYPE: $
109 CODE: 100 CODE:
110 RETVAL = (UV) sv_len_utf8 (scalar); 101 RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
111 OUTPUT: 102 OUTPUT:
112 RETVAL 103 RETVAL
113 104
105bool
106readonly (SV *scalar, SV *on = NO_INIT)
107 PROTOTYPE: $;$
108 CODE:
109 RETVAL = SvREADONLY (scalar);
110 if (items > 1)
111 {
112 if (SvTRUE (on))
113 SvREADONLY_on (scalar);
114 else
115 SvREADONLY_off (scalar);
116 }
117 OUTPUT:
118 RETVAL
119
114void 120void
121readonly_on (SV *scalar)
122 PROTOTYPE: $
123 CODE:
124 SvREADONLY_on (scalar);
125
126void
127readonly_off (SV *scalar)
128 PROTOTYPE: $
129 CODE:
130 SvREADONLY_off (scalar);
131
132void
115unmagic(scalar, type) 133unmagic (SV *scalar, char type)
116 SV * scalar
117 char type
118 PROTOTYPE: $ 134 PROTOTYPE: $$
119 CODE: 135 CODE:
120 sv_unmagic (scalar, type); 136 sv_unmagic (scalar, type);
121 137
122void 138void
123weaken(scalar) 139weaken (SV *scalar)
124 SV * scalar
125 PROTOTYPE: $ 140 PROTOTYPE: $
126 CODE: 141 CODE:
127 sv_rvweaken (scalar); 142 sv_rvweaken (scalar);
128 143
129void 144void
130taint(scalar) 145taint (SV *scalar)
131 SV * scalar
132 PROTOTYPE: $ 146 PROTOTYPE: $
133 CODE: 147 CODE:
134 SvTAINTED_on (scalar); 148 SvTAINTED_on (scalar);
135 149
136int 150bool
137tainted(scalar) 151tainted (SV *scalar)
138 SV * scalar
139 PROTOTYPE: $ 152 PROTOTYPE: $
140 CODE: 153 CODE:
141 RETVAL = SvTAINTED (scalar); 154 RETVAL = !!SvTAINTED (scalar);
142 OUTPUT: 155 OUTPUT:
143 RETVAL 156 RETVAL
144 157
145void 158void
146untaint(scalar) 159untaint (SV *scalar)
147 SV * scalar
148 PROTOTYPE: $ 160 PROTOTYPE: $
149 CODE: 161 CODE:
150 SvTAINTED_off (scalar); 162 SvTAINTED_off (scalar);
151 163
164STRLEN
165len (SV *scalar)
166 PROTOTYPE: $
167 CODE:
168 if (SvTYPE (scalar) < SVt_PV)
169 XSRETURN_UNDEF;
170 RETVAL = SvLEN (scalar);
171 OUTPUT:
172 RETVAL
173
152void 174void
153grow(scalar,newlen) 175grow (SV *scalar, STRLEN newlen)
154 SV * scalar
155 U32 newlen
156 PROTOTYPE: $$ 176 PROTOTYPE: $$
157 PPCODE: 177 PPCODE:
158 sv_grow (scalar, newlen); 178 sv_grow (scalar, newlen);
159 if (GIMME_V != G_VOID) 179 if (GIMME_V != G_VOID)
160 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar))); 180 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
161 181
182void
183extend (SV *scalar, STRLEN addlen)
184 PROTOTYPE: $$
185 PPCODE:
186{
187 if (SvTYPE (scalar) < SVt_PV)
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
209 if (GIMME_V != G_VOID)
210 XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
211}
212
162int 213int
163refcnt(scalar,newrefcnt=0) 214refcnt (SV *scalar, U32 newrefcnt = NO_INIT)
164 SV * scalar
165 int newrefcnt
166 PROTOTYPE: $;$ 215 PROTOTYPE: $;$
167 ALIAS: 216 ALIAS:
168 refcnt_rv = 1 217 refcnt_rv = 1
169 CODE: 218 CODE:
170 if (ix) 219 if (ix)
… …
177 SvREFCNT (scalar) = newrefcnt; 226 SvREFCNT (scalar) = newrefcnt;
178 OUTPUT: 227 OUTPUT:
179 RETVAL 228 RETVAL
180 229
181void 230void
182refcnt_inc(scalar) 231refcnt_inc (SV *scalar)
183 SV * scalar
184 ALIAS: 232 ALIAS:
185 refcnt_inc_rv = 1 233 refcnt_inc_rv = 1
186 PROTOTYPE: $ 234 PROTOTYPE: $
187 CODE: 235 CODE:
188 if (ix) 236 if (ix)
… …
191 scalar = SvRV (scalar); 239 scalar = SvRV (scalar);
192 } 240 }
193 SvREFCNT_inc (scalar); 241 SvREFCNT_inc (scalar);
194 242
195void 243void
196refcnt_dec(scalar) 244refcnt_dec (SV *scalar)
197 SV * scalar
198 ALIAS: 245 ALIAS:
199 refcnt_dec_rv = 1 246 refcnt_dec_rv = 1
200 PROTOTYPE: $ 247 PROTOTYPE: $
201 CODE: 248 CODE:
202 if (ix) 249 if (ix)
203 { 250 {
204 if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument"); 251 if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
205 scalar = SvRV (scalar); 252 scalar = SvRV (scalar);
206 } 253 }
207 SvREFCNT_dec (scalar); 254 SvREFCNT_dec (scalar);
255
256bool
257ok (SV *scalar)
258 PROTOTYPE: $
259 CODE:
260 RETVAL = !!SvOK (scalar);
261 OUTPUT:
262 RETVAL
263
264bool
265uok (SV *scalar)
266 PROTOTYPE: $
267 CODE:
268 RETVAL = !!SvUOK (scalar);
269 OUTPUT:
270 RETVAL
271
272bool
273rok (SV *scalar)
274 PROTOTYPE: $
275 CODE:
276 RETVAL = !!SvROK (scalar);
277 OUTPUT:
278 RETVAL
279
280bool
281pok (SV *scalar)
282 PROTOTYPE: $
283 CODE:
284 RETVAL = !!SvPOK (scalar);
285 OUTPUT:
286 RETVAL
287
288bool
289nok (SV *scalar)
290 PROTOTYPE: $
291 CODE:
292 RETVAL = !!SvNOK (scalar);
293 OUTPUT:
294 RETVAL
295
296bool
297niok (SV *scalar)
298 PROTOTYPE: $
299 CODE:
300 RETVAL = !!SvNIOK (scalar);
301 OUTPUT:
302 RETVAL
303

Diff Legend

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