X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=f69ec571296e186155d815d4ea2424f5bdd96b6e;hb=19320607dd1e6217be5f0f7f68db79465d0fb6d9;hp=d81911218534f69bb5c1d8aa81e06b72e3de9aa8;hpb=ab76842ea6760e3e08b2455b63aa55888b70deec;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index d819112..f69ec57 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -5,10 +5,10 @@ use warnings; use Sub::Exporter; use Scalar::Util 'blessed'; -use Carp 'confess'; -use Class::MOP (); +use Class::MOP 0.60; -our $VERSION = '0.02'; +our $VERSION = '0.68'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; my @exports = qw[ @@ -18,6 +18,10 @@ my @exports = qw[ apply_all_roles get_all_init_args get_all_attribute_values + resolve_metatrait_alias + resolve_metaclass_alias + add_method_modifier + english_list ]; Sub::Exporter::setup_exporter({ @@ -40,7 +44,7 @@ sub does_role { my $meta = find_meta($class_or_obj); return unless defined $meta; - + return unless $meta->can('does_role'); return 1 if $meta->does_role($role); return; } @@ -68,31 +72,30 @@ sub search_class_by_role { sub apply_all_roles { my $applicant = shift; - - confess "Must specify at least one role to apply to $applicant" unless @_; - - my $roles = Data::OptList::mkopt([ @_ ]); - - #use Data::Dumper; - #warn Dumper $roles; - - my $meta = (blessed $applicant ? $applicant : find_meta($applicant)); - - Class::MOP::load_class($_->[0]) for @$roles; - - ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, " . $_->[0] . " is not a Moose role" - foreach @$roles; - if (scalar @$roles == 1) { - my ($role, $params) = @{$roles->[0]}; - $role->meta->apply($meta, (defined $params ? %$params : ())); + Moose->throw_error("Must specify at least one role to apply to $applicant") unless @_; + + my $roles = Data::OptList::mkopt( [@_] ); + + my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) ); + + foreach my $role_spec (@$roles) { + Class::MOP::load_class( $role_spec->[0] ); + } + + ( $_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role') ) + || Moose->throw_error("You can only consume roles, " + . $_->[0] + . " is not a Moose role") + foreach @$roles; + + if ( scalar @$roles == 1 ) { + my ( $role, $params ) = @{ $roles->[0] }; + $role->meta->apply( $meta, ( defined $params ? %$params : () ) ); } else { - Moose::Meta::Role->combine( - @$roles - )->apply($meta); - } + Moose::Meta::Role->combine( @$roles )->apply($meta); + } } # instance deconstruction ... @@ -116,6 +119,70 @@ sub get_all_init_args { }; } +sub resolve_metatrait_alias { + return resolve_metaclass_alias( @_, trait => 1 ); +} + +{ + my %cache; + + sub resolve_metaclass_alias { + my ( $type, $metaclass_name, %options ) = @_; + + my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' ); + return $cache{$cache_key}{$metaclass_name} + if $cache{$cache_key}{$metaclass_name}; + + my $possible_full_name + = 'Moose::Meta::' + . $type + . '::Custom::' + . ( $options{trait} ? "Trait::" : "" ) + . $metaclass_name; + + my $loaded_class = Class::MOP::load_first_existing_class( + $possible_full_name, + $metaclass_name + ); + + return $cache{$cache_key}{$metaclass_name} + = $loaded_class->can('register_implementation') + ? $loaded_class->register_implementation + : $loaded_class; + } +} + +sub add_method_modifier { + my ( $class_or_obj, $modifier_name, $args ) = @_; + my $meta = find_meta($class_or_obj); + my $code = pop @{$args}; + my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier'; + if ( my $method_modifier_type = ref( @{$args}[0] ) ) { + if ( $method_modifier_type eq 'Regexp' ) { + my @all_methods = $meta->get_all_methods; + my @matched_methods + = grep { $_->name =~ @{$args}[0] } @all_methods; + $meta->$add_modifier_method( $_->name, $code ) + for @matched_methods; + } + } + else { + $meta->$add_modifier_method( $_, $code ) for @{$args}; + } +} + +sub english_list { + my @items = sort @_; + + return $items[0] if @items == 1; + return "$items[0] and $items[1]" if @items == 2; + + my $tail = pop @items; + my $list = join ', ', @items; + $list .= ', and ' . $tail; + + return $list; +} 1; @@ -142,11 +209,14 @@ Moose::Util - Utilities for working with Moose classes =head1 DESCRIPTION -This is a set of utility functions to help working with Moose classes. This -is an experimental module, and it's not 100% clear what purpose it will serve. -That said, ideas, suggestions and contributions to this collection are most -welcome. See the L section below for a list of ideas for possible -functions to write. +This is a set of utility functions to help working with Moose classes, and +is used internally by Moose itself. The goal is to provide useful functions +that for both Moose users and Moose extenders (MooseX:: authors). + +This is a relatively new addition to the Moose tool chest, so ideas, +suggestions and contributions to this collection are most welcome. +See the L section below for a list of ideas for possible functions +to write. =head1 EXPORTED FUNCTIONS @@ -171,7 +241,7 @@ Given an C<$applicant> (which can somehow be turned into either a metaclass or a metarole) and a list of C<@roles> this will do the right thing to apply the C<@roles> to the C<$applicant>. This is actually used internally by both L and L, and the -C<@roles> will be pre-processed through L +C<@roles> will be preprocessed through L to allow for the additional arguments to be passed. =item B @@ -184,6 +254,26 @@ Returns a hash reference where the keys are all the attributes' Cs and the values are the instance's fields. Attributes without an C will be skipped. +=item B + +=item B + +Resolve a short name like in e.g. + + has foo => ( + metaclass => "Bar", + ); + +to a full class name. + +=item B + +=item B + +Given a list of scalars, turns them into a proper list in English +("one and two", "one, two, three, and four"). This is used to help us +make nicer error messages. + =back =head1 TODO @@ -216,7 +306,7 @@ Stevan Little =head1 COPYRIGHT AND LICENSE -Copyright 2007-2008 by Infinity Interactive, Inc. +Copyright 2007-2009 by Infinity Interactive, Inc. L