# This is typemap code which represents a binary C object as a tied hash in perl.
# TestObjImpl is a typedef,
#
#    typedef TestObj TestObjImpl;
#
# which lets XS know whether you're passing in a tied hash (most of the time),
# or the bare blessed object (for FETCH, STORE, DESTROY, etc.). In most cases,
# usage of TestObjImpl is limited to the .xs file which implements the TestObj
# class, with other .xs files (implementing other classes) taking TestObj
# as their argument (since they expect to be passed a hash).

# The O_OBJECT typemap code is stolen directly from Dean Roehrich's perlobject.map

TYPEMAP

TestObj *               T_TIED_HASH
TestObjImpl *           O_OBJECT

INPUT

O_OBJECT
        if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
                $var = ($type)SvIV((SV*)SvRV( $arg ));
        else{
                warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" )
;
                XSRETURN_UNDEF;
        }

T_TIED_HASH
        {
                MAGIC* magic;

                if( SvROK($arg)
                        && (SvTYPE(SvRV($arg)) == SVt_PVHV)
                        && ((magic = mg_find(SvRV($arg), PERL_MAGIC_tied)) != NULL)
                        && sv_isobject(magic->mg_obj)
                        && (SvTYPE(SvRV(magic->mg_obj)) == SVt_PVMG) ) {

                        $var = ($type)SvIV((SV*)SvRV(magic->mg_obj));
                }
                else {
                        warn( \"${Package}::$func_name() -- $var is not a tied hash refere
nce\" );
                        if(!magic)
                                warn(\"No magic\");
                        else if (!sv_isobject(magic->mg_obj))
                                warn(\"No magic object\");
                        else
                                warn(\"Wrong object type\");

                        XSRETURN_UNDEF;
                }
        }

OUTPUT

T_TIED_HASH

        {
                SV* tie = sv_newmortal();
                HV* hash = newHV();

                /* Get a blessed reference to the pointer, */

                sv_setref_pv(tie, CLASS, (void*)$var);

                /* and tie it to a hash. */

                hv_magic(hash, (GV*)tie, PERL_MAGIC_tied);

                $arg = sv_2mortal((SV*)newRV_noinc((SV*)hash));
        }