X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FRole.pm;h=43bcdd9f392b0a964b6e9f57cbe7d162b0427056;hp=c798d6ac7feb2f6ad7e157d29d66fcd60a0e886d;hb=3a63a2e7ef8fbac5f61eab04baecbf5d19374b83;hpb=e0396a57ff4663622ba6862a3039d05c2514fe4b diff --git a/lib/Mouse/Role.pm b/lib/Mouse/Role.pm index c798d6a..43bcdd9 100644 --- a/lib/Mouse/Role.pm +++ b/lib/Mouse/Role.pm @@ -7,8 +7,12 @@ use Carp 'confess', 'croak'; use Scalar::Util 'blessed'; use Mouse::Meta::Role; +use Mouse::Util; our @EXPORT = qw(before after around super override inner augment has extends with requires excludes confess blessed); +our %is_removable = map{ $_ => undef } @EXPORT; +delete $is_removable{confess}; +delete $is_removable{blessed}; sub before { my $meta = Mouse::Meta::Role->initialize(caller); @@ -116,11 +120,13 @@ sub import { return; } - my $meta = Mouse::Meta::Role->initialize(caller); + my $meta_method = sub{ + Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]); + }; - no strict 'refs'; - no warnings 'redefine'; - *{$caller.'::meta'} = sub { $meta }; + Mouse::Meta::Role->initialize($caller)->add_method(meta => sub { + return Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]); + }); Mouse::Role->export_to_level(1, @_); } @@ -128,10 +134,21 @@ 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}; + } } + return; } 1;