Convert-Scalar/Scalar.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#if PERL_VERSION < 7
# define is_utf8_string(s,l) (croak ("utf8_valid requires perl 5.7 or higher"), 0)
#endif

MODULE = Convert::Scalar                PACKAGE = Convert::Scalar

int
utf8(scalar,mode=0)
        SV *    scalar
        SV *    mode
        PROTOTYPE: $;$
        CODE:
        SvGETMAGIC (scalar);
        RETVAL = !!SvUTF8 (scalar);
        if (items > 1)
          {
            if (SvREADONLY (scalar))
              croak ("Convert::Scalar::utf8 called on read only scalar");
            if (SvTRUE (mode))
              SvUTF8_on (scalar);
            else
              SvUTF8_off (scalar);
          }
        OUTPUT:
        RETVAL

void
utf8_on(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        if (SvREADONLY (scalar))
          croak ("Convert::Scalar::utf8_on called on read only scalar");

        SvGETMAGIC (scalar);
        SvUTF8_on (scalar);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

void
utf8_off(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        if (SvREADONLY (scalar))
          croak ("Convert::Scalar::utf8_off called on read only scalar");

        SvGETMAGIC (scalar);
        SvUTF8_off (scalar);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

int
utf8_valid(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        STRLEN len;
        char *str = SvPV (scalar, len);
        RETVAL = !!is_utf8_string (str, len);
        OUTPUT:
        RETVAL

void
utf8_upgrade(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        if (SvREADONLY (scalar))
          croak ("Convert::Scalar::utf8_upgrade called on read only scalar");

        sv_utf8_upgrade(scalar);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

bool
utf8_downgrade(scalar, fail_ok = 0)
        SV *    scalar
        bool    fail_ok
        PROTOTYPE: $;$
        CODE:
        if (SvREADONLY (scalar))
          croak ("Convert::Scalar::utf8_downgrade called on read only scalar");

        RETVAL = sv_utf8_downgrade (scalar, fail_ok);
        OUTPUT:
        RETVAL

void
utf8_encode(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        if (SvREADONLY (scalar))
          croak ("Convert::Scalar::utf8_encode called on read only scalar");

        sv_utf8_encode (scalar);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

UV
utf8_length(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
        OUTPUT:
        RETVAL

void
unmagic(scalar, type)
        SV *    scalar
        char    type
        PROTOTYPE: $
        CODE:
        sv_unmagic (scalar, type);

void
weaken(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        sv_rvweaken (scalar);

void
taint(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        SvTAINTED_on (scalar);

int
tainted(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvTAINTED (scalar);
        OUTPUT:
        RETVAL

void
untaint(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        SvTAINTED_off (scalar);

void
grow(scalar,newlen)
        SV *    scalar
        U32     newlen
        PROTOTYPE: $$
        PPCODE:
        sv_grow (scalar, newlen);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

int
refcnt(scalar,newrefcnt=0)
        SV *    scalar
        int     newrefcnt
        PROTOTYPE: $;$
        ALIAS:
          refcnt_rv = 1
        CODE:
        if (ix)
          {
            if (!SvROK (scalar)) croak ("refcnt_rv requires a reference as it's first argument");
            scalar = SvRV (scalar);
          }
        RETVAL = SvREFCNT (scalar);
        if (items > 1)
          SvREFCNT (scalar) = newrefcnt;
        OUTPUT:
        RETVAL

void
refcnt_inc(scalar)
        SV *    scalar
        ALIAS:
          refcnt_inc_rv = 1
        PROTOTYPE: $
        CODE:
        if (ix)
          {
            if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");
            scalar = SvRV (scalar);
          }
        SvREFCNT_inc (scalar);

void
refcnt_dec(scalar)
        SV *    scalar
        ALIAS:
          refcnt_dec_rv = 1
        PROTOTYPE: $
        CODE:
        if (ix)
          {
            if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
            scalar = SvRV (scalar);
          }
        SvREFCNT_dec (scalar);

bool
ok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvOK (scalar);
        OUTPUT:
        RETVAL

bool
uok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvUOK (scalar);
        OUTPUT:
        RETVAL

bool
rok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvROK (scalar);
        OUTPUT:
        RETVAL

bool
pok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvPOK (scalar);
        OUTPUT:
        RETVAL

bool
nok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvNOK (scalar);
        OUTPUT:
        RETVAL

bool
niok(scalar)
        SV *    scalar
        PROTOTYPE: $
        CODE:
        RETVAL = SvNIOK (scalar);
        OUTPUT:
        RETVAL

Revision:	1.5
Committed:	Wed Feb 12 20:42:10 2003 UTC (21 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.4:	+55 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
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			MODULE = Convert::Scalar PACKAGE = Convert::Scalar
10
11			int
12			utf8(scalar,mode=0)
13			SV * scalar
14			SV * mode
15			PROTOTYPE: $;$
16			CODE:
17			SvGETMAGIC (scalar);
18			RETVAL = !!SvUTF8 (scalar);
19			if (items > 1)
20			{
21	root	1.3	if (SvREADONLY (scalar))
22			croak ("Convert::Scalar::utf8 called on read only scalar");
23	root	1.1	if (SvTRUE (mode))
24			SvUTF8_on (scalar);
25			else
26			SvUTF8_off (scalar);
27			}
28			OUTPUT:
29			RETVAL
30
31			void
32			utf8_on(scalar)
33			SV * scalar
34			PROTOTYPE: $
35			PPCODE:
36	root	1.3	if (SvREADONLY (scalar))
37			croak ("Convert::Scalar::utf8_on called on read only scalar");
38
39	root	1.1	SvGETMAGIC (scalar);
40			SvUTF8_on (scalar);
41			if (GIMME_V != G_VOID)
42			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
43
44			void
45			utf8_off(scalar)
46			SV * scalar
47			PROTOTYPE: $
48			PPCODE:
49	root	1.3	if (SvREADONLY (scalar))
50			croak ("Convert::Scalar::utf8_off called on read only scalar");
51
52	root	1.1	SvGETMAGIC (scalar);
53			SvUTF8_off (scalar);
54			if (GIMME_V != G_VOID)
55			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
56
57			int
58			utf8_valid(scalar)
59			SV * scalar
60			PROTOTYPE: $
61			CODE:
62			STRLEN len;
63			char *str = SvPV (scalar, len);
64			RETVAL = !!is_utf8_string (str, len);
65			OUTPUT:
66			RETVAL
67
68			void
69			utf8_upgrade(scalar)
70			SV * scalar
71			PROTOTYPE: $
72			PPCODE:
73	root	1.3	if (SvREADONLY (scalar))
74			croak ("Convert::Scalar::utf8_upgrade called on read only scalar");
75
76	root	1.1	sv_utf8_upgrade(scalar);
77			if (GIMME_V != G_VOID)
78			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
79
80			bool
81			utf8_downgrade(scalar, fail_ok = 0)
82			SV * scalar
83			bool fail_ok
84			PROTOTYPE: $;$
85			CODE:
86	root	1.3	if (SvREADONLY (scalar))
87			croak ("Convert::Scalar::utf8_downgrade called on read only scalar");
88
89	root	1.1	RETVAL = sv_utf8_downgrade (scalar, fail_ok);
90			OUTPUT:
91			RETVAL
92
93			void
94			utf8_encode(scalar)
95			SV * scalar
96			PROTOTYPE: $
97			PPCODE:
98	root	1.3	if (SvREADONLY (scalar))
99			croak ("Convert::Scalar::utf8_encode called on read only scalar");
100
101	root	1.1	sv_utf8_encode (scalar);
102			if (GIMME_V != G_VOID)
103			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
104
105			UV
106			utf8_length(scalar)
107			SV * scalar
108			PROTOTYPE: $
109			CODE:
110	root	1.4	RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
111	root	1.1	OUTPUT:
112			RETVAL
113
114			void
115			unmagic(scalar, type)
116			SV * scalar
117			char type
118			PROTOTYPE: $
119			CODE:
120			sv_unmagic (scalar, type);
121
122			void
123			weaken(scalar)
124			SV * scalar
125			PROTOTYPE: $
126			CODE:
127			sv_rvweaken (scalar);
128
129			void
130			taint(scalar)
131			SV * scalar
132			PROTOTYPE: $
133			CODE:
134			SvTAINTED_on (scalar);
135
136			int
137			tainted(scalar)
138			SV * scalar
139			PROTOTYPE: $
140			CODE:
141			RETVAL = SvTAINTED (scalar);
142			OUTPUT:
143			RETVAL
144
145			void
146			untaint(scalar)
147			SV * scalar
148			PROTOTYPE: $
149			CODE:
150			SvTAINTED_off (scalar);
151
152			void
153			grow(scalar,newlen)
154			SV * scalar
155			U32 newlen
156			PROTOTYPE: $$
157			PPCODE:
158			sv_grow (scalar, newlen);
159			if (GIMME_V != G_VOID)
160			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
161
162	root	1.2	int
163			refcnt(scalar,newrefcnt=0)
164			SV * scalar
165			int newrefcnt
166			PROTOTYPE: $;$
167			ALIAS:
168			refcnt_rv = 1
169			CODE:
170			if (ix)
171			{
172			if (!SvROK (scalar)) croak ("refcnt_rv requires a reference as it's first argument");
173			scalar = SvRV (scalar);
174			}
175			RETVAL = SvREFCNT (scalar);
176			if (items > 1)
177			SvREFCNT (scalar) = newrefcnt;
178			OUTPUT:
179			RETVAL
180
181			void
182			refcnt_inc(scalar)
183			SV * scalar
184			ALIAS:
185			refcnt_inc_rv = 1
186			PROTOTYPE: $
187			CODE:
188			if (ix)
189			{
190			if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");
191			scalar = SvRV (scalar);
192			}
193			SvREFCNT_inc (scalar);
194
195			void
196			refcnt_dec(scalar)
197			SV * scalar
198			ALIAS:
199			refcnt_dec_rv = 1
200			PROTOTYPE: $
201			CODE:
202			if (ix)
203			{
204			if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
205			scalar = SvRV (scalar);
206			}
207			SvREFCNT_dec (scalar);
208	root	1.5
209			bool
210			ok(scalar)
211			SV * scalar
212			PROTOTYPE: $
213			CODE:
214			RETVAL = SvOK (scalar);
215			OUTPUT:
216			RETVAL
217
218			bool
219			uok(scalar)
220			SV * scalar
221			PROTOTYPE: $
222			CODE:
223			RETVAL = SvUOK (scalar);
224			OUTPUT:
225			RETVAL
226
227			bool
228			rok(scalar)
229			SV * scalar
230			PROTOTYPE: $
231			CODE:
232			RETVAL = SvROK (scalar);
233			OUTPUT:
234			RETVAL
235
236			bool
237			pok(scalar)
238			SV * scalar
239			PROTOTYPE: $
240			CODE:
241			RETVAL = SvPOK (scalar);
242			OUTPUT:
243			RETVAL
244
245			bool
246			nok(scalar)
247			SV * scalar
248			PROTOTYPE: $
249			CODE:
250			RETVAL = SvNOK (scalar);
251			OUTPUT:
252			RETVAL
253
254			bool
255			niok(scalar)
256			SV * scalar
257			PROTOTYPE: $
258			CODE:
259			RETVAL = SvNIOK (scalar);
260			OUTPUT:
261			RETVAL
262