X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=d006137fc13b1fb1b67d41874e16735dbdeed234;hb=4f9945f5a128e120049ce8a7a30cf469d1568b9b;hp=7ca9997d04c2b3af492b823ec823d91895044e3e;hpb=15b4faa9f83b2f8d62c4d875672ca801f0c89ed1;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 7ca9997..d006137 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -11,12 +11,17 @@ use Scalar::Util 'blessed'; use Mouse::Util; use Mouse::Meta::Attribute; +use Mouse::Meta::Module; # class_of() use Mouse::Meta::Class; use Mouse::Object; use Mouse::Util::TypeConstraints; our @EXPORT = qw(extends has before after around override super blessed confess with); +our %is_removable = map{ $_ => undef } @EXPORT; +delete $is_removable{blessed}; +delete $is_removable{confess}; + sub extends { Mouse::Meta::Class->initialize(caller)->superclasses(@_) } sub has { @@ -119,13 +124,10 @@ sub init_meta { $meta->superclasses($base_class) unless $meta->superclasses; - { - no strict 'refs'; - no warnings 'redefine'; - *{$class.'::meta'} = sub { - return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]); - }; - } + $meta->add_method(meta => sub{ + return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]); + }); + return $meta; } @@ -171,21 +173,30 @@ sub import { sub unimport { my $caller = caller; - no strict 'refs'; + my $stash = do{ + no strict 'refs'; + \%{$caller . '::'} + }; + for my $keyword (@EXPORT) { - delete ${ $caller . '::' }{$keyword}; + my $code; + if(exists $is_removable{$keyword} + && ($code = $caller->can($keyword)) + && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){ + + delete $stash->{$keyword}; + } } } sub load_class { my $class = shift; - if (ref($class) || !defined($class) || !length($class)) { + if (!Mouse::Util::is_valid_class_name($class)) { my $display = defined($class) ? $class : 'undef'; confess "Invalid class name ($display)"; } - return 1 if $class eq 'Mouse::Object'; return 1 if is_class_loaded($class); (my $file = "$class.pm") =~ s{::}{/}g; @@ -196,11 +207,14 @@ sub load_class { return 1; } +my %is_class_loaded_cache; sub is_class_loaded { my $class = shift; return 0 if ref($class) || !defined($class) || !length($class); + return 1 if exists $is_class_loaded_cache{$class}; + # walk the symbol table tree to avoid autovififying # \*{${main::}{"Foo::"}} == \*main::Foo:: @@ -211,27 +225,21 @@ sub is_class_loaded { } # check for $VERSION or @ISA - return 1 if exists ${$$pack}{VERSION} + return ++$is_class_loaded_cache{$class} if exists ${$$pack}{VERSION} && defined *{${$$pack}{VERSION}}{SCALAR}; - return 1 if exists ${$$pack}{ISA} + return ++$is_class_loaded_cache{$class} if exists ${$$pack}{ISA} && defined *{${$$pack}{ISA}}{ARRAY}; # check for any method foreach ( keys %{$$pack} ) { next if substr($_, -2, 2) eq '::'; - return 1 if defined *{${$$pack}{$_}}{CODE}; + return ++$is_class_loaded_cache{$class} if defined *{${$$pack}{$_}}{CODE}; } # fail return 0; } -sub class_of { - return unless defined $_[0]; - my $class = blessed($_[0]) || $_[0]; - return Mouse::Meta::Class::get_metaclass_by_name($class); -} - 1; __END__