Convert-Scalar/Scalar.xs

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

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

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

bool
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);

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