1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5
6MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
7
8#define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
9
10bool
11exists(hash, key_sv)
12	PREINIT:
13	STRLEN len;
14	const char *key;
15	INPUT:
16	HV *hash
17	SV *key_sv
18	CODE:
19	key = SvPV(key_sv, len);
20	RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
21        OUTPUT:
22        RETVAL
23
24SV *
25delete(hash, key_sv)
26	PREINIT:
27	STRLEN len;
28	const char *key;
29	INPUT:
30	HV *hash
31	SV *key_sv
32	CODE:
33	key = SvPV(key_sv, len);
34	/* It's already mortal, so need to increase reference count.  */
35	RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
36        OUTPUT:
37        RETVAL
38
39SV *
40store_ent(hash, key, value)
41	PREINIT:
42	SV *copy;
43	HE *result;
44	INPUT:
45	HV *hash
46	SV *key
47	SV *value
48	CODE:
49	copy = newSV(0);
50	result = hv_store_ent(hash, key, copy, 0);
51	SvSetMagicSV(copy, value);
52	if (!result) {
53	    SvREFCNT_dec(copy);
54	    XSRETURN_EMPTY;
55	}
56	/* It's about to become mortal, so need to increase reference count.
57	 */
58	RETVAL = SvREFCNT_inc(HeVAL(result));
59        OUTPUT:
60        RETVAL
61
62
63SV *
64store(hash, key_sv, value)
65	PREINIT:
66	STRLEN len;
67	const char *key;
68	SV *copy;
69	SV **result;
70	INPUT:
71	HV *hash
72	SV *key_sv
73	SV *value
74	CODE:
75	key = SvPV(key_sv, len);
76	copy = newSV(0);
77	result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
78	SvSetMagicSV(copy, value);
79	if (!result) {
80	    SvREFCNT_dec(copy);
81	    XSRETURN_EMPTY;
82	}
83	/* It's about to become mortal, so need to increase reference count.
84	 */
85	RETVAL = SvREFCNT_inc(*result);
86        OUTPUT:
87        RETVAL
88
89
90SV *
91fetch(hash, key_sv)
92	PREINIT:
93	STRLEN len;
94	const char *key;
95	SV **result;
96	INPUT:
97	HV *hash
98	SV *key_sv
99	CODE:
100	key = SvPV(key_sv, len);
101	result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
102	if (!result) {
103	    XSRETURN_EMPTY;
104	}
105	/* Force mg_get  */
106	RETVAL = newSVsv(*result);
107        OUTPUT:
108        RETVAL
109=pod
110
111sub TIEHASH  { bless {}, $_[0] }
112sub STORE    { $_[0]->{$_[1]} = $_[2] }
113sub FETCH    { $_[0]->{$_[1]} }
114sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
115sub NEXTKEY  { each %{$_[0]} }
116sub EXISTS   { exists $_[0]->{$_[1]} }
117sub DELETE   { delete $_[0]->{$_[1]} }
118sub CLEAR    { %{$_[0]} = () }
119
120=cut
121
122MODULE = XS::APItest		PACKAGE = XS::APItest
123
124PROTOTYPES: DISABLE
125
126void
127print_double(val)
128        double val
129        CODE:
130        printf("%5.3f\n",val);
131
132int
133have_long_double()
134        CODE:
135#ifdef HAS_LONG_DOUBLE
136        RETVAL = 1;
137#else
138        RETVAL = 0;
139#endif
140        OUTPUT:
141        RETVAL
142
143void
144print_long_double()
145        CODE:
146#ifdef HAS_LONG_DOUBLE
147#   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
148        long double val = 7.0;
149        printf("%5.3" PERL_PRIfldbl "\n",val);
150#   else
151        double val = 7.0;
152        printf("%5.3f\n",val);
153#   endif
154#endif
155
156void
157print_int(val)
158        int val
159        CODE:
160        printf("%d\n",val);
161
162void
163print_long(val)
164        long val
165        CODE:
166        printf("%ld\n",val);
167
168void
169print_float(val)
170        float val
171        CODE:
172        printf("%5.3f\n",val);
173
174void
175print_flush()
176    	CODE:
177	fflush(stdout);
178