recommends 'MRO::Compat' if $] < 5.010;
-my $use_xs;\r
-\r
-for (@ARGV) {\r
- /^--pp$/ and $use_xs = 0;\r
- /^--xs$/ and $use_xs = 1;\r
-}\r
+my $use_xs;
+
+for (@ARGV) {
+ /^--pp$/ and $use_xs = 0;
+ /^--xs$/ and $use_xs = 1;
+}
if(!defined $use_xs){
configure_requires 'ExtUtils::CBuilder';
--- /dev/null
+package
+ Mouse::Util;
+
+use strict;
+use warnings;
+
+use warnings FATAL => 'redefine'; # to avoid to load Mouse::PurePerl
+
+use B ();
+
+sub is_class_loaded {
+ my $class = shift;
+
+ return 0 if ref($class) || !defined($class) || !length($class);
+
+ # walk the symbol table tree to avoid autovififying
+ # \*{${main::}{"Foo::"}} == \*main::Foo::
+
+ my $pack = \%::;
+ foreach my $part (split('::', $class)) {
+ my $entry = \$pack->{$part . '::'};
+ return 0 if ref($entry) ne 'GLOB';
+ $pack = *{$entry}{HASH} or return 0;
+ }
+
+ # check for $VERSION or @ISA
+ return 1 if exists $pack->{VERSION}
+ && defined *{$pack->{VERSION}}{SCALAR} && defined ${ $pack->{VERSION} };
+ return 1 if exists $pack->{ISA}
+ && defined *{$pack->{ISA}}{ARRAY} && @{ $pack->{ISA} } != 0;
+
+ # check for any method
+ foreach my $name( keys %{$pack} ) {
+ my $entry = \$pack->{$name};
+ return 1 if ref($entry) ne 'GLOB' || defined *{$entry}{CODE};
+ }
+
+ # fail
+ return 0;
+}
+
+
+# taken from Sub::Identify
+sub get_code_info {
+ my ($coderef) = @_;
+ ref($coderef) or return;
+
+ my $cv = B::svref_2object($coderef);
+ $cv->isa('B::CV') or return;
+
+ my $gv = $cv->GV;
+ $gv->isa('B::GV') or return;
+
+ return ($gv->STASH->NAME, $gv->NAME);
+}
+
+sub get_code_package{
+ my($coderef) = @_;
+
+ my $cv = B::svref_2object($coderef);
+ $cv->isa('B::CV') or return '';
+
+ my $gv = $cv->GV;
+ $gv->isa('B::GV') or return '';
+
+ return $gv->STASH->NAME;
+}
+
+
+package
+ Mouse::Meta::Method::Accessor;
+
+1;
+__END__
package Mouse::Util;
use Mouse::Exporter; # enables strict and warnings
+BEGIN{
+ # Because Mouse::Util is loaded first in all the Mouse sub-modules,
+ # XS loader is placed here, not in Mouse.pm.
+
+ our $VERSION = '0.40';
+
+ my $need_pp = !!$ENV{MOUSE_PUREPERL};
+
+ if(!$need_pp && !exists $INC{'Mouse/PurePerl.pm'}){
+ local $@;
+ $need_pp = !eval{
+ require XSLoader;
+ XSLoader::load('Mouse', $VERSION);
+ };
+ warn $@ if $@; # for DEBUGGING
+ }
+
+ if($need_pp){
+ require 'Mouse/PurePerl.pm'; # we don't want to create its namespace
+ }
+}
+
+
use Carp qw(confess);
use Scalar::Util qw(blessed);
-use B ();
use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
*get_linear_isa = $impl;
}
-{ # taken from Sub::Identify
- sub get_code_info($) {
- my ($coderef) = @_;
- ref($coderef) or return;
-
- my $cv = B::svref_2object($coderef);
- $cv->isa('B::CV') or return;
-
- my $gv = $cv->GV;
- $gv->isa('B::GV') or return;
-
- return ($gv->STASH->NAME, $gv->NAME);
- }
-
- sub get_code_package{
- my($coderef) = @_;
-
- my $cv = B::svref_2object($coderef);
- $cv->isa('B::CV') or return '';
-
- my $gv = $cv->GV;
- $gv->isa('B::GV') or return '';
-
- return $gv->STASH->NAME;
- }
-}
# taken from Mouse::Util (0.90)
{
# Utilities from Class::MOP
+sub get_code_info;
+sub get_code_package;
# taken from Class/MOP.pm
sub is_valid_class_name {
return 1;
}
-
-sub is_class_loaded {
- my $class = shift;
-
- return 0 if ref($class) || !defined($class) || !length($class);
-
- # walk the symbol table tree to avoid autovififying
- # \*{${main::}{"Foo::"}} == \*main::Foo::
-
- my $pack = \%::;
- foreach my $part (split('::', $class)) {
- my $entry = \$pack->{$part . '::'};
- return 0 if ref($entry) ne 'GLOB';
- $pack = *{$entry}{HASH} or return 0;
- }
-
- # check for $VERSION or @ISA
- return 1 if exists $pack->{VERSION}
- && defined *{$pack->{VERSION}}{SCALAR} && defined ${ $pack->{VERSION} };
- return 1 if exists $pack->{ISA}
- && defined *{$pack->{ISA}}{ARRAY} && @{ $pack->{ISA} } != 0;
-
- # check for any method
- foreach my $name( keys %{$pack} ) {
- my $entry = \$pack->{$name};
- return 1 if ref($entry) ne 'GLOB' || defined *{$entry}{CODE};
- }
-
- # fail
- return 0;
-}
+sub is_class_loaded;
sub apply_all_roles {
--- /dev/null
+#ifndef MOUSE_H
+#define MOUSE_H
+
+#define PERL_NO_GET_CONTEXT
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include "ppport.h"
+
+#define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv)
+bool mouse_is_class_loaded(pTHX_ SV*);
+
+#define is_instance_of(sv, klass) mouse_is_instance_of(aTHX_ sv, klass)
+bool mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass);
+
+#define IsObject(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)))
+
+#define mcall0(invocant, m) mouse_call0(aTHX_ (invocant), (m))
+#define mcall1(invocant, m, arg1) mouse_call1(aTHX_ (invocant), (m), (arg1))
+#define mcall0s(invocant, m) mcall0((invocant), newSVpvs_flags(m, SVs_TEMP))
+#define mcall1s(invocant, m, arg1) mcall1((invocant), newSVpvs_flags(m, SVs_TEMP), (arg1))
+
+SV* mouse_call0(pTHX_ SV *const self, SV *const method);
+SV* mouse_call1(pTHX_ SV *const self, SV *const method, SV* const arg1);
+
+
+#endif /* !MOUSE_H */
+
--- /dev/null
+#include "mouse.h"
+
+MODULE = Mouse PACKAGE = Mouse::Util
+
+PROTOTYPES: DISABLE
+
+bool
+is_class_loaded(SV* sv = &PL_sv_undef)
+
+void
+get_code_info(CV* code)
+PREINIT:
+ GV* gv;
+ HV* stash;
+PPCODE:
+ if((gv = CvGV(code)) && isGV(gv) && (stash = GvSTASH(gv))){
+ EXTEND(SP, 2);
+ mPUSHs(newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U));
+ mPUSHs(newSVpvn_share(GvNAME_get(gv), GvNAMELEN_get(gv), 0U));
+ }
+
+SV*
+get_code_package(CV* code)
+PREINIT:
+ HV* stash;
+CODE:
+ if(CvGV(code) && isGV(CvGV(code)) && (stash = GvSTASH(CvGV(code)))){
+ RETVAL = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
+ }
+ else{
+ RETVAL = &PL_sv_no;
+ }
+OUTPUT:
+ RETVAL
+
--- /dev/null
+#include "mouse.h"
+
+/* equivalent to "blessed($x) && $x->isa($klass)" */
+bool
+mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){
+ assert(sv);
+ assert(klass);
+
+ if(IsObject(sv) && SvOK(klass)){
+ bool ok;
+
+ ENTER;
+ SAVETMPS;
+
+ ok = SvTRUEx(mcall1s(sv, "isa", klass));
+
+ FREETMPS;
+ LEAVE;
+
+ return ok;
+ }
+
+ return FALSE;
+}
+
+
+bool
+mouse_is_class_loaded(pTHX_ SV * const klass){
+ HV *stash;
+ GV** gvp;
+ HE* he;
+
+ if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
+ return FALSE;
+ }
+
+ stash = gv_stashsv(klass, FALSE);
+ if (!stash) {
+ return FALSE;
+ }
+
+ if (( gvp = (GV**)hv_fetchs(stash, "VERSION", FALSE) )) {
+ if(isGV(*gvp) && GvSV(*gvp) && SvOK(GvSV(*gvp))){
+ return TRUE;
+ }
+ }
+
+ if (( gvp = (GV**)hv_fetchs(stash, "ISA", FALSE) )) {
+ if(isGV(*gvp) && GvAV(*gvp) && av_len(GvAV(*gvp)) != -1){
+ return TRUE;
+ }
+ }
+
+ hv_iterinit(stash);
+ while(( he = hv_iternext(stash) )){
+ GV* const gv = (GV*)HeVAL(he);
+
+ if(isGV(gv)){
+ if(GvCVu(gv)){
+ return TRUE;
+ }
+ }
+ else if(SvOK(gv)){
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
+
+SV *
+mouse_call0 (pTHX_ SV *const self, SV *const method)
+{
+ dSP;
+ SV *ret;
+
+ PUSHMARK(SP);
+ XPUSHs(self);
+ PUTBACK;
+
+ call_sv(method, G_SCALAR | G_METHOD);
+
+ SPAGAIN;
+ ret = POPs;
+ PUTBACK;
+
+ return ret;
+}
+
+SV *
+mouse_call1 (pTHX_ SV *const self, SV *const method, SV* const arg1)
+{
+ dSP;
+ SV *ret;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(self);
+ PUSHs(arg1);
+ PUTBACK;
+
+ call_sv(method, G_SCALAR | G_METHOD);
+
+ SPAGAIN;
+ ret = POPs;
+ PUTBACK;
+
+ return ret;
+}
+
projects / gitmo/Mouse.git / commitdiff