X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=123d5fff41c4d519370df6f478d263ed348003ac;hp=fa0642390cb72024f55e055f7c6f10afc6ce6b30;hb=d16f42f3dda545377565fe301d7d98f4e2ee632b;hpb=7ca5c5fb6e084d9c57bc022b336458afc74c6847

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index fa06423..123d5ff 100644
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -1,10 +1,15 @@
 package Mouse::Util;
 use strict;
 use warnings;
-use base qw/Exporter/;
+
+use Exporter;
 
 use Carp qw(confess);
+use B ();
+
+use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
 
+our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(
     find_meta
     does_role
@@ -18,25 +23,37 @@ our @EXPORT_OK = qw(
     get_linear_isa
     get_code_info
 
+    get_code_package
+
     not_supported
 
     does meta dump
+    _MOUSE_VERBOSE
 );
 our %EXPORT_TAGS = (
     all  => \@EXPORT_OK,
-    meta => [qw(does meta dump)],
+    meta => [qw(does meta dump _MOUSE_VERBOSE)],
 );
 
+# aliases as public APIs
+
+BEGIN{
+    *class_of                    = \&Mouse::Meta::Module::class_of;
+    *get_metaclass_by_name       = \&Mouse::Meta::Module::get_metaclass_by_name;
+    *get_all_metaclass_instances = \&Mouse::Meta::Module::get_all_metaclass_instances;
+    *get_all_metaclass_names     = \&Mouse::Meta::Module::get_all_metaclass_names;
+}
+
 # Moose::Util compatible utilities
 
 sub find_meta{
-    return Mouse::Meta::Module::class_of( $_[0] );
+    return class_of( $_[0] );
 }
 
 sub does_role{
     my ($class_or_obj, $role_name) = @_;
 
-    my $meta = Mouse::Meta::Module::class_of($class_or_obj);
+    my $meta = class_of($class_or_obj);
 
     (defined $role_name)
         || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
@@ -44,8 +61,6 @@ sub does_role{
     return defined($meta) && $meta->does_role($role_name);
 }
 
-
-
 BEGIN {
     my $impl;
     if ($] >= 5.009_005) {
@@ -94,8 +109,6 @@ BEGIN {
         my ($coderef) = @_;
         ref($coderef) or return;
 
-        require B;
-
         my $cv = B::svref_2object($coderef);
         $cv->isa('B::CV') or return;
 
@@ -104,6 +117,18 @@ BEGIN {
 
         return ($gv->STASH->NAME, $gv->NAME);
     }
+
+    sub get_code_package{
+        my($coderef) = @_;
+
+        my $cv = B::svref_2object($coderef);
+        $cv->isa('B::CV') or return '';
+
+        my $gv = $cv->GV;
+        $gv->isa('B::GV') or return '';
+
+        return $gv->STASH->NAME;
+    }
 }
 
 # taken from Mouse::Util (0.90)
@@ -133,6 +158,9 @@ BEGIN {
     }
 }
 
+# Utilities from Class::MOP
+
+
 # taken from Class/MOP.pm
 sub is_valid_class_name {
     my $class = shift;
@@ -314,7 +342,7 @@ __END__
 
 =head1 NAME
 
-Mouse::Util - features, with or without their dependencies
+Mouse::Util - Features, with or without their dependencies
 
 =head1 IMPLEMENTATIONS FOR
 
@@ -332,7 +360,7 @@ Mouse::Util - features, with or without their dependencies
 
 =head2 Class::MOP
 
-=head2 C<< is_class_loaded(ClassName) -> Bool >>
+=head3 C<< is_class_loaded(ClassName) -> Bool >>
 
 Returns whether C<ClassName> is actually loaded or not. It uses a heuristic which
 involves checking for the existence of C<$VERSION>, C<@ISA>, and any
@@ -340,10 +368,18 @@ locally-defined method.
 
 =head3 C<< load_class(ClassName) >>
 
-This will load a given C<ClassName> (or die if it's not loadable).
+This will load a given C<ClassName> (or die if it is not loadable).
 This function can be used in place of tricks like
 C<eval "use $module"> or using C<require>.
 
+=head2 C<< Mouse::Util::class_of(ClassName) >>
+
+The counterpart of C<Class::MOP::class_of()>. This is not exportable.
+
+=head2 C<< Mouse::Util::get_metaclass_by_name(ClassName) >>
+
+The counterpart of C<Class::MOP::get_metaclass_by_name()>. This is not exportable.
+
 =head2 MRO::Compat
 
 =head3 C<get_linear_isa>
@@ -354,13 +390,7 @@ C<eval "use $module"> or using C<require>.
 
 =head1 UTILITIES FOR MOUSE
 
-=over 4
-
-=item *
-
-C<not_supported>
-
-=back
+=head3 C<not_supported>
 
 =head1 SEE ALSO