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