X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=b03caa5d17e30ef4f45ff2e8e97ed1d2c5b72e27;hb=a917d5ae83dc260c6a84fed0ffdc0d1b70c50266;hp=351e394b8da9d0b3c02509468b004332a1518fd2;hpb=f4b86ac0e1fd7ff8a180f2f8332821170db5371e;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 351e394..b03caa5 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,11 +11,8 @@ use Scalar::Util 'blessed'; use List::Util qw(first); use List::MoreUtils qw(any all); use overload (); -use Class::MOP 0.60; - -our $VERSION = '1.16'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; +use Try::Tiny; +use Class::MOP; my @exports = qw[ find_meta @@ -47,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; @@ -100,7 +102,18 @@ sub _apply_all_roles { Moose->throw_error("Must specify at least one role to apply to $applicant"); } - my $roles = Data::OptList::mkopt( [@_] ); + # If @_ contains role meta objects, mkopt will think that they're values, + # because they're references. In other words (roleobj1, roleobj2, + # roleobj3) will become [ [ roleobj1, roleobj2 ], [ roleobj3, undef ] ] + # -- this is no good. We'll preprocess @_ first to eliminate the potential + # bug. + # -- rjbs, 2011-04-08 + my $roles = Data::OptList::mkopt( [@_], { + moniker => 'role', + name_test => sub { + ! ref $_[0] or blessed($_[0]) && $_[0]->isa('Moose::Meta::Role') + } + }); my @role_metas; foreach my $role (@$roles) { @@ -110,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') ) { @@ -130,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] }; @@ -199,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 ); @@ -262,7 +279,7 @@ sub _caller_info { my $level = @_ ? ($_[0] + 1) : 2; my %info; @info{qw(package file line)} = caller($level); - return \%info; + return %info; } sub _create_alias { @@ -291,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 { @@ -309,7 +328,7 @@ sub _reconcile_roles_for_metaclass { # handle the case where we need to fix compatibility between a class and # its parent, but all roles in the class are already also done by the # parent - # see t/050/054.t + # see t/metaclasses/metaclass_compat_no_fixing_bug.t return $super_meta_name unless @role_differences; @@ -453,14 +472,12 @@ sub _is_role_only_subclass { 1; +# ABSTRACT: Utilities for working with Moose classes + __END__ =pod -=head1 NAME - -Moose::Util - Utilities for working with Moose classes - =head1 SYNOPSIS use Moose::Util qw/find_meta does_role search_class_by_role/; @@ -519,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 @@ -587,24 +604,5 @@ Here is a list of possible functions to write See L for details on reporting bugs. -=head1 AUTHOR - -Anders Nor Berle Edebolaz@gmail.comE - -B - -Robert (phaylon) Sedlacek - -Stevan Little - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2009 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =cut