X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=e03e12a7d7dac90e27cb944a3386f3e192394123;hb=3370794fc5ea58f40c7e4f7f89c4f4960e28f9d7;hp=264f32cc29176f1099422d2f0a5435d8bda52575;hpb=10389a8bffa67d857a7ec8332d82beb681bcfb18;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 264f32c..e03e12a 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -17,6 +17,10 @@ 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,11 +123,10 @@ sub init_meta { $meta->superclasses($base_class) unless $meta->superclasses; - { - no strict 'refs'; - no warnings 'redefine'; - *{$class.'::meta'} = sub { $meta }; - } + $meta->add_method(meta => sub{ + return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]); + }); + return $meta; } @@ -169,21 +172,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; @@ -194,11 +206,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:: @@ -209,15 +224,15 @@ 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 @@ -225,9 +240,7 @@ sub is_class_loaded { } sub class_of { - return unless defined $_[0]; - my $class = blessed($_[0]) || $_[0]; - return Mouse::Meta::Class::get_metaclass_by_name($class); + return Mouse::Meta::Class::class_of($_[0]); } 1;