A tiny tweak

[gitmo/Mouse.git] / lib / Mouse / Util.pm

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index ff39422..73e76ba 100644 (file)
--- 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($) {\r
         my ($coderef) = @_;\r
         ref($coderef) or return;\r
+
         my $cv = B::svref_2object($coderef);\r
         $cv->isa('B::CV') or return;
 
         my $gv = $cv->GV;\r
-        # bail out if GV is undefined\r
-        $gv->isa('B::SPECIAL') and return;\r
+        $gv->isa('B::GV') or return;\r
 \r
         return ($gv->STASH->NAME, $gv->NAME);\r
     }\r
 }
 
-{ # 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;