X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=91e874559f2cc886f0fabcbb7d17e94f7de3ed01;hb=72d15b838f9f72a7fe7dcc1570c4b445d9252c2b;hp=f4bc473138f4914714b7a0015cd0e13636ac1b4f;hpb=d7d8a8c72f249e02b2d9b213e099f9f2aa4307f6;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index f4bc473..91e8745 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -6,9 +6,10 @@ use warnings; use Sub::Exporter; use Scalar::Util 'blessed'; use Carp 'confess'; -use Class::MOP (); +use Class::MOP 0.56; -our $VERSION = '0.02'; +our $VERSION = '0.55_01'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; my @exports = qw[ @@ -16,6 +17,11 @@ my @exports = qw[ does_role search_class_by_role apply_all_roles + get_all_init_args + get_all_attribute_values + resolve_metatrait_alias + resolve_metaclass_alias + add_method_modifier ]; Sub::Exporter::setup_exporter({ @@ -38,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; } @@ -66,39 +72,93 @@ 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; - if (blessed $applicant && - ($applicant->isa('Class::MOP::Class') || - $applicant->isa('Moose::Meta::Role')) ){ - $meta = $applicant; + + 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') ) + || 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 : () ) ); } else { - $meta = find_meta($applicant); + Moose::Meta::Role->combine( @$roles )->apply($meta); } - - 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; +} + +# instance deconstruction ... - if (scalar @$roles == 1) { - my ($role, $params) = @{$roles->[0]}; - $role->meta->apply($meta, (defined $params ? %$params : ())); +sub get_all_attribute_values { + my ($class, $instance) = @_; + return +{ + map { $_->name => $_->get_value($instance) } + grep { $_->has_value($instance) } + $class->compute_all_applicable_attributes + }; +} + +sub get_all_init_args { + my ($class, $instance) = @_; + return +{ + map { $_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { defined($_->init_arg) } + $class->compute_all_applicable_attributes + }; +} + +sub resolve_metatrait_alias { + resolve_metaclass_alias( @_, trait => 1 ); +} + +sub resolve_metaclass_alias { + my ( $type, $metaclass_name, %options ) = @_; + + if ( my $resolved = eval { + my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name; + + Class::MOP::load_class($possible_full_name); + + $possible_full_name->can('register_implementation') + ? $possible_full_name->register_implementation + : $possible_full_name; + } ) { + return $resolved; + } else { + Class::MOP::load_class($metaclass_name); + return $metaclass_name; + } +} + +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 { - Moose::Meta::Role->combine( - @$roles - )->apply($meta); - } + $meta->$add_modifier_method( $_, $code ) for @{$args}; + } } 1; @@ -126,11 +186,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 toolchest, 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 @@ -154,7 +217,33 @@ Returns first class in precedence list that consumed C<$role_name>. 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. +actually used internally by both L and L, and the +C<@roles> will be pre-processed through L +to allow for the additional arguments to be passed. + +=item B + +Returns the values of the C<$instance>'s fields keyed by the attribute names. + +=item B + +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 =back