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 (SvTRUE (mode))
              SvUTF8_on (scalar);
            else
              SvUTF8_off (scalar);
          }
        OUTPUT:
        RETVAL

void
utf8_on(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        SvGETMAGIC (scalar);
        SvUTF8_on (scalar);
        if (GIMME_V != G_VOID)
          XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));

void
utf8_off(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        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:
        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:
        RETVAL = sv_utf8_downgrade (scalar, fail_ok);
        OUTPUT:
        RETVAL

void
utf8_encode(scalar)
        SV *    scalar
        PROTOTYPE: $
        PPCODE:
        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) sv_len_utf8 (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);
Revision:	1.2
Committed:	Sun Jan 20 04:23:59 2002 UTC (24 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.1:	+46 -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			if (SvTRUE (mode))
22			SvUTF8_on (scalar);
23			else
24			SvUTF8_off (scalar);
25			}
26			OUTPUT:
27			RETVAL
28
29			void
30			utf8_on(scalar)
31			SV * scalar
32			PROTOTYPE: $
33			PPCODE:
34			SvGETMAGIC (scalar);
35			SvUTF8_on (scalar);
36			if (GIMME_V != G_VOID)
37			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
38
39			void
40			utf8_off(scalar)
41			SV * scalar
42			PROTOTYPE: $
43			PPCODE:
44			SvGETMAGIC (scalar);
45			SvUTF8_off (scalar);
46			if (GIMME_V != G_VOID)
47			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
48
49			int
50			utf8_valid(scalar)
51			SV * scalar
52			PROTOTYPE: $
53			CODE:
54			STRLEN len;
55			char *str = SvPV (scalar, len);
56			RETVAL = !!is_utf8_string (str, len);
57			OUTPUT:
58			RETVAL
59
60			void
61			utf8_upgrade(scalar)
62			SV * scalar
63			PROTOTYPE: $
64			PPCODE:
65			sv_utf8_upgrade(scalar);
66			if (GIMME_V != G_VOID)
67			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
68
69			bool
70			utf8_downgrade(scalar, fail_ok = 0)
71			SV * scalar
72			bool fail_ok
73			PROTOTYPE: $;$
74			CODE:
75			RETVAL = sv_utf8_downgrade (scalar, fail_ok);
76			OUTPUT:
77			RETVAL
78
79			void
80			utf8_encode(scalar)
81			SV * scalar
82			PROTOTYPE: $
83			PPCODE:
84			sv_utf8_encode (scalar);
85			if (GIMME_V != G_VOID)
86			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
87
88			UV
89			utf8_length(scalar)
90			SV * scalar
91			PROTOTYPE: $
92			CODE:
93			RETVAL = (UV) sv_len_utf8 (scalar);
94			OUTPUT:
95			RETVAL
96
97			void
98			unmagic(scalar, type)
99			SV * scalar
100			char type
101			PROTOTYPE: $
102			CODE:
103			sv_unmagic (scalar, type);
104
105			void
106			weaken(scalar)
107			SV * scalar
108			PROTOTYPE: $
109			CODE:
110			sv_rvweaken (scalar);
111
112			void
113			taint(scalar)
114			SV * scalar
115			PROTOTYPE: $
116			CODE:
117			SvTAINTED_on (scalar);
118
119			int
120			tainted(scalar)
121			SV * scalar
122			PROTOTYPE: $
123			CODE:
124			RETVAL = SvTAINTED (scalar);
125			OUTPUT:
126			RETVAL
127
128			void
129			untaint(scalar)
130			SV * scalar
131			PROTOTYPE: $
132			CODE:
133			SvTAINTED_off (scalar);
134
135			void
136			grow(scalar,newlen)
137			SV * scalar
138			U32 newlen
139			PROTOTYPE: $$
140			PPCODE:
141			sv_grow (scalar, newlen);
142			if (GIMME_V != G_VOID)
143			XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
144
145	root	1.2	int
146			refcnt(scalar,newrefcnt=0)
147			SV * scalar
148			int newrefcnt
149			PROTOTYPE: $;$
150			ALIAS:
151			refcnt_rv = 1
152			CODE:
153			if (ix)
154			{
155			if (!SvROK (scalar)) croak ("refcnt_rv requires a reference as it's first argument");
156			scalar = SvRV (scalar);
157			}
158			RETVAL = SvREFCNT (scalar);
159			if (items > 1)
160			SvREFCNT (scalar) = newrefcnt;
161			OUTPUT:
162			RETVAL
163
164			void
165			refcnt_inc(scalar)
166			SV * scalar
167			ALIAS:
168			refcnt_inc_rv = 1
169			PROTOTYPE: $
170			CODE:
171			if (ix)
172			{
173			if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");
174			scalar = SvRV (scalar);
175			}
176			SvREFCNT_inc (scalar);
177
178			void
179			refcnt_dec(scalar)
180			SV * scalar
181			ALIAS:
182			refcnt_dec_rv = 1
183			PROTOTYPE: $
184			CODE:
185			if (ix)
186			{
187			if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
188			scalar = SvRV (scalar);
189			}
190			SvREFCNT_dec (scalar);