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

Comparing Convert-Scalar/Scalar.xs (file contents):
Revision 1.1 by root, Thu Sep 27 18:32:22 2001 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	{
		55	if (SvREADONLY (scalar))
		56	croak ("Convert::Scalar::utf8 called on read only scalar");
21	if (SvTRUE (mode))	57	if (SvTRUE (mode))
22	SvUTF8_on (scalar);	58	SvUTF8_on (scalar);
23	else	59	else
24	SvUTF8_off (scalar);	60	SvUTF8_off (scalar);
25	}	61	}
26	OUTPUT:	62	OUTPUT:
27	RETVAL	63	RETVAL
28		64
29	void	65	void
30	utf8_on(scalar)	66	utf8_on (SV *scalar)
31	SV * scalar
32	PROTOTYPE: $
33	PPCODE:	67	PPCODE:
		68	if (SvREADONLY (scalar))
		69	croak ("Convert::Scalar::utf8_on called on read only scalar");
		70
34	SvGETMAGIC (scalar);	71	SvGETMAGIC (scalar);
35	SvUTF8_on (scalar);	72	SvUTF8_on (scalar);
36	if (GIMME_V != G_VOID)	73	RETCOPY (scalar);
37	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
38		74
39	void	75	void
40	utf8_off(scalar)	76	utf8_off (SV *scalar)
41	SV * scalar
42	PROTOTYPE: $
43	PPCODE:	77	PPCODE:
		78	if (SvREADONLY (scalar))
		79	croak ("Convert::Scalar::utf8_off called on read only scalar");
		80
44	SvGETMAGIC (scalar);	81	SvGETMAGIC (scalar);
45	SvUTF8_off (scalar);	82	SvUTF8_off (scalar);
46	if (GIMME_V != G_VOID)	83	RETCOPY (scalar);
47	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
48		84
49	int	85	int
50	utf8_valid(scalar)	86	utf8_valid (SV *scalar)
51	SV * scalar
52	PROTOTYPE: $
53	CODE:	87	CODE:
54	STRLEN len;	88	STRLEN len;
55	char *str = SvPV (scalar, len);	89	char *str = SvPV (scalar, len);
56	RETVAL = !!is_utf8_string (str, len);	90	RETVAL = !!is_utf8_string (str, len);
57	OUTPUT:	91	OUTPUT:
58	RETVAL	92	RETVAL
59		93
60	void	94	void
61	utf8_upgrade(scalar)	95	utf8_upgrade (SV *scalar)
62	SV * scalar
63	PROTOTYPE: $
64	PPCODE:	96	PPCODE:
		97	if (SvREADONLY (scalar))
		98	croak ("Convert::Scalar::utf8_upgrade called on read only scalar");
		99
65	sv_utf8_upgrade(scalar);	100	sv_utf8_upgrade(scalar);
66	if (GIMME_V != G_VOID)	101	RETCOPY (scalar);
67	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
68		102
69	bool	103	bool
70	utf8_downgrade(scalar, fail_ok = 0)	104	utf8_downgrade (SV *scalar, bool fail_ok = 0)
71	SV * scalar
72	bool fail_ok
73	PROTOTYPE: $;$
74	CODE:	105	CODE:
		106	if (SvREADONLY (scalar))
		107	croak ("Convert::Scalar::utf8_downgrade called on read only scalar");
		108
75	RETVAL = sv_utf8_downgrade (scalar, fail_ok);	109	RETVAL = !!sv_utf8_downgrade (scalar, fail_ok);
76	OUTPUT:	110	OUTPUT:
77	RETVAL	111	RETVAL
78		112
79	void	113	void
80	utf8_encode(scalar)	114	utf8_encode (SV *scalar)
81	SV * scalar
82	PROTOTYPE: $
83	PPCODE:	115	PPCODE:
		116	if (SvREADONLY (scalar))
		117	croak ("Convert::Scalar::utf8_encode called on read only scalar");
		118
84	sv_utf8_encode (scalar);	119	sv_utf8_encode (scalar);
85	if (GIMME_V != G_VOID)	120	RETCOPY (scalar);
86	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
87		121
88	UV	122	UV
89	utf8_length(scalar)	123	utf8_length (SV *scalar)
90	SV * scalar
91	PROTOTYPE: $
92	CODE:	124	CODE:
93	RETVAL = (UV) sv_len_utf8 (scalar);	125	RETVAL = (UV) utf8_length (SvPV_nolen (scalar), SvEND (scalar));
94	OUTPUT:	126	OUTPUT:
95	RETVAL	127	RETVAL
96		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
97	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
98	unmagic(scalar, type)	154	unmagic (SV *scalar, char type)
99	SV * scalar
100	char type
101	PROTOTYPE: $
102	CODE:	155	CODE:
103	sv_unmagic (scalar, type);	156	sv_unmagic (scalar, type);
104		157
105	void	158	void
106	weaken(scalar)	159	weaken (SV *scalar)
107	SV * scalar
108	PROTOTYPE: $
109	CODE:	160	CODE:
110	sv_rvweaken (scalar);	161	sv_rvweaken (scalar);
111		162
112	void	163	void
113	taint(scalar)	164	taint (SV *scalar)
114	SV * scalar
115	PROTOTYPE: $
116	CODE:	165	CODE:
117	SvTAINTED_on (scalar);	166	SvTAINTED_on (scalar);
118		167
119	int	168	bool
120	tainted(scalar)	169	tainted (SV *scalar)
121	SV * scalar
122	PROTOTYPE: $
123	CODE:	170	CODE:
124	RETVAL = SvTAINTED (scalar);	171	RETVAL = !!SvTAINTED (scalar);
125	OUTPUT:	172	OUTPUT:
126	RETVAL	173	RETVAL
127		174
128	void	175	void
129	untaint(scalar)	176	untaint (SV *scalar)
130	SV * scalar
131	PROTOTYPE: $
132	CODE:	177	CODE:
133	SvTAINTED_off (scalar);	178	SvTAINTED_off (scalar);
134		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
135	void	189	void
136	grow(scalar,newlen)	190	grow (SV *scalar, STRLEN newlen)
137	SV * scalar
138	U32 newlen
139	PROTOTYPE: $$
140	PPCODE:	191	PPCODE:
141	sv_grow (scalar, newlen);	192	sv_grow (scalar, newlen);
142	if (GIMME_V != G_VOID)	193	if (GIMME_V != G_VOID)
143	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));	194	XPUSHs (sv_2mortal (SvREFCNT_inc (scalar)));
144		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
		294	int
		295	refcnt (SV *scalar, U32 newrefcnt = NO_INIT)
		296	ALIAS:
		297	refcnt_rv = 1
		298	CODE:
		299	if (ix)
		300	{
		301	if (!SvROK (scalar)) croak ("refcnt_rv requires a reference as it's first argument");
		302	scalar = SvRV (scalar);
		303	}
		304	RETVAL = SvREFCNT (scalar);
		305	if (items > 1)
		306	SvREFCNT (scalar) = newrefcnt;
		307	OUTPUT:
		308	RETVAL
		309
		310	void
		311	refcnt_inc (SV *scalar)
		312	ALIAS:
		313	refcnt_inc_rv = 1
		314	CODE:
		315	if (ix)
		316	{
		317	if (!SvROK (scalar)) croak ("refcnt_inc_rv requires a reference as it's first argument");
		318	scalar = SvRV (scalar);
		319	}
		320	SvREFCNT_inc (scalar);
		321
		322	void
		323	refcnt_dec (SV *scalar)
		324	ALIAS:
		325	refcnt_dec_rv = 1
		326	CODE:
		327	if (ix)
		328	{
		329	if (!SvROK (scalar)) croak ("refcnt_dec_rv requires a reference as it's first argument");
		330	scalar = SvRV (scalar);
		331	}
		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.1 by root, Thu Sep 27 18:32:22 2001 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.1 by root, Thu Sep 27 18:32:22 2001 UTC vs.
Revision 1.12 by root, Tue Aug 15 07:29:07 2017 UTC