X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse.pm;h=4f6e8f9647be01592d3ccf3b3f3be1dfa27a8f4e;hb=6cfa1e5e70616fb102915489c02d8347ffa912fb;hp=03aa91f796b12df955be64eb32e67670828353fe;hpb=93ac97dd92e8c829816790b432a5638ad4585904;p=gitmo%2FMouse.git diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 03aa91f..4f6e8f9 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -4,19 +4,24 @@ use warnings; use 5.006; use base 'Exporter'; -our $VERSION = '0.29'; +our $VERSION = '0.30'; use Carp 'confess'; use Scalar::Util 'blessed'; -use Mouse::Util; +use Mouse::Util qw(load_class is_class_loaded); 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,11 +124,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,65 +173,20 @@ sub import { sub unimport { my $caller = caller; - no strict 'refs'; - for my $keyword (@EXPORT) { - delete ${ $caller . '::' }{$keyword}; - } -} - -sub load_class { - my $class = shift; - - if (ref($class) || !defined($class) || !length($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; - - eval { CORE::require($file) }; - confess "Could not load class ($class) because : $@" if $@; - - 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)) { - return 0 unless exists ${$$pack}{"${part}::"}; - $pack = \*{${$$pack}{"${part}::"}}; - } + my $stash = do{ + no strict 'refs'; + \%{$caller . '::'} + }; - # check for $VERSION or @ISA - return 1 if exists ${$$pack}{VERSION} - && defined *{${$$pack}{VERSION}}{SCALAR}; - return 1 if exists ${$$pack}{ISA} - && defined *{${$$pack}{ISA}}{ARRAY}; + for my $keyword (@EXPORT) { + my $code; + if(exists $is_removable{$keyword} + && ($code = $caller->can($keyword)) + && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){ - # check for any method - foreach ( keys %{$$pack} ) { - next if substr($_, -2, 2) eq '::'; - return 1 if defined *{${$$pack}{$_}}{CODE}; + delete $stash->{$keyword}; + } } - - # 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;