X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=8b4c34f0a1662b42d7b07a83bf2086b958151314;hb=a9f50e21a1107a444935e5d8c3a38e466d8d2968;hp=8604d2a5db086537b8a2c37ec0345866f947f8d9;hpb=bb09ad9144e7ee7b2cad8a90725267f591346406;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 8604d2a..8b4c34f 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.17'; -$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 ); @@ -309,7 +326,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 +470,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 +534,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 +602,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