# This is typemap code which represents a binary C object as a tied ha
+sh in perl.
# TestObjImpl is a typedef,
#
# typedef TestObj TestObjImpl;
#
# which lets XS know whether you're passing in a tied hash (most of th
+e time),
# or the bare blessed object (for FETCH, STORE, DESTROY, etc.). In mos
+t cases,
# usage of TestObjImpl is limited to the .xs file which implements the
+ TestObj
# class, with other .xs files (implementing other classes) taking Test
+Obj
# as their argument (since they expect to be passed a hash).
# The O_OBJECT typemap code is stolen directly from Dean Roehrich's pe
+rlobject.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 bles
+sed SV reference\" )
;
XSRETURN_UNDEF;
}
T_TIED_HASH
{
MAGIC* magic;
if( SvROK($arg)
&& (SvTYPE(SvRV($arg)) == SVt_PVHV)
&& ((magic = mg_find(SvRV($arg), PERL_MAGIC_ti
+ed)) != 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 no
+t 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));
}
|