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;
+ SV *sv;
char *name;
if (items != 2)
sv = ST(0);
name = (char *)SvPV(ST(1),na);
- if (!SvROK(sv)) {
- rv = &sv_no;
- }
- else if((sv = (SV*)SvRV(sv)) && SvOBJECT(sv) &&
- &sv_yes == isa_lookup(SvSTASH(sv), name, strlen(name), 0)) {
- rv = &sv_yes;
- }
- else {
- char *s;
-
- switch (SvTYPE(sv)) {
- case SVt_NULL:
- case SVt_IV:
- case SVt_NV:
- case SVt_RV:
- case SVt_PV:
- case SVt_PVIV:
- case SVt_PVNV:
- case SVt_PVBM:
- case SVt_PVMG: s = "SCALAR"; break;
- case SVt_PVLV: s = "LVALUE"; break;
- case SVt_PVAV: s = "ARRAY"; break;
- case SVt_PVHV: s = "HASH"; break;
- case SVt_PVCV: s = "CODE"; break;
- case SVt_PVGV: s = "GLOB"; break;
- case SVt_PVFM: s = "FORMATLINE"; break;
- case SVt_PVIO: s = "FILEHANDLE"; break;
- default: s = "UNKNOWN"; break;
- }
- rv = strEQ(s,name) ? &sv_yes : &sv_no;
- }
+ ST(0) = (sv_derived_from(sv, name) ? &sv_yes : &sv_no) ;
- ST(0) = rv;
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);
GV *gv;
SV *sv;
char *undef;
+ double req;
if(SvROK(ST(0))) {
sv = (SV*)SvRV(ST(0));
undef = "(undef)";
}
- if(items > 1 && (undef || SvNV(ST(1)) > SvNV(sv)))
+ if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv))))
croak("%s version %s required--this is only version %s",
- HvNAME(pkg),SvPV(ST(1),na),undef ? undef : SvPV(sv,na));
+ HvNAME(pkg), SvPV(ST(1),na), undef ? undef : SvPV(sv,na));
ST(0) = sv;