X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=2c3bdafdaf0b4f1802202624c8f2cc38ff29c4d9;hb=31c5194bc6a176cec4de515163d27f174eba5c9b;hp=35c117d1acbf2c6163acfe6ae41cd8e7433ceff9;hpb=ea249879d28f5ce42afb95feeb7dcb6d37fcd241;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index 35c117d..2c3bdaf 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -1,11 +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 @@ -19,10 +23,16 @@ 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 _MOUSE_VERBOSE)], ); # Moose::Util compatible utilities @@ -32,13 +42,14 @@ sub find_meta{ } sub does_role{ - my ($class_or_obj, $role) = @_; + my ($class_or_obj, $role_name) = @_; my $meta = Mouse::Meta::Module::class_of($class_or_obj); - return 0 unless defined $meta; - return 1 if $meta->does_role($role); - return 0; + (defined $role_name) + || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()"); + + return defined($meta) && $meta->does_role($role_name); } @@ -99,6 +110,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) @@ -145,7 +168,6 @@ sub load_first_existing_class { my @classes = @_ or return; - my $found; my %exceptions; for my $class (@classes) { my $e = _try_load_one_class($class); @@ -154,12 +176,11 @@ sub load_first_existing_class { $exceptions{$class} = $e; } else { - $found = $class; - last; + return $class; } } - return $found if $found; + # not found confess join( "\n", map { @@ -245,7 +266,7 @@ sub apply_all_roles { if ($i + 1 < $max && ref($_[$i + 1])) { push @roles, [ $_[$i++] => $_[$i] ]; } else { - push @roles, [ $_[$i] => {} ]; + push @roles, [ $_[$i] => undef ]; } my $role_name = $roles[-1][0]; load_class($role_name); @@ -276,6 +297,9 @@ sub english_list { return join q{, }, @items, "and $tail"; } + +# common utilities + sub not_supported{ my($feature) = @_; @@ -285,6 +309,23 @@ sub not_supported{ Carp::confess("Mouse does not currently support $feature"); } +sub meta{ + return Mouse::Meta::Class->initialize($_[0]); +} + +sub dump { + my($self, $maxdepth) = @_; + + require 'Data/Dumper.pm'; # we don't want to create its namespace + my $dd = Data::Dumper->new([$self]); + $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 2); + $dd->Indent(1); + return $dd->Dump(); +} + +sub does :method; +*does = \&does_role; # alias + 1; __END__ @@ -309,9 +350,17 @@ Mouse::Util - features, with or without their dependencies =head2 Class::MOP -=head3 C +=head3 C<< is_class_loaded(ClassName) -> Bool >> -=head3 C +Returns whether C is actually loaded or not. It uses a heuristic which +involves checking for the existence of C<$VERSION>, C<@ISA>, and any +locally-defined method. + +=head3 C<< load_class(ClassName) >> + +This will load a given C (or die if it's not loadable). +This function can be used in place of tricks like +C or using C. =head2 MRO::Compat @@ -331,5 +380,15 @@ C =back +=head1 SEE ALSO + +L + +L + +L + +L + =cut