| File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Moose/Util/MetaRole.pm |
| Statements Executed | 19 |
| Statement Execution Time | 652µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 50µs | 59µs | Moose::Util::MetaRole::BEGIN@3 |
| 1 | 1 | 1 | 11µs | 53µs | Moose::Util::MetaRole::BEGIN@12 |
| 1 | 1 | 1 | 9µs | 27µs | Moose::Util::MetaRole::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 30µs | Moose::Util::MetaRole::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 34µs | Moose::Util::MetaRole::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::__ANON__[:103] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::__ANON__[:147] |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::_fixup_old_style_args |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::_make_new_class |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::_make_new_metaclass |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::apply_base_class_roles |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::apply_metaclass_roles |
| 0 | 0 | 0 | 0s | 0s | Moose::Util::MetaRole::apply_metaroles |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Moose::Util::MetaRole; | ||||
| 2 | |||||
| 3 | 3 | 29µs | 2 | 68µs | # spent 59µs (50+9) within Moose::Util::MetaRole::BEGIN@3 which was called
# once (50µs+9µs) by Moose::Exporter::BEGIN@13 at line 3 # spent 59µs making 1 call to Moose::Util::MetaRole::BEGIN@3
# spent 9µs making 1 call to strict::import |
| 4 | 3 | 23µs | 2 | 45µs | # spent 27µs (9+18) within Moose::Util::MetaRole::BEGIN@4 which was called
# once (9µs+18µs) by Moose::Exporter::BEGIN@13 at line 4 # spent 27µs making 1 call to Moose::Util::MetaRole::BEGIN@4
# spent 18µs making 1 call to warnings::import |
| 5 | 3 | 47µs | 2 | 60µs | # spent 34µs (7+27) within Moose::Util::MetaRole::BEGIN@5 which was called
# once (7µs+27µs) by Moose::Exporter::BEGIN@13 at line 5 # spent 34µs making 1 call to Moose::Util::MetaRole::BEGIN@5
# spent 26µs making 1 call to Exporter::import |
| 6 | |||||
| 7 | 1 | 600ns | our $VERSION = '0.98'; | ||
| 8 | 1 | 16µs | $VERSION = eval $VERSION; | ||
| 9 | 1 | 400ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
| 10 | |||||
| 11 | 3 | 25µs | 2 | 52µs | # spent 30µs (7+23) within Moose::Util::MetaRole::BEGIN@11 which was called
# once (7µs+23µs) by Moose::Exporter::BEGIN@13 at line 11 # spent 30µs making 1 call to Moose::Util::MetaRole::BEGIN@11
# spent 23µs making 1 call to Exporter::import |
| 12 | 3 | 507µs | 2 | 95µs | # spent 53µs (11+42) within Moose::Util::MetaRole::BEGIN@12 which was called
# once (11µs+42µs) by Moose::Exporter::BEGIN@13 at line 12 # spent 53µs making 1 call to Moose::Util::MetaRole::BEGIN@12
# spent 42µs making 1 call to Exporter::import |
| 13 | |||||
| 14 | sub apply_metaclass_roles { | ||||
| 15 | goto &apply_metaroles; | ||||
| 16 | } | ||||
| 17 | |||||
| 18 | sub apply_metaroles { | ||||
| 19 | my %args = @_; | ||||
| 20 | |||||
| 21 | _fixup_old_style_args(\%args); | ||||
| 22 | Carp::cluck('applying') if $::D; | ||||
| 23 | my $for | ||||
| 24 | = blessed $args{for} | ||||
| 25 | ? $args{for} | ||||
| 26 | : Class::MOP::class_of( $args{for} ); | ||||
| 27 | |||||
| 28 | if ( $for->isa('Moose::Meta::Role') ) { | ||||
| 29 | return _make_new_metaclass( $for, $args{role_metaroles}, 'role' ); | ||||
| 30 | } | ||||
| 31 | else { | ||||
| 32 | return _make_new_metaclass( $for, $args{class_metaroles}, 'class' ); | ||||
| 33 | } | ||||
| 34 | } | ||||
| 35 | |||||
| 36 | sub _fixup_old_style_args { | ||||
| 37 | my $args = shift; | ||||
| 38 | |||||
| 39 | return if $args->{class_metaroles} || $args->{roles_metaroles}; | ||||
| 40 | |||||
| 41 | $args->{for} = delete $args->{for_class} | ||||
| 42 | if exists $args->{for_class}; | ||||
| 43 | |||||
| 44 | my @old_keys = qw( | ||||
| 45 | attribute_metaclass_roles | ||||
| 46 | method_metaclass_roles | ||||
| 47 | wrapped_method_metaclass_roles | ||||
| 48 | instance_metaclass_roles | ||||
| 49 | constructor_class_roles | ||||
| 50 | destructor_class_roles | ||||
| 51 | error_class_roles | ||||
| 52 | |||||
| 53 | application_to_class_class_roles | ||||
| 54 | application_to_role_class_roles | ||||
| 55 | application_to_instance_class_roles | ||||
| 56 | application_role_summation_class_roles | ||||
| 57 | ); | ||||
| 58 | |||||
| 59 | my $for | ||||
| 60 | = blessed $args->{for} | ||||
| 61 | ? $args->{for} | ||||
| 62 | : Class::MOP::class_of( $args->{for} ); | ||||
| 63 | |||||
| 64 | my $top_key; | ||||
| 65 | if ( $for->isa('Moose::Meta::Class') ) { | ||||
| 66 | $top_key = 'class_metaroles'; | ||||
| 67 | |||||
| 68 | $args->{class_metaroles}{class} = delete $args->{metaclass_roles} | ||||
| 69 | if exists $args->{metaclass_roles}; | ||||
| 70 | } | ||||
| 71 | else { | ||||
| 72 | $top_key = 'role_metaroles'; | ||||
| 73 | |||||
| 74 | $args->{role_metaroles}{role} = delete $args->{metaclass_roles} | ||||
| 75 | if exists $args->{metaclass_roles}; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | for my $old_key (@old_keys) { | ||||
| 79 | my ($new_key) = $old_key =~ /^(.+)_(?:class|metaclass)_roles$/; | ||||
| 80 | |||||
| 81 | $args->{$top_key}{$new_key} = delete $args->{$old_key} | ||||
| 82 | if exists $args->{$old_key}; | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | return; | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | sub _make_new_metaclass { | ||||
| 89 | my $for = shift; | ||||
| 90 | my $roles = shift; | ||||
| 91 | my $primary = shift; | ||||
| 92 | |||||
| 93 | return $for unless keys %{$roles}; | ||||
| 94 | |||||
| 95 | my $new_metaclass | ||||
| 96 | = exists $roles->{$primary} | ||||
| 97 | ? _make_new_class( ref $for, $roles->{$primary} ) | ||||
| 98 | : blessed $for; | ||||
| 99 | |||||
| 100 | my %classes; | ||||
| 101 | |||||
| 102 | for my $key ( grep { $_ ne $primary } keys %{$roles} ) { | ||||
| 103 | my $attr = first {$_} | ||||
| 104 | map { $for->meta->find_attribute_by_name($_) } ( | ||||
| 105 | $key . '_metaclass', | ||||
| 106 | $key . '_class' | ||||
| 107 | ); | ||||
| 108 | |||||
| 109 | my $reader = $attr->get_read_method; | ||||
| 110 | |||||
| 111 | $classes{ $attr->init_arg } | ||||
| 112 | = _make_new_class( $for->$reader(), $roles->{$key} ); | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | my $new_meta = $new_metaclass->reinitialize( $for, %classes ); | ||||
| 116 | |||||
| 117 | return $new_meta; | ||||
| 118 | } | ||||
| 119 | |||||
| 120 | sub apply_base_class_roles { | ||||
| 121 | my %args = @_; | ||||
| 122 | |||||
| 123 | my $for = $args{for} || $args{for_class}; | ||||
| 124 | |||||
| 125 | my $meta = Class::MOP::class_of($for); | ||||
| 126 | |||||
| 127 | my $new_base = _make_new_class( | ||||
| 128 | $for, | ||||
| 129 | $args{roles}, | ||||
| 130 | [ $meta->superclasses() ], | ||||
| 131 | ); | ||||
| 132 | |||||
| 133 | $meta->superclasses($new_base) | ||||
| 134 | if $new_base ne $meta->name(); | ||||
| 135 | } | ||||
| 136 | |||||
| 137 | sub _make_new_class { | ||||
| 138 | my $existing_class = shift; | ||||
| 139 | my $roles = shift; | ||||
| 140 | my $superclasses = shift || [$existing_class]; | ||||
| 141 | |||||
| 142 | return $existing_class unless $roles; | ||||
| 143 | |||||
| 144 | my $meta = Class::MOP::Class->initialize($existing_class); | ||||
| 145 | |||||
| 146 | return $existing_class | ||||
| 147 | if $meta->can('does_role') && all { $meta->does_role($_) } | ||||
| 148 | grep { !ref $_ } @{$roles}; | ||||
| 149 | |||||
| 150 | return Moose::Meta::Class->create_anon_class( | ||||
| 151 | superclasses => $superclasses, | ||||
| 152 | roles => $roles, | ||||
| 153 | cache => 1, | ||||
| 154 | )->name(); | ||||
| 155 | } | ||||
| 156 | |||||
| 157 | 1 | 4µs | 1; | ||
| 158 | |||||
| 159 | __END__ | ||||
| 160 | |||||
| 161 | =head1 NAME | ||||
| 162 | |||||
| 163 | Moose::Util::MetaRole - Apply roles to any metaclass, as well as the object base class | ||||
| 164 | |||||
| 165 | =head1 SYNOPSIS | ||||
| 166 | |||||
| 167 | package MyApp::Moose; | ||||
| 168 | |||||
| 169 | use Moose (); | ||||
| 170 | use Moose::Exporter; | ||||
| 171 | use Moose::Util::MetaRole; | ||||
| 172 | |||||
| 173 | use MyApp::Role::Meta::Class; | ||||
| 174 | use MyApp::Role::Meta::Method::Constructor; | ||||
| 175 | use MyApp::Role::Object; | ||||
| 176 | |||||
| 177 | Moose::Exporter->setup_import_methods( also => 'Moose' ); | ||||
| 178 | |||||
| 179 | sub init_meta { | ||||
| 180 | shift; | ||||
| 181 | my %args = @_; | ||||
| 182 | |||||
| 183 | Moose->init_meta(%args); | ||||
| 184 | |||||
| 185 | Moose::Util::MetaRole::apply_metaroles( | ||||
| 186 | for => $args{for_class}, | ||||
| 187 | class_metaroles => { | ||||
| 188 | class => => ['MyApp::Role::Meta::Class'], | ||||
| 189 | constructor => ['MyApp::Role::Meta::Method::Constructor'], | ||||
| 190 | }, | ||||
| 191 | ); | ||||
| 192 | |||||
| 193 | Moose::Util::MetaRole::apply_base_class_roles( | ||||
| 194 | for => $args{for_class}, | ||||
| 195 | roles => ['MyApp::Role::Object'], | ||||
| 196 | ); | ||||
| 197 | |||||
| 198 | return $args{for_class}->meta(); | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | =head1 DESCRIPTION | ||||
| 202 | |||||
| 203 | This utility module is designed to help authors of Moose extensions | ||||
| 204 | write extensions that are able to cooperate with other Moose | ||||
| 205 | extensions. To do this, you must write your extensions as roles, which | ||||
| 206 | can then be dynamically applied to the caller's metaclasses. | ||||
| 207 | |||||
| 208 | This module makes sure to preserve any existing superclasses and roles | ||||
| 209 | already set for the meta objects, which means that any number of | ||||
| 210 | extensions can apply roles in any order. | ||||
| 211 | |||||
| 212 | =head1 USAGE | ||||
| 213 | |||||
| 214 | B<It is very important that you only call this module's functions when | ||||
| 215 | your module is imported by the caller>. The process of applying roles | ||||
| 216 | to the metaclass reinitializes the metaclass object, which wipes out | ||||
| 217 | any existing attributes already defined. However, as long as you do | ||||
| 218 | this when your module is imported, the caller should not have any | ||||
| 219 | attributes defined yet. | ||||
| 220 | |||||
| 221 | The easiest way to ensure that this happens is to use | ||||
| 222 | L<Moose::Exporter>, which can generate the appropriate C<init_meta> | ||||
| 223 | method for you, and make sure it is called when imported. | ||||
| 224 | |||||
| 225 | =head1 FUNCTIONS | ||||
| 226 | |||||
| 227 | This module provides two functions. | ||||
| 228 | |||||
| 229 | =head2 apply_metaroles( ... ) | ||||
| 230 | |||||
| 231 | This function will apply roles to one or more metaclasses for the specified | ||||
| 232 | class. It will return a new metaclass object for the class or role passed in | ||||
| 233 | the "for" parameter. | ||||
| 234 | |||||
| 235 | It accepts the following parameters: | ||||
| 236 | |||||
| 237 | =over 4 | ||||
| 238 | |||||
| 239 | =item * for => $name | ||||
| 240 | |||||
| 241 | This specifies the class or for which to alter the meta classes. This can be a | ||||
| 242 | package name, or an appropriate meta-object (a L<Moose::Meta::Class> or | ||||
| 243 | L<Moose::Meta::Role>). | ||||
| 244 | |||||
| 245 | =item * class_metaroles => \%roles | ||||
| 246 | |||||
| 247 | This is a hash reference specifying which metaroles will be applied to the | ||||
| 248 | class metaclass and its contained metaclasses and helper classes. | ||||
| 249 | |||||
| 250 | Each key should in turn point to an array reference of role names. | ||||
| 251 | |||||
| 252 | It accepts the following keys: | ||||
| 253 | |||||
| 254 | =over 8 | ||||
| 255 | |||||
| 256 | =item class | ||||
| 257 | |||||
| 258 | =item attribute | ||||
| 259 | |||||
| 260 | =item method | ||||
| 261 | |||||
| 262 | =item wrapped_method | ||||
| 263 | |||||
| 264 | =item instance | ||||
| 265 | |||||
| 266 | =item constructor | ||||
| 267 | |||||
| 268 | =item destructor | ||||
| 269 | |||||
| 270 | =item error | ||||
| 271 | |||||
| 272 | =back | ||||
| 273 | |||||
| 274 | =item * role_metaroles => \%roles | ||||
| 275 | |||||
| 276 | This is a hash reference specifying which metaroles will be applied to the | ||||
| 277 | role metaclass and its contained metaclasses and helper classes. | ||||
| 278 | |||||
| 279 | It accepts the following keys: | ||||
| 280 | |||||
| 281 | =over 8 | ||||
| 282 | |||||
| 283 | =item role | ||||
| 284 | |||||
| 285 | =item attribute | ||||
| 286 | |||||
| 287 | =item method | ||||
| 288 | |||||
| 289 | =item required_method | ||||
| 290 | |||||
| 291 | =item conflicting_method | ||||
| 292 | |||||
| 293 | =item application_to_class | ||||
| 294 | |||||
| 295 | =item application_to_role | ||||
| 296 | |||||
| 297 | =item application_to_instance | ||||
| 298 | |||||
| 299 | =item application_role_summation | ||||
| 300 | |||||
| 301 | =back | ||||
| 302 | |||||
| 303 | =back | ||||
| 304 | |||||
| 305 | =head2 apply_base_class_roles( for => $class, roles => \@roles ) | ||||
| 306 | |||||
| 307 | This function will apply the specified roles to the object's base class. | ||||
| 308 | |||||
| 309 | =head1 BUGS | ||||
| 310 | |||||
| 311 | See L<Moose/BUGS> for details on reporting bugs. | ||||
| 312 | |||||
| 313 | =head1 AUTHOR | ||||
| 314 | |||||
| 315 | Dave Rolsky E<lt>autarch@urth.orgE<gt> | ||||
| 316 | |||||
| 317 | =head1 COPYRIGHT AND LICENSE | ||||
| 318 | |||||
| 319 | Copyright 2009 by Infinity Interactive, Inc. | ||||
| 320 | |||||
| 321 | L<http://www.iinteractive.com> | ||||
| 322 | |||||
| 323 | This library is free software; you can redistribute it and/or modify | ||||
| 324 | it under the same terms as Perl itself. | ||||
| 325 | |||||
| 326 | =cut |