X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=73e76baced88e4b5849e0b1a361ff6cb85d212cc;hb=fce211ae5c3943a1b041b9c0985c4daf189fb8a8;hp=ff39422f74aa334df4cb293b4ef2d9b8a9e673c0;hpb=3a63a2e7ef8fbac5f61eab04baecbf5d19374b83;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index ff39422..73e76ba 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -8,10 +8,8 @@ use B (); our @EXPORT_OK = qw( get_linear_isa apply_all_roles - version - authority - identifier get_code_info + not_supported ); our %EXPORT_TAGS = ( all => \@EXPORT_OK, @@ -55,39 +53,26 @@ BEGIN { } } - no strict 'refs'; - *{ __PACKAGE__ . '::get_linear_isa'} = $impl; + + no warnings 'once'; + *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; - # bail out if GV is undefined - $gv->isa('B::SPECIAL') and return; + $gv->isa('B::GV') or return; return ($gv->STASH->NAME, $gv->NAME); } } -{ # adapted from Class::MOP::Module - - sub version { no strict 'refs'; ${shift->name.'::VERSION'} } - sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} } - sub identifier { - my $self = shift; - join '-' => ( - $self->name, - ($self->version || ()), - ($self->authority || ()), - ); - } -} - # taken from Class/MOP.pm { my %cache; @@ -117,7 +102,7 @@ BEGIN { } # taken from Class/MOP.pm -sub _is_valid_class_name { +sub is_valid_class_name { my $class = shift; return 0 if ref($class); @@ -134,16 +119,14 @@ sub load_first_existing_class { my @classes = @_ or return; - foreach my $class (@classes) { - unless ( _is_valid_class_name($class) ) { + my $found; + my %exceptions; + for my $class (@classes) { + unless ( is_valid_class_name($class) ) { my $display = defined($class) ? $class : 'undef'; confess "Invalid class name ($display)"; } - } - my $found; - my %exceptions; - for my $class (@classes) { my $e = _try_load_one_class($class); if ($e) { @@ -213,7 +196,16 @@ sub apply_all_roles { else { Mouse::Meta::Role->combine_apply($meta, @roles); } + return; +} + +sub not_supported{ + my($feature) = @_; + + $feature ||= ( caller(1) )[3]; # subroutine name + local $Carp::CarpLevel = $Carp::CarpLevel + 2; + Carp::croak("Mouse does not currently support $feature"); } 1;