lib/Mouse/Util/MetaRole.pm

   1 package Mouse::Util::MetaRole;
   2 use Mouse::Util; # enables strict and warnings
   3
   4 my @MetaClassTypes = qw(
   5     metaclass
   6     attribute_metaclass
   7     method_metaclass
   8     constructor_class
   9     destructor_class
  10 );
  11
  12 # In Mouse::Exporter::do_import():
  13 # apply_metaclass_roles(for_class => $class, metaclass_roles => \@traits)
  14 sub apply_metaclass_roles {
  15     my %options = @_;
  16
  17     my $for = Scalar::Util::blessed($options{for_class})
  18         ? $options{for_class}
  19         : Mouse::Util::get_metaclass_by_name($options{for_class});
  20
  21     my $new_metaclass = _make_new_class( ref $for,
  22         $options{metaclass_roles},
  23         $options{metaclass} ? [$options{metaclass}] : undef,
  24     );
  25
  26     my @metaclass_map;
  27
  28     foreach my $mc_type(@MetaClassTypes){
  29         next if !$for->can($mc_type);
  30
  31         if(my $roles = $options{ $mc_type . '_roles' }){
  32             push @metaclass_map,
  33                 ($mc_type => _make_new_class($for->$mc_type(), $roles));
  34         }
  35         elsif(my $mc = $options{$mc_type}){
  36             push @metaclass_map, ($mc_type => $mc);
  37         }
  38     }
  39
  40     return $new_metaclass->reinitialize( $for, @metaclass_map );
  41 }
  42
  43 sub apply_base_class_roles {
  44     my %options = @_;
  45
  46     my $for = $options{for_class};
  47
  48     my $meta = Mouse::Util::class_of($for);
  49
  50     my $new_base = _make_new_class(
  51         $for,
  52         $options{roles},
  53         [ $meta->superclasses() ],
  54     );
  55
  56     $meta->superclasses($new_base)
  57         if $new_base ne $meta->name();
  58     return;
  59 }
  60
  61 sub _make_new_class {
  62     my($existing_class, $roles, $superclasses) = @_;
  63
  64     if(!$superclasses){
  65         return $existing_class if !$roles;
  66
  67         my $meta = Mouse::Meta::Class->initialize($existing_class);
  68
  69         return $existing_class
  70             if !grep { !ref($_) && !$meta->does_role($_) } @{$roles};
  71     }
  72
  73     return Mouse::Meta::Class->create_anon_class(
  74         superclasses => $superclasses ? $superclasses : [$existing_class],
  75         roles        => $roles,
  76         cache        => 1,
  77     )->name();
  78 }
  79
  80 1;
  81 __END__
  82
  83 =head1 NAME
  84
  85 Mouse::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
  86
  87 =head1 SYNOPSIS
  88
  89   package MyApp::Mouse;
  90
  91   use Mouse ();
  92   use Mouse::Exporter;
  93   use Mouse::Util::MetaRole;
  94
  95   use MyApp::Role::Meta::Class;
  96   use MyApp::Role::Meta::Method::Constructor;
  97   use MyApp::Role::Object;
  98
  99   Mouse::Exporter->setup_import_methods( also => 'Mouse' );
 100
 101   sub init_meta {
 102       shift;
 103       my %options = @_;
 104
 105       Mouse->init_meta(%options);
 106
 107       Mouse::Util::MetaRole::apply_metaclass_roles(
 108           for_class               => $options{for_class},
 109           metaclass_roles         => ['MyApp::Role::Meta::Class'],
 110           constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'],
 111       );
 112
 113       Mouse::Util::MetaRole::apply_base_class_roles(
 114           for_class => $options{for_class},
 115           roles     => ['MyApp::Role::Object'],
 116       );
 117
 118       return $options{for_class}->meta();
 119   }
 120
 121 =head1 DESCRIPTION
 122
 123 This utility module is designed to help authors of Mouse extensions
 124 write extensions that are able to cooperate with other Mouse
 125 extensions. To do this, you must write your extensions as roles, which
 126 can then be dynamically applied to the caller's metaclasses.
 127
 128 This module makes sure to preserve any existing superclasses and roles
 129 already set for the meta objects, which means that any number of
 130 extensions can apply roles in any order.
 131
 132 =head1 USAGE
 133
 134 B<It is very important that you only call this module's functions when
 135 your module is imported by the caller>. The process of applying roles
 136 to the metaclass reinitializes the metaclass object, which wipes out
 137 any existing attributes already defined. However, as long as you do
 138 this when your module is imported, the caller should not have any
 139 attributes defined yet.
 140
 141 The easiest way to ensure that this happens is to use
 142 L<Mouse::Exporter>, which can generate the appropriate C<init_meta>
 143 method for you, and make sure it is called when imported.
 144
 145 =head1 FUNCTIONS
 146
 147 This module provides two functions.
 148
 149 =head2 apply_metaclass_roles( ... )
 150
 151 This function will apply roles to one or more metaclasses for the
 152 specified class. It accepts the following parameters:
 153
 154 =over 4
 155
 156 =item * for_class => $name
 157
 158 This specifies the class for which to alter the meta classes.
 159
 160 =item * metaclass_roles => \@roles
 161
 162 =item * attribute_metaclass_roles => \@roles
 163
 164 =item * method_metaclass_roles => \@roles
 165
 166 =item * constructor_class_roles => \@roles
 167
 168 =item * destructor_class_roles => \@roles
 169
 170 These parameter all specify one or more roles to be applied to the
 171 specified metaclass. You can pass any or all of these parameters at
 172 once.
 173
 174 =back
 175
 176 =head2 apply_base_class_roles( for_class => $class, roles => \@roles )
 177
 178 This function will apply the specified roles to the object's base class.
 179
 180 =head1 SEE ALSO
 181
 182 L<Moose::Util::MetaRole>
 183
 184 =cut