XS/APItest/APItest.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"


MODULE = XS::APItest:Hash       PACKAGE = XS::APItest::Hash

#define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)

bool
exists(hash, key_sv)
    PREINIT:
    STRLEN len;
    const char *key;
    INPUT:
    HV *hash
    SV *key_sv
    CODE:
    key = SvPV(key_sv, len);
    RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
        OUTPUT:
        RETVAL

SV *
delete(hash, key_sv)
    PREINIT:
    STRLEN len;
    const char *key;
    INPUT:
    HV *hash
    SV *key_sv
    CODE:
    key = SvPV(key_sv, len);
    /* It's already mortal, so need to increase reference count.  */
    RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
        OUTPUT:
        RETVAL

SV *
store_ent(hash, key, value)
    PREINIT:
    SV *copy;
    HE *result;
    INPUT:
    HV *hash
    SV *key
    SV *value
    CODE:
    copy = newSV(0);
    result = hv_store_ent(hash, key, copy, 0);
    SvSetMagicSV(copy, value);
    if (!result) {
        SvREFCNT_dec(copy);
        XSRETURN_EMPTY;
    }
    /* It's about to become mortal, so need to increase reference count.
     */
    RETVAL = SvREFCNT_inc(HeVAL(result));
        OUTPUT:
        RETVAL


SV *
store(hash, key_sv, value)
    PREINIT:
    STRLEN len;
    const char *key;
    SV *copy;
    SV **result;
    INPUT:
    HV *hash
    SV *key_sv
    SV *value
    CODE:
    key = SvPV(key_sv, len);
    copy = newSV(0);
    result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
    SvSetMagicSV(copy, value);
    if (!result) {
        SvREFCNT_dec(copy);
        XSRETURN_EMPTY;
    }
    /* It's about to become mortal, so need to increase reference count.
     */
    RETVAL = SvREFCNT_inc(*result);
        OUTPUT:
        RETVAL


SV *
fetch(hash, key_sv)
    PREINIT:
    STRLEN len;
    const char *key;
    SV **result;
    INPUT:
    HV *hash
    SV *key_sv
    CODE:
    key = SvPV(key_sv, len);
    result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
    if (!result) {
        XSRETURN_EMPTY;
    }
    /* Force mg_get  */
    RETVAL = newSVsv(*result);
        OUTPUT:
        RETVAL
=pod

sub TIEHASH  { bless {}, $_[0] }
sub STORE    { $_[0]->{$_[1]} = $_[2] }
sub FETCH    { $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY  { each %{$_[0]} }
sub EXISTS   { exists $_[0]->{$_[1]} }
sub DELETE   { delete $_[0]->{$_[1]} }
sub CLEAR    { %{$_[0]} = () }

=cut

MODULE = XS::APItest        PACKAGE = XS::APItest

PROTOTYPES: DISABLE

void
print_double(val)
        double val
        CODE:
        printf("%5.3f\n",val);

int
have_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
        RETVAL = 1;
#else
        RETVAL = 0;
#endif
        OUTPUT:
        RETVAL

void
print_long_double()
        CODE:
#ifdef HAS_LONG_DOUBLE
#   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
        long double val = 7.0;
        printf("%5.3" PERL_PRIfldbl "\n",val);
#   else
        double val = 7.0;
        printf("%5.3f\n",val);
#   endif
#endif

void
print_int(val)
        int val
        CODE:
        printf("%d\n",val);

void
print_long(val)
        long val
        CODE:
        printf("%ld\n",val);

void
print_float(val)
        float val
        CODE:
        printf("%5.3f\n",val);

void
print_flush()
        CODE:
    fflush(stdout);