local-lib5/lib/perl5/MooseX/MethodAttributes/Role/Meta/Role.pm

   1 package MooseX::MethodAttributes::Role::Meta::Role;
   2 our $VERSION = '0.18';
   3
   4 # ABSTRACT: metarole role for storing code attributes
   5
   6 use Moose::Util::MetaRole;
   7 use Moose::Util qw/find_meta does_role ensure_all_roles/;
   8 use Carp qw/croak/;
   9
  10 use Moose::Role;
  11
  12 use MooseX::MethodAttributes ();
  13 use MooseX::MethodAttributes::Role ();
  14
  15 use namespace::clean -except => 'meta';
  16
  17
  18 with qw/
  19     MooseX::MethodAttributes::Role::Meta::Map
  20     MooseX::MethodAttributes::Role::Meta::Role::Application
  21 /;
  22
  23 has '+composition_class_roles' => (
  24     default => [ 'MooseX::MethodAttributes::Role::Meta::Role::Application::Summation' ],
  25 );
  26
  27
  28 after 'initialize' => sub {
  29     my ($self, $class, %args) = @_;
  30     ensure_all_roles($class, 'MooseX::MethodAttributes::Role::AttrContainer');
  31 };
  32
  33
  34 # FIXME - Skip this logic if the method metaclass already does the right role?
  35 around method_metaclass => sub {
  36     my $orig = shift;
  37     my $self = shift;
  38     return $self->$orig(@_) if scalar @_;
  39     Moose::Meta::Class->create_anon_class(
  40         superclasses => [ $self->$orig ],
  41         roles        => [qw/
  42             MooseX::MethodAttributes::Role::Meta::Method
  43         /],
  44         cache        => 1,
  45     )->name();
  46 };
  47
  48
  49 sub _copy_attributes {
  50     my ($self, $thing) = @_;
  51
  52     push @{ $thing->_method_attribute_list }, @{ $self->_method_attribute_list };
  53     @{ $thing->_method_attribute_map }{ (keys(%{ $self->_method_attribute_map }), keys(%{ $thing->_method_attribute_map })) }
  54         = (values(%{ $self->_method_attribute_map }), values(%{ $thing->_method_attribute_map }));
  55 };
  56
  57 # This allows you to say use Moose::Role -traits => 'MethodAttributes'
  58 # This is replaced by MooseX::MethodAttributes::Role, and this trait registration
  59 # is now only present for backwards compatibility reasons.
  60 package # Hide from PAUSE
  61     Moose::Meta::Role::Custom::Trait::MethodAttributes;
  62
  63 sub register_implementation { 'MooseX::MethodAttributes::Role::Meta::Role' }
  64
  65 1;
  66
  67
  68 __END__
  69
  70 =pod
  71
  72 =head1 NAME
  73
  74 MooseX::MethodAttributes::Role::Meta::Role - metarole role for storing code attributes
  75
  76 =head1 VERSION
  77
  78 version 0.18
  79
  80 =head1 SYNOPSIS
  81
  82     package MyRole;
  83     use MooseX::MethodAttributes::Role;
  84
  85     sub foo : Bar Baz('corge') { ... }
  86
  87     package MyClass
  88     use Moose;
  89
  90     with 'MyRole';
  91
  92     my $attrs = MyClass->meta->get_method('foo')->attributes; # ["Bar", "Baz('corge')"]
  93
  94 =head1 DESCRIPTION
  95
  96 This module is a metaclass role which is applied by L<MooseX::MethodAttributes::Role>, allowing
  97 you to add code attributes to methods in Moose roles.
  98
  99 These attributes can then be found by introspecting the role metaclass, and are automatically copied
 100 into any classes or roles that the role is composed onto.
 101
 102 =head1 CAVEATS
 103
 104 =over
 105
 106 =item *
 107
 108 Currently roles with attributes cannot have methods excluded
 109 or aliased, and will in turn confer this property onto any roles they
 110 are composed onto.
 111
 112 =back
 113
 114
 115
 116 =head1 METHODS
 117
 118 =head2 initialize
 119
 120 Ensures that the package containing the role methods does the
 121 L<MooseX::MethodAttributes::Role::AttrContainer> role during initialisation,
 122 which in turn is responsible for capturing the method attributes on the class
 123 and registering them with the metaclass.
 124
 125
 126
 127 =head2 method_metaclass
 128
 129 Wraps the normal method and ensures that the method metaclass performs the
 130 L<MooseX::MethodAttributes::Role::Meta::Method> role, which allows you to
 131 introspect the attributes from the method objects returned by the MOP when
 132 querying the metaclass.
 133
 134
 135
 136 =head1 AUTHORS
 137
 138   Florian Ragwitz <rafl@debian.org>
 139   Tomas Doran <bobtfish@bobtfish.net>
 140
 141 =head1 COPYRIGHT AND LICENSE
 142
 143 This software is copyright (c) 2009 by Florian Ragwitz.
 144
 145 This is free software; you can redistribute it and/or modify it under
 146 the same terms as perl itself.
 147
 148 =cut
 149
 150