return &sv_no;
}
+bool
+sv_derived_from(sv, name)
+SV * sv ;
+char * name ;
+{
+ SV *rv;
+ char *type;
+ HV *stash;
+
+ stash = Nullhv;
+ type = Nullch;
+
+ if (SvGMAGICAL(sv))
+ mg_get(sv) ;
+
+ if (SvROK(sv)) {
+ sv = SvRV(sv);
+ type = sv_reftype(sv,0);
+ if(SvOBJECT(sv))
+ stash = SvSTASH(sv);
+ }
+ else {
+ stash = gv_stashsv(sv, FALSE);
+ }
+
+ return (type && strEQ(type,name)) ||
+ (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
+ ? TRUE
+ : FALSE ;
+
+}
+
+
static
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
- SV *sv, *rv;
- char *name, *type;
- HV *stash;
+ SV *sv;
+ char *name;
if (items != 2)
croak("Usage: UNIVERSAL::isa(reference, kind)");
- stash = Nullhv;
- type = Nullch;
sv = ST(0);
name = (char *)SvPV(ST(1),na);
- if (SvROK(sv)) {
- sv = SvRV(sv);
- type = sv_reftype(sv,0);
- if(SvOBJECT(sv))
- stash = SvSTASH(sv);
- }
- else {
- stash = gv_stashsv(sv, FALSE);
- }
-
- ST(0) = (type && strEQ(type,name)) ||
- (stash && isa_lookup(stash, name, strlen(name), 0) == &sv_yes)
- ? &sv_yes
- : &sv_no;
+ ST(0) = (sv_derived_from(sv, name) ? &sv_yes : &sv_no) ;
XSRETURN(1);
}
SV *rv;
GV *gv;
CV *cvp;
+ HV *pkg = NULL;
if (items != 2)
croak("Usage: UNIVERSAL::can(object-ref, method)");
name = (char *)SvPV(ST(1),na);
rv = &sv_undef;
- if(SvROK(sv) && (sv = (SV*)SvRV(sv)) && SvOBJECT(sv)) {
- gv = gv_fetchmethod(SvSTASH(sv), name);
+ if(SvROK(sv)) {
+ sv = (SV*)SvRV(sv);
+ if(SvOBJECT(sv))
+ pkg = SvSTASH(sv);
+ }
+ else {
+ pkg = gv_stashsv(sv, FALSE);
+ }
+
+ if (pkg) {
+ gv = gv_fetchmethod(pkg, name);
if(gv && GvCV(gv)) {
/* If the sub is only a stub then we may have a gv to AUTOLOAD */
XS(XS_UNIVERSAL_class)
{
dXSARGS;
- if(SvROK(ST(0))) {
+ if(SvROK(ST(0)) && SvOBJECT(SvRV(ST(0)))) {
SV *sv = sv_newmortal();
- sv_setpv(sv, HvNAME(SvSTASH(ST(0))));
+ sv_setpv(sv, HvNAME(SvSTASH(SvRV(ST(0)))));
ST(0) = sv;
}
XSRETURN(1);