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
  82 __END__
  83
  84 =head1 NAME
  85
  86 Mouse::Util::MetaRole - Apply roles to any metaclass, as well as the object base class
  87
  88 =head1 SYNOPSIS
  89
  90   package MyApp::Mouse;
  91
  92   use Mouse ();
  93   use Mouse::Exporter;
  94   use Mouse::Util::MetaRole;
  95
  96   use MyApp::Role::Meta::Class;
  97   use MyApp::Role::Meta::Method::Constructor;
  98   use MyApp::Role::Object;
  99
 100   Mouse::Exporter->setup_import_methods( also => 'Mouse' );
 101
 102   sub init_meta {
 103       shift;
 104       my %options = @_;
 105
 106       Mouse->init_meta(%options);
 107
 108       Mouse::Util::MetaRole::apply_metaclass_roles(
 109           for_class               => $options{for_class},
 110           metaclass_roles         => ['MyApp::Role::Meta::Class'],
 111           constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'],
 112       );
 113
 114       Mouse::Util::MetaRole::apply_base_class_roles(
 115           for_class => $options{for_class},
 116           roles     => ['MyApp::Role::Object'],
 117       );
 118
 119       return $options{for_class}->meta();
 120   }
 121
 122 =head1 DESCRIPTION
 123
 124 This utility module is designed to help authors of Mouse extensions
 125 write extensions that are able to cooperate with other Mouse
 126 extensions. To do this, you must write your extensions as roles, which
 127 can then be dynamically applied to the caller's metaclasses.
 128
 129 This module makes sure to preserve any existing superclasses and roles
 130 already set for the meta objects, which means that any number of
 131 extensions can apply roles in any order.
 132
 133 =head1 USAGE
 134
 135 B<It is very important that you only call this module's functions when
 136 your module is imported by the caller>. The process of applying roles
 137 to the metaclass reinitializes the metaclass object, which wipes out
 138 any existing attributes already defined. However, as long as you do
 139 this when your module is imported, the caller should not have any
 140 attributes defined yet.
 141
 142 The easiest way to ensure that this happens is to use
 143 L<Mouse::Exporter>, which can generate the appropriate C<init_meta>
 144 method for you, and make sure it is called when imported.
 145
 146 =head1 FUNCTIONS
 147
 148 This module provides two functions.
 149
 150 =head2 apply_metaclass_roles( ... )
 151
 152 This function will apply roles to one or more metaclasses for the
 153 specified class. It accepts the following parameters:
 154
 155 =over 4
 156
 157 =item * for_class => $name
 158
 159 This specifies the class for which to alter the meta classes.
 160
 161 =item * metaclass_roles => \@roles
 162
 163 =item * attribute_metaclass_roles => \@roles
 164
 165 =item * method_metaclass_roles => \@roles
 166
 167 =item * constructor_class_roles => \@roles
 168
 169 =item * destructor_class_roles => \@roles
 170
 171 These parameter all specify one or more roles to be applied to the
 172 specified metaclass. You can pass any or all of these parameters at
 173 once.
 174
 175 =back
 176
 177 =head2 apply_base_class_roles( for_class => $class, roles => \@roles )
 178
 179 This function will apply the specified roles to the object's base class.
 180
 181 =head1 SEE ALSO
 182
 183 L<Moose::Util::MetaRole>
 184
 185 =cut