Subject: | Class::MOP::is_class_loaded() into MOP.xs |
Hi.
I has written another XS feature, Class::MOP::is_loaded(), which is
about 16-24 times faster (indicated by is_class_loaded.pl, executed on
perl 5.8.9 i686-linux-thread-multi).
Strictly speaking, the XS version is a little different form the pure
perl version. That is, it means, "does the package have something other
than inner packages?", while the pp version means, "does the package
have $VERSION, @ISA or subroutines?". However, it does not matter
because all the tests are OK with the XS version.
Regards,
--
Goro Fuji (GFUJI at CPAN.org)
Subject: | MOP.xs.patch |
*** MOP.xs~ Wed Dec 17 00:09:16 2008
--- MOP.xs Mon Dec 22 16:02:10 2008
***************
*** 339,344 ****
--- 339,384 ----
PUSHs(newSVpv(name, 0));
}
+ bool
+ is_class_loaded(klass = &PL_sv_undef)
+ SV* klass
+ INIT:
+ RETVAL = FALSE;
+ CODE:
+ SvGETMAGIC(klass);
+ if(SvPOKp(klass) && SvCUR(klass) > 0){
+ HV* const stash = gv_stashsv(klass, FALSE);
+ if(stash){
+ char* key;
+ I32 keylen;
+ GV* gv;
+
+ hv_iterinit(stash);
+ while((gv = (GV*)hv_iternextsv(stash, &key, &keylen))){
+ /* skip something special, such as other stashes */
+ if(keylen > 0 && key[keylen-1] == ':'){
+ continue;
+ }
+
+ /* does gv have something? */
+ if(
+ (!isGV(gv)) /* a stub or special constant */
+ || GvSV(gv)
+ || GvAV(gv)
+ || GvHV(gv)
+ || GvCV(gv)
+ || GvIO(gv)
+ || GvFORM(gv)
+ ){
+ RETVAL = TRUE;
+ break;
+ }
+ }
+ }
+ }
+ OUTPUT:
+ RETVAL
+
MODULE = Class::MOP PACKAGE = Class::MOP::Package
Subject: | is_class_loaded.pl |
#!perl -w
use strict;
BEGIN{
$ENV{CLASS_MOP_NO_XS} = 1;
require Class::MOP;
*Class::MOP::is_class_loaded_pp = \&Class::MOP::is_class_loaded;
package Class::MOP;
require XSLoader;
XSLoader::load('Class::MOP');
}
use Benchmark qw(:all);
print qq{For "strict":\n};
cmpthese -1 => {
pp => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded_pp("Class::MOP");
}
},
xs => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded("Class::MOP");
}
},
};
print qq{\nFor "Class::MOP::Method":\n};
cmpthese -1 => {
pp => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded_pp("Class::MOP::Method");
}
},
xs => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded("Class::MOP::Method");
}
},
};
print qq{\nFor "Foo::Bar", which does not exist:\n};
cmpthese -1 => {
pp => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded_pp("Foo::Bar");
}
},
xs => sub{
foreach (1 .. 10){
1 if Class::MOP::is_class_loaded("Foo::Bar");
}
},
};