[ViewVC] Diff of: cvs/Convert-Scalar/Scalar.xs

Comparing Convert-Scalar/Scalar.xs (file contents):
Revision 1.4 by root, Mon Sep 23 03:42:02 2002 UTC vs.
Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC

…		…
1	#include "EXTERN.h"	1	#include "EXTERN.h"
2	#include "perl.h"	2	#include "perl.h"
3	#include "XSUB.h"	3	#include "XSUB.h"
4		4
5	#if PERL_VERSION < 7	5	#define RETCOPY(sv) \
6	# define is_utf8_string(s,l) (croak ("utf8_valid requires perl 5.7 or higher"), 0)	6	if (GIMME_V != G_VOID) \
7	#endif	7	{ \
		8	dXSTARG; \
		9	sv_setsv (TARG, (sv)); \
		10	EXTEND (SP, 1); \
		11	PUSHs (TARG); \
		12	}
		13
		14	static void
		15	extend (SV *scalar, STRLEN addlen)
		16	{
		17	SvUPGRADE (scalar, SVt_PV);
		18
		19	STRLEN cur = SvCUR (scalar);
		20	STRLEN len = SvLEN (scalar);
		21
		22	if (cur + addlen < len)
		23	return;
		24
		25	STRLEN l = len;
		26	STRLEN o = cur + addlen >= 4096 ? sizeof (void ) 4 : 0;
		27
		28	if (l < 64)
		29	l = 64;
		30
		31	/* for big sizes, leave a bit of space for malloc management, and assume 4kb or smaller pages */
		32	addlen += o;
		33
		34	while (cur + addlen >= l)
		35	l <<= 1;
		36
		37	sv_grow (scalar, l - o);
		38	}
8		39
9	MODULE = Convert::Scalar PACKAGE = Convert::Scalar	40	MODULE = Convert::Scalar PACKAGE = Convert::Scalar
10		41
11	int	42	TYPEMAP: <<EOF
12	utf8(scalar,mode=0)	43	SSize_t T_UV
13	SV * scalar	44	EOF
14	SV * mode	45
15	PROTOTYPE: $;$	46	PROTOTYPES: ENABLE
		47
		48	bool
		49	utf8 (SV scalar, SV mode = NO_INIT)
16	CODE:	50	CODE:
17	SvGETMAGIC (scalar);	51	SvGETMAGIC (scalar);
18	RETVAL = !!SvUTF8 (scalar);	52	RETVAL = !!SvUTF8 (scalar);
19	if (items > 1)	53	if (items > 1)
20	{	54	{
27	}	61	}
28	OUTPUT:	62	OUTPUT:
29	RETVAL	63	RETVAL
30		64
31	void	65	void
32	utf8_on(scalar)	66	utf8_on (SV *scalar)
33	SV * scalar
34	PROTOTYPE: $
35	PPCODE:	67	PPCODE:
36	if (SvREADONLY (scalar))	68	if (SvREADONLY (scalar))
37	croak ("Convert::Scalar::utf8_on called on read only scalar");	69	croak ("Convert::Scalar::utf8_on called on read only scalar");
38		70
39	SvGETMAGIC (scalar);	71	SvGETMAGIC (scalar);
40	SvUTF8_on (scalar);	72	SvUTF8_on (scalar);
41	if (GIMME_V != G_VOID)	73	RETCOPY (scalar);
42	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
43		74
44	void	75	void
45	utf8_off(scalar)	76	utf8_off (SV *scalar)
46	SV * scalar
47	PROTOTYPE: $
48	PPCODE:	77	PPCODE:
49	if (SvREADONLY (scalar))	78	if (SvREADONLY (scalar))
50	croak ("Convert::Scalar::utf8_off called on read only scalar");	79	croak ("Convert::Scalar::utf8_off called on read only scalar");
51		80
52	SvGETMAGIC (scalar);	81	SvGETMAGIC (scalar);
53	SvUTF8_off (scalar);	82	SvUTF8_off (scalar);
54	if (GIMME_V != G_VOID)	83	RETCOPY (scalar);
55	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
56		84
57	int	85	int
58	utf8_valid(scalar)	86	utf8_valid (SV *scalar)
59	SV * scalar
60	PROTOTYPE: $
61	CODE:	87	CODE:
62	STRLEN len;	88	STRLEN len;
63	char *str = SvPV (scalar, len);	89	char *str = SvPV (scalar, len);
64	RETVAL = !!is_utf8_string (str, len);	90	RETVAL = !!is_utf8_string (str, len);
65	OUTPUT:	91	OUTPUT:
66	RETVAL	92	RETVAL
67		93
68	void	94	void
69	utf8_upgrade(scalar)	95	utf8_upgrade (SV *scalar)
70	SV * scalar
71	PROTOTYPE: $
72	PPCODE:	96	PPCODE:
73	if (SvREADONLY (scalar))	97	if (SvREADONLY (scalar))
74	croak ("Convert::Scalar::utf8_upgrade called on read only scalar");	98	croak ("Convert::Scalar::utf8_upgrade called on read only scalar");
75		99
76	sv_utf8_upgrade(scalar);	100	sv_utf8_upgrade(scalar);
77	if (GIMME_V != G_VOID)	101	RETCOPY (scalar);
78	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
79		102
80	bool	103	bool
81	utf8_downgrade(scalar, fail_ok = 0)	104	utf8_downgrade (SV *scalar, bool fail_ok = 0)
82	SV * scalar
83	bool fail_ok
84	PROTOTYPE: $;$
85	CODE:	105	CODE:
86	if (SvREADONLY (scalar))	106	if (SvREADONLY (scalar))
87	croak ("Convert::Scalar::utf8_downgrade called on read only scalar");	107	croak ("Convert::Scalar::utf8_downgrade called on read only scalar");
88		108
89	RETVAL = sv_utf8_downgrade (scalar, fail_ok);	109	RETVAL = !!sv_utf8_downgrade (scalar, fail_ok);
90	OUTPUT:	110	OUTPUT:
91	RETVAL	111	RETVAL
92		112
93	void	113	void
94	utf8_encode(scalar)	114	utf8_encode (SV *scalar)
95	SV * scalar
96	PROTOTYPE: $
97	PPCODE:	115	PPCODE:
98	if (SvREADONLY (scalar))	116	if (SvREADONLY (scalar))
99	croak ("Convert::Scalar::utf8_encode called on read only scalar");	117	croak ("Convert::Scalar::utf8_encode called on read only scalar");
100		118
101	sv_utf8_encode (scalar);	119	sv_utf8_encode (scalar);
102	if (GIMME_V != G_VOID)	120	RETCOPY (scalar);
103	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
104		121
105	UV	122	UV
106	utf8_length(scalar)	123	utf8_length (SV *scalar)
107	SV * scalar
108	PROTOTYPE: $
109	CODE:	124	CODE:
110	RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));	125	RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
111	OUTPUT:	126	OUTPUT:
112	RETVAL	127	RETVAL
113		128
		129	bool
		130	readonly (SV scalar, SV on = NO_INIT)
		131	CODE:
		132	RETVAL = SvREADONLY (scalar);
		133	if (items > 1)
		134	{
		135	if (SvTRUE (on))
		136	SvREADONLY_on (scalar);
		137	else
		138	SvREADONLY_off (scalar);
		139	}
		140	OUTPUT:
		141	RETVAL
		142
114	void	143	void
		144	readonly_on (SV *scalar)
		145	CODE:
		146	SvREADONLY_on (scalar);
		147
		148	void
		149	readonly_off (SV *scalar)
		150	CODE:
		151	SvREADONLY_off (scalar);
		152
		153	void
115	unmagic(scalar, type)	154	unmagic (SV *scalar, char type)
116	SV * scalar
117	char type
118	PROTOTYPE: $
119	CODE:	155	CODE:
120	sv_unmagic (scalar, type);	156	sv_unmagic (scalar, type);
121		157
122	void	158	void
123	weaken(scalar)	159	weaken (SV *scalar)
124	SV * scalar
125	PROTOTYPE: $
126	CODE:	160	CODE:
127	sv_rvweaken (scalar);	161	sv_rvweaken (scalar);
128		162
129	void	163	void
130	taint(scalar)	164	taint (SV *scalar)
131	SV * scalar
132	PROTOTYPE: $
133	CODE:	165	CODE:
134	SvTAINTED_on (scalar);	166	SvTAINTED_on (scalar);
135		167
136	int	168	bool
137	tainted(scalar)	169	tainted (SV *scalar)
138	SV * scalar
139	PROTOTYPE: $
140	CODE:	170	CODE:
141	RETVAL = SvTAINTED (scalar);	171	RETVAL = !!SvTAINTED (scalar);
142	OUTPUT:	172	OUTPUT:
143	RETVAL	173	RETVAL
144		174
145	void	175	void
146	untaint(scalar)	176	untaint (SV *scalar)
147	SV * scalar
148	PROTOTYPE: $
149	CODE:	177	CODE:
150	SvTAINTED_off (scalar);	178	SvTAINTED_off (scalar);
151		179
		180	STRLEN
		181	len (SV *scalar)
		182	CODE:
		183	if (SvTYPE (scalar) < SVt_PV)
		184	XSRETURN_UNDEF;
		185	RETVAL = SvLEN (scalar);
		186	OUTPUT:
		187	RETVAL
		188
152	void	189	void
153	grow(scalar,newlen)	190	grow (SV *scalar, STRLEN newlen)
154	SV * scalar
155	U32 newlen
156	PROTOTYPE: $$
157	PPCODE:	191	PPCODE:
158	sv_grow (scalar, newlen);	192	sv_grow (scalar, newlen);
159	if (GIMME_V != G_VOID)	193	if (GIMME_V != G_VOID)
160	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));	194	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
161		195
		196	void
		197	extend (SV *scalar, STRLEN addlen = 64)
		198	PPCODE:
		199	{
		200	extend (scalar, addlen);
		201
		202	if (GIMME_V != G_VOID)
		203	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
		204	}
		205
		206	SSize_t
		207	extend_read (PerlIO fh, SV scalar, STRLEN addlen = 64)
		208	CODE:
		209	{
		210	if (SvUTF8 (scalar))
		211	sv_utf8_downgrade (scalar, 0);
		212
		213	extend (scalar, addlen);
		214
		215	RETVAL = PerlLIO_read (PerlIO_fileno (fh), SvEND (scalar), SvLEN (scalar) - SvCUR (scalar));
		216
		217	if (RETVAL < 0)
		218	XSRETURN_UNDEF;
		219
		220	SvPOK_only (scalar);
		221	SvCUR_set (scalar, SvCUR (scalar) + RETVAL);
		222	}
		223	OUTPUT: RETVAL
		224
		225	SSize_t
		226	read_all (PerlIO fh, SV scalar, STRLEN count)
		227	CODE:
		228	{
		229	SvUPGRADE (scalar, SVt_PV);
		230	if (SvUTF8 (scalar))
		231	sv_utf8_downgrade (scalar, 0);
		232
		233	SvPOK_only (scalar);
		234
		235	int fd = PerlIO_fileno (fh);
		236	RETVAL = 0;
		237
		238	SvGROW (scalar, count);
		239
		240	for (;;)
		241	{
		242	STRLEN rem = count - RETVAL;
		243
		244	if (!rem)
		245	break;
		246
		247	STRLEN got = PerlLIO_read (fd, SvPVX (scalar) + RETVAL, rem);
		248
		249	if (got == 0)
		250	break;
		251	else if (got < 0)
		252	if (RETVAL)
		253	break;
		254	else
		255	XSRETURN_UNDEF;
		256
		257	RETVAL += got;
		258	}
		259
		260	SvCUR_set (scalar, RETVAL);
		261	}
		262	OUTPUT: RETVAL
		263
		264	SSize_t
		265	write_all (PerlIO fh, SV scalar)
		266	CODE:
		267	{
		268	STRLEN count;
		269	char *ptr = SvPVbyte (scalar, count);
		270
		271	int fd = PerlIO_fileno (fh);
		272	RETVAL = 0;
		273
		274	for (;;)
		275	{
		276	STRLEN rem = count - RETVAL;
		277
		278	if (!rem)
		279	break;
		280
		281	STRLEN got = PerlLIO_write (fd, ptr + RETVAL, rem);
		282
		283	if (got < 0)
		284	if (RETVAL)
		285	break;
		286	else
		287	XSRETURN_UNDEF;
		288
		289	RETVAL += got;
		290	}
		291	}
		292	OUTPUT: RETVAL
		293
162	int	294	int
163	refcnt(scalar,newrefcnt=0)	295	refcnt (SV *scalar, U32 newrefcnt = NO_INIT)
164	SV * scalar
165	int newrefcnt
166	PROTOTYPE: $;$
167	ALIAS:	296	ALIAS:
168	refcnt_rv = 1	297	refcnt_rv = 1
169	CODE:	298	CODE:
170	if (ix)	299	if (ix)
171	{	300	{
…		…
177	SvREFCNT (scalar) = newrefcnt;	306	SvREFCNT (scalar) = newrefcnt;
178	OUTPUT:	307	OUTPUT:
179	RETVAL	308	RETVAL
180		309
181	void	310	void
182	refcnt_inc(scalar)	311	refcnt_inc (SV *scalar)
183	SV * scalar
184	ALIAS:	312	ALIAS:
185	refcnt_inc_rv = 1	313	refcnt_inc_rv = 1
186	PROTOTYPE: $
187	CODE:	314	CODE:
188	if (ix)	315	if (ix)
189	{	316	{
190	if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");	317	if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");
191	scalar = SvRV (scalar);	318	scalar = SvRV (scalar);
192	}	319	}
193	SvREFCNT_inc (scalar);	320	SvREFCNT_inc (scalar);
194		321
195	void	322	void
196	refcnt_dec(scalar)	323	refcnt_dec (SV *scalar)
197	SV * scalar
198	ALIAS:	324	ALIAS:
199	refcnt_dec_rv = 1	325	refcnt_dec_rv = 1
200	PROTOTYPE: $
201	CODE:	326	CODE:
202	if (ix)	327	if (ix)
203	{	328	{
204	if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");	329	if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
205	scalar = SvRV (scalar);	330	scalar = SvRV (scalar);
206	}	331	}
207	SvREFCNT_dec (scalar);	332	SvREFCNT_dec (scalar);
		333
		334	bool
		335	ok (SV *scalar)
		336	CODE:
		337	RETVAL = !!SvOK (scalar);
		338	OUTPUT:
		339	RETVAL
		340
		341	bool
		342	uok (SV *scalar)
		343	CODE:
		344	RETVAL = !!SvUOK (scalar);
		345	OUTPUT:
		346	RETVAL
		347
		348	bool
		349	rok (SV *scalar)
		350	CODE:
		351	RETVAL = !!SvROK (scalar);
		352	OUTPUT:
		353	RETVAL
		354
		355	bool
		356	pok (SV *scalar)
		357	CODE:
		358	RETVAL = !!SvPOK (scalar);
		359	OUTPUT:
		360	RETVAL
		361
		362	bool
		363	nok (SV *scalar)
		364	CODE:
		365	RETVAL = !!SvNOK (scalar);
		366	OUTPUT:
		367	RETVAL
		368
		369	bool
		370	niok (SV *scalar)
		371	CODE:
		372	RETVAL = !!SvNIOK (scalar);
		373	OUTPUT:
		374	RETVAL
		375

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Convert-Scalar/Scalar.xs (file contents): Revision 1.4 by root, Mon Sep 23 03:42:02 2002 UTC vs. Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC

Diff Legend

Comparing Convert-Scalar/Scalar.xs (file contents):
Revision 1.4 by root, Mon Sep 23 03:42:02 2002 UTC vs.
Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC