1N/A#include "EXTERN.h"
1N/A#include "perl.h"
1N/A#include "XSUB.h"
1N/A
1N/A
1N/AMODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
1N/A
1N/A#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
1N/A
1N/Abool
1N/Aexists(hash, key_sv)
1N/A PREINIT:
1N/A STRLEN len;
1N/A const char *key;
1N/A INPUT:
1N/A HV *hash
1N/A SV *key_sv
1N/A CODE:
1N/A key = SvPV(key_sv, len);
1N/A RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
1N/A OUTPUT:
1N/A RETVAL
1N/A
1N/ASV *
1N/Adelete(hash, key_sv)
1N/A PREINIT:
1N/A STRLEN len;
1N/A const char *key;
1N/A INPUT:
1N/A HV *hash
1N/A SV *key_sv
1N/A CODE:
1N/A key = SvPV(key_sv, len);
1N/A /* It's already mortal, so need to increase reference count. */
1N/A RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
1N/A OUTPUT:
1N/A RETVAL
1N/A
1N/ASV *
1N/Astore_ent(hash, key, value)
1N/A PREINIT:
1N/A SV *copy;
1N/A HE *result;
1N/A INPUT:
1N/A HV *hash
1N/A SV *key
1N/A SV *value
1N/A CODE:
1N/A copy = newSV(0);
1N/A result = hv_store_ent(hash, key, copy, 0);
1N/A SvSetMagicSV(copy, value);
1N/A if (!result) {
1N/A SvREFCNT_dec(copy);
1N/A XSRETURN_EMPTY;
1N/A }
1N/A /* It's about to become mortal, so need to increase reference count.
1N/A */
1N/A RETVAL = SvREFCNT_inc(HeVAL(result));
1N/A OUTPUT:
1N/A RETVAL
1N/A
1N/A
1N/ASV *
1N/Astore(hash, key_sv, value)
1N/A PREINIT:
1N/A STRLEN len;
1N/A const char *key;
1N/A SV *copy;
1N/A SV **result;
1N/A INPUT:
1N/A HV *hash
1N/A SV *key_sv
1N/A SV *value
1N/A CODE:
1N/A key = SvPV(key_sv, len);
1N/A copy = newSV(0);
1N/A result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
1N/A SvSetMagicSV(copy, value);
1N/A if (!result) {
1N/A SvREFCNT_dec(copy);
1N/A XSRETURN_EMPTY;
1N/A }
1N/A /* It's about to become mortal, so need to increase reference count.
1N/A */
1N/A RETVAL = SvREFCNT_inc(*result);
1N/A OUTPUT:
1N/A RETVAL
1N/A
1N/A
1N/ASV *
1N/Afetch(hash, key_sv)
1N/A PREINIT:
1N/A STRLEN len;
1N/A const char *key;
1N/A SV **result;
1N/A INPUT:
1N/A HV *hash
1N/A SV *key_sv
1N/A CODE:
1N/A key = SvPV(key_sv, len);
1N/A result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
1N/A if (!result) {
1N/A XSRETURN_EMPTY;
1N/A }
1N/A /* Force mg_get */
1N/A RETVAL = newSVsv(*result);
1N/A OUTPUT:
1N/A RETVAL
1N/A=pod
1N/A
1N/Asub TIEHASH { bless {}, $_[0] }
1N/Asub STORE { $_[0]->{$_[1]} = $_[2] }
1N/Asub FETCH { $_[0]->{$_[1]} }
1N/Asub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
1N/Asub NEXTKEY { each %{$_[0]} }
1N/Asub EXISTS { exists $_[0]->{$_[1]} }
1N/Asub DELETE { delete $_[0]->{$_[1]} }
1N/Asub CLEAR { %{$_[0]} = () }
1N/A
1N/A=cut
1N/A
1N/AMODULE = XS::APItest PACKAGE = XS::APItest
1N/A
1N/APROTOTYPES: DISABLE
1N/A
1N/Avoid
1N/Aprint_double(val)
1N/A double val
1N/A CODE:
1N/A printf("%5.3f\n",val);
1N/A
1N/Aint
1N/Ahave_long_double()
1N/A CODE:
1N/A#ifdef HAS_LONG_DOUBLE
1N/A RETVAL = 1;
1N/A#else
1N/A RETVAL = 0;
1N/A#endif
1N/A OUTPUT:
1N/A RETVAL
1N/A
1N/Avoid
1N/Aprint_long_double()
1N/A CODE:
1N/A#ifdef HAS_LONG_DOUBLE
1N/A# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
1N/A long double val = 7.0;
1N/A printf("%5.3" PERL_PRIfldbl "\n",val);
1N/A# else
1N/A double val = 7.0;
1N/A printf("%5.3f\n",val);
1N/A# endif
1N/A#endif
1N/A
1N/Avoid
1N/Aprint_int(val)
1N/A int val
1N/A CODE:
1N/A printf("%d\n",val);
1N/A
1N/Avoid
1N/Aprint_long(val)
1N/A long val
1N/A CODE:
1N/A printf("%ld\n",val);
1N/A
1N/Avoid
1N/Aprint_float(val)
1N/A float val
1N/A CODE:
1N/A printf("%5.3f\n",val);
1N/A
1N/Avoid
1N/Aprint_flush()
1N/A CODE:
1N/A fflush(stdout);