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

#define RETCOPY(sv)             \
  if (GIMME_V != G_VOID)        \
    {                           \
      dXSTARG;                  \
      sv_setsv (TARG, (sv));    \
      EXTEND (SP, 1);           \
      PUSHs (TARG);             \
    }

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