X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=09803d46a7050e33cc06702ba8383e451745573c;hb=97da20ef3707567e7aef8fa52598b2934a832de9;hp=469e2814fcab8aa37a4752eaa88be72bb11665b6;hpb=c01f48b7c45ab0f906baa9f0fdb0a9ed11b8246f;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 469e281..09803d4 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -3,6 +3,7 @@ package Moose::Util; use strict; use warnings; +use Class::Load 0.07 qw(load_class load_first_existing_class); use Data::OptList; use Params::Util qw( _STRING ); use Sub::Exporter; @@ -10,6 +11,7 @@ use Scalar::Util 'blessed'; use List::Util qw(first); use List::MoreUtils qw(any all); use overload (); +use Try::Tiny; use Class::MOP; my @exports = qw[ @@ -43,6 +45,10 @@ sub find_meta { Class::MOP::class_of(@_) } sub does_role { my ($class_or_obj, $role) = @_; + if (try { $class_or_obj->isa('Moose::Object') }) { + return $class_or_obj->does($role); + } + my $meta = find_meta($class_or_obj); return unless defined $meta; @@ -117,8 +123,8 @@ sub _apply_all_roles { $meta = $role->[0]; } else { - Class::MOP::load_class( $role->[0] , $role->[1] ); - $meta = Class::MOP::class_of( $role->[0] ); + load_class( $role->[0] , $role->[1] ); + $meta = find_meta( $role->[0] ); } unless ($meta && $meta->isa('Moose::Meta::Role') ) { @@ -137,7 +143,11 @@ sub _apply_all_roles { return unless @role_metas; - my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) ); + load_class($applicant) + unless blessed($applicant) + || Class::MOP::class_of($applicant); + + my $meta = ( blessed $applicant ? $applicant : Moose::Meta::Class->initialize($applicant) ); if ( scalar @role_metas == 1 ) { my ( $role, $params ) = @{ $role_metas[0] }; @@ -206,7 +216,7 @@ sub _build_alias_package_name { $type, $metaclass_name, $options{trait} ); - my $loaded_class = Class::MOP::load_first_existing_class( + my $loaded_class = load_first_existing_class( $possible_full_name, $metaclass_name ); @@ -298,12 +308,14 @@ sub meta_class_alias { # XXX - this should be added to Params::Util sub _STRINGLIKE0 ($) { - return _STRING( $_[0] ) - || ( defined $_[0] - && $_[0] eq q{} ) - || ( blessed $_[0] - && overload::Method( $_[0], q{""} ) - && length "$_[0]" ); + return 1 if _STRING( $_[0] ); + if ( blessed $_[0] ) { + return overload::Method( $_[0], q{""} ); + } + + return 1 if defined $_[0] && $_[0] eq q{}; + + return 0; } sub _reconcile_roles_for_metaclass { @@ -524,7 +536,7 @@ each of which can be followed by an optional hash reference of options =item B -This function is similar to L, but only applies roles that +This function is similar to C, but only applies roles that C<$applicant> does not already consume. =item B