ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Convert-Scalar/Scalar.xs
Revision: 1.11
Committed: Mon Feb 3 03:32:13 2014 UTC (10 years, 3 months ago) by root
Branch: MAIN
CVS Tags: rel-1_11
Changes since 1.10: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

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