Update .gitignore and add MANIFEST.SKIP

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

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index 2f10181..9f3ecf9 100644 (file)
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -2,14 +2,16 @@ package Mouse::Util;
 use strict;
 use warnings;
 use base qw/Exporter/;
-use Carp;
+use Carp qw(confess);
+use B ();
 
 our @EXPORT_OK = qw(
+    load_class
+    is_class_loaded
     get_linear_isa
     apply_all_roles
-    version 
-    authority
-    identifier
+    get_code_info
+    not_supported
 );
 our %EXPORT_TAGS = (
     all  => \@EXPORT_OK,
@@ -53,22 +55,24 @@ BEGIN {
         }
     }
 
-    no strict 'refs';
-    *{ __PACKAGE__ . '::get_linear_isa'} = $impl;
+
+    no warnings 'once';
+    *get_linear_isa = $impl;
 }
 
-{ # 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 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
+        $gv->isa('B::GV') or return;\r
+\r
+        return ($gv->STASH->NAME, $gv->NAME);\r
+    }\r
 }
 
 # taken from Class/MOP.pm
@@ -100,12 +104,11 @@ BEGIN {
 }
 
 # taken from Class/MOP.pm
-sub _is_valid_class_name {
+sub is_valid_class_name {
     my $class = shift;
 
     return 0 if ref($class);
     return 0 unless defined($class);
-    return 0 unless length($class);
 
     return 1 if $class =~ /^\w+(?:::\w+)*$/;
 
@@ -117,13 +120,6 @@ sub load_first_existing_class {
     my @classes = @_
       or return;
 
-    foreach 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) {
@@ -152,7 +148,12 @@ sub load_first_existing_class {
 sub _try_load_one_class {
     my $class = shift;
 
-    return if Mouse::is_class_loaded($class);
+    unless ( is_valid_class_name($class) ) {
+        my $display = defined($class) ? $class : 'undef';
+        confess "Invalid class name ($display)";
+    }
+
+    return if is_class_loaded($class);
 
     my $file = $class . '.pm';
     $file =~ s{::}{/}g;
@@ -164,6 +165,49 @@ sub _try_load_one_class {
     };
 }
 
+
+sub load_class {
+    my $class = shift;
+    my $e = _try_load_one_class($class);
+    confess "Could not load class ($class) because : $e" if $e;
+
+    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::
+
+    my $pack = \*::;
+    foreach my $part (split('::', $class)) {
+        return 0 unless exists ${$$pack}{"${part}::"};
+        $pack = \*{${$$pack}{"${part}::"}};
+    }
+
+    # check for $VERSION or @ISA
+    return ++$is_class_loaded_cache{$class} if exists ${$$pack}{VERSION}
+             && defined *{${$$pack}{VERSION}}{SCALAR};
+    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 ++$is_class_loaded_cache{$class} if defined *{${$$pack}{$_}}{CODE};
+    }
+
+    # fail
+    return 0;
+}
+
+
 sub apply_all_roles {
     my $meta = Mouse::Meta::Class->initialize(shift);
 
@@ -184,7 +228,7 @@ sub apply_all_roles {
     }
 
     ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
-        || croak("You can only consume roles, "
+        || confess("You can only consume roles, "
         . $_->[0]
         . " is not a Moose role")
         foreach @roles;
@@ -196,7 +240,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;