File Coverage

blib/lib/Moose/Meta/Class.pm
Criterion Covered Total %
statement 300 322 93.1
branch 108 126 85.7
condition 60 75 80.0
subroutine 59 60 98.3
pod 15 15 100.0
total 542 598 90.6


line stmt bran cond sub pod time code
1             package Moose::Meta::Class;
2             our $VERSION = '2.2205';
3              
4 380     380   431698 use strict;
  380         946  
  380         14085  
5 380     380   3392 use warnings;
  380         2099  
  380         10840  
6              
7 380     380   6723 use Class::MOP;
  380         2997  
  380         10763  
8 380     380   2232 use Data::OptList;
  380         852  
  380         4151  
9 380     380   18598 use List::Util 1.33 qw( any );
  380         7624  
  380         24763  
10 380     380   3079 use Scalar::Util 'blessed';
  380         1101  
  380         20904  
11              
12 380     380   186809 use Moose::Meta::Method::Overridden;
  380         1059  
  380         14576  
13 380     380   181353 use Moose::Meta::Method::Augmented;
  380         2297  
  380         16896  
14 380     380   180366 use Moose::Meta::Class::Immutable::Trait;
  380         2189  
  380         13234  
15 380     380   174838 use Moose::Meta::Method::Constructor;
  380         2257  
  380         18379  
16 380     380   178536 use Moose::Meta::Method::Destructor;
  380         2282  
  380         14469  
17 380     380   170094 use Moose::Meta::Method::Meta;
  380         1103  
  380         14473  
18 380     380   2950 use Moose::Util 'throw_exception';
  380         853  
  380         3782  
19 380     380   91346 use Class::MOP::MiniTrait;
  380         948  
  380         11034  
20              
21 380     380   1935 use parent 'Class::MOP::Class';
  380         839  
  380         1497  
22              
23             Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
24              
25             __PACKAGE__->meta->add_attribute('roles' => (
26             reader => 'roles',
27             default => sub { [] },
28             Class::MOP::_definition_context(),
29             ));
30              
31             __PACKAGE__->meta->add_attribute('role_applications' => (
32             reader => '_get_role_applications',
33             default => sub { [] },
34             Class::MOP::_definition_context(),
35             ));
36              
37             __PACKAGE__->meta->add_attribute(
38             Class::MOP::Attribute->new('immutable_trait' => (
39             accessor => "immutable_trait",
40             default => 'Moose::Meta::Class::Immutable::Trait',
41             Class::MOP::_definition_context(),
42             ))
43             );
44              
45             __PACKAGE__->meta->add_attribute('constructor_class' => (
46             accessor => 'constructor_class',
47             default => 'Moose::Meta::Method::Constructor',
48             Class::MOP::_definition_context(),
49             ));
50              
51             __PACKAGE__->meta->add_attribute('destructor_class' => (
52             accessor => 'destructor_class',
53             default => 'Moose::Meta::Method::Destructor',
54             Class::MOP::_definition_context(),
55             ));
56              
57             sub initialize {
58 2713     2713 1 8516 my $class = shift;
59 2713         7844 my @args = @_;
60 2713 50       11800 unshift @args, 'package' if @args % 2;
61 2713         9202 my %opts = @args;
62 2713         6843 my $package = delete $opts{package};
63 2713   100     8238 return Class::MOP::get_metaclass_by_name($package)
64             || $class->SUPER::initialize($package,
65             'attribute_metaclass' => 'Moose::Meta::Attribute',
66             'method_metaclass' => 'Moose::Meta::Method',
67             'instance_metaclass' => 'Moose::Meta::Instance',
68             %opts,
69             );
70             }
71              
72             sub create {
73 696     696 1 26574 my $class = shift;
74 696         2378 my @args = @_;
75              
76 696 100       3712 unshift @args, 'package' if @args % 2 == 1;
77 696         2890 my %options = @args;
78              
79             (ref $options{roles} eq 'ARRAY')
80             || throw_exception( RolesInCreateTakesAnArrayRef => params => \%options )
81 696 100 66     3632 if exists $options{roles};
82              
83 694         1781 my $package = delete $options{package};
84 694         1530 my $roles = delete $options{roles};
85              
86 694         4099 my $new_meta = $class->SUPER::create($package, %options);
87              
88 692 100       2631 if ($roles) {
89 572         2243 Moose::Util::apply_all_roles( $new_meta, @$roles );
90             }
91              
92 689         4237 return $new_meta;
93             }
94              
95 2599     2599   21107 sub _meta_method_class { 'Moose::Meta::Method::Meta' }
96              
97 823     823   3459 sub _anon_package_prefix { 'Moose::Meta::Class::__ANON__::SERIAL::' }
98              
99             sub _anon_cache_key {
100 2717     2717   4950 my $class = shift;
101 2717         7542 my %options = @_;
102              
103             my $superclass_key = join('|',
104 2717   50     4749 map { $_->[0] } @{ Data::OptList::mkopt($options{superclasses} || []) }
  4781         114429  
  2717         11255  
105             );
106              
107             my $roles = Data::OptList::mkopt(($options{roles} || []), {
108             moniker => 'role',
109             name_test => sub {
110 19 100 66 19   752 ! ref $_[0] or blessed($_[0]) && $_[0]->isa('Moose::Meta::Role')
111             },
112 2717   100     20441 });
113              
114 2717         86605 my @role_keys;
115 2717         6499 for my $role_spec (@$roles) {
116 2726         6075 my ($role, $params) = @$role_spec;
117 2726 100       6018 $params = { %$params } if $params;
118              
119 2726 100       8370 my $key = blessed($role) ? $role->name : $role;
120              
121 2726 100 66     6779 if ($params && %$params) {
122             my $alias = delete $params->{'-alias'}
123 5   0     25 || delete $params->{'alias'}
124             || {};
125             my $excludes = delete $params->{'-excludes'}
126 5   50     42 || delete $params->{'excludes'}
127             || [];
128 5 100       23 $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
129              
130 5 50       17 if (%$params) {
131 0         0 warn "Roles with parameters cannot be cached. Consider "
132             . "applying the parameters before calling "
133             . "create_anon_class, or using 'weaken => 0' instead";
134 0         0 return;
135             }
136              
137             my $alias_key = join('%',
138 5         25 map { $_ => $alias->{$_} } sort keys %$alias
  5         24  
139             );
140 5         19 my $excludes_key = join('%',
141             sort @$excludes
142             );
143 5         28 $key .= '<' . join('+', 'a', $alias_key, 'e', $excludes_key) . '>';
144             }
145              
146 2726         6294 push @role_keys, $key;
147             }
148              
149 2717         8387 my $role_key = join('|', sort @role_keys);
150              
151             # Makes something like Super::Class|Super::Class::2=Role|Role::1
152 2717         12176 return join('=', $superclass_key, $role_key);
153             }
154              
155             sub reinitialize {
156 105     105 1 2766 my $self = shift;
157 105         213 my $pkg = shift;
158              
159 105 100       505 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
160              
161 105         248 my %existing_classes;
162 105 50       325 if ($meta) {
163 105         562 %existing_classes = map { $_ => $meta->$_() } qw(
  630         7572  
164             attribute_metaclass
165             method_metaclass
166             wrapped_method_metaclass
167             instance_metaclass
168             constructor_class
169             destructor_class
170             );
171             }
172              
173 105         957 return $self->SUPER::reinitialize(
174             $pkg,
175             %existing_classes,
176             @_,
177             );
178             }
179              
180             sub add_role {
181 1094     1094 1 4006 my ($self, $role) = @_;
182 1094 100 100     11677 (blessed($role) && $role->isa('Moose::Meta::Role'))
183             || throw_exception( AddRoleTakesAMooseMetaRoleInstance => role_to_be_added => $role,
184             class_name => $self->name,
185             );
186 1091         3672 push @{$self->roles} => $role;
  1091         30959  
187             }
188              
189             sub role_applications {
190 9     9 1 22 my ($self) = @_;
191              
192 9         16 return @{$self->_get_role_applications};
  9         321  
193             }
194              
195             sub add_role_application {
196 1091     1091 1 3005 my ($self, $application) = @_;
197              
198 1091 100 66     11424 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
199             || throw_exception( InvalidRoleApplication => class_name => $self->name,
200             application => $application,
201             );
202              
203 1090         3433 push @{$self->_get_role_applications} => $application;
  1090         39401  
204             }
205              
206             sub calculate_all_roles {
207 352     352 1 896 my $self = shift;
208 352         672 my %seen;
209 352         710 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
  541         2782  
  335         1751  
  352         10819  
210             }
211              
212             sub _roles_with_inheritance {
213 122     122   214 my $self = shift;
214 122         179 my %seen;
215 131         874 grep { !$seen{$_->name}++ }
216 122         295 map { Class::MOP::class_of($_)->can('roles')
217 1187 100       2150 ? @{ Class::MOP::class_of($_)->roles }
  131         252  
218             : () }
219             $self->linearized_isa;
220             }
221              
222             sub calculate_all_roles_with_inheritance {
223 22     22 1 48 my $self = shift;
224 22         45 my %seen;
225 33         249 grep { !$seen{$_->name}++ }
226 22 100       64 map { Class::MOP::class_of($_)->can('calculate_all_roles')
  189         386  
227             ? Class::MOP::class_of($_)->calculate_all_roles
228             : () }
229             $self->linearized_isa;
230             }
231              
232             sub does_role {
233 487     487 1 2016 my ($self, $role_name) = @_;
234              
235 487 100       1170 (defined $role_name)
236             || throw_exception( RoleNameRequired => class_name => $self->name );
237              
238 485         1537 foreach my $class ($self->class_precedence_list) {
239 943         2458 my $meta = Class::MOP::class_of($class);
240             # when a Moose metaclass is itself extended with a role,
241             # this check needs to be done since some items in the
242             # class_precedence_list might in fact be Class::MOP
243             # based still.
244 943 100 66     4953 next unless $meta && $meta->can('roles');
245 665         1141 foreach my $role (@{$meta->roles}) {
  665         20027  
246 458 100       1859 return 1 if $role->does_role($role_name);
247             }
248             }
249 127         712 return 0;
250             }
251              
252             sub excludes_role {
253 1121     1121 1 3472 my ($self, $role_name) = @_;
254              
255 1121 100       3615 (defined $role_name)
256             || throw_exception( RoleNameRequired => class_name => $self->name );
257              
258 1120         5768 foreach my $class ($self->class_precedence_list) {
259 10411         21537 my $meta = Class::MOP::class_of($class);
260             # when a Moose metaclass is itself extended with a role,
261             # this check needs to be done since some items in the
262             # class_precedence_list might in fact be Class::MOP
263             # based still.
264 10411 100 66     45022 next unless $meta && $meta->can('roles');
265 2178         4192 foreach my $role (@{$meta->roles}) {
  2178         62930  
266 116 100       671 return 1 if $role->excludes_role($role_name);
267             }
268             }
269 1114         6419 return 0;
270             }
271              
272             sub new_object {
273 3750     3750 1 7536 my $self = shift;
274 3750 100       9408 my $params = @_ == 1 ? $_[0] : {@_};
275 3750         14551 my $object = $self->SUPER::new_object($params);
276              
277 2758         9609 $self->_call_all_triggers($object, $params);
278              
279 2758 100       21967 $object->BUILDALL($params) if $object->can('BUILDALL');
280              
281 2749         18334 return $object;
282             }
283              
284             sub _call_all_triggers {
285 2837     2837   5915 my ($self, $object, $params) = @_;
286              
287 2837         8249 foreach my $attr ( $self->get_all_attributes() ) {
288              
289 12749 100 100     197121 next unless $attr->can('has_trigger') && $attr->has_trigger;
290              
291 51         248 my $init_arg = $attr->init_arg;
292 51 50       207 next unless defined $init_arg;
293 51 100       193 next unless exists $params->{$init_arg};
294              
295             $attr->trigger->(
296             $object,
297             (
298             $attr->should_coerce
299             ? $attr->get_read_method_ref->($object)
300 18 100       588 : $params->{$init_arg}
301             ),
302             );
303             }
304             }
305              
306             sub _generate_fallback_constructor {
307 745     745   1711 my $self = shift;
308 745         1818 my ($class) = @_;
309 745         6580 return $class . '->Moose::Object::new(@_)'
310             }
311              
312             sub _inline_params {
313 745     745   1721 my $self = shift;
314 745         2071 my ($params, $class) = @_;
315             return (
316 745         3421 'my ' . $params . ' = ',
317             $self->_inline_BUILDARGS($class, '@_'),
318             ';',
319             );
320             }
321              
322             sub _inline_BUILDARGS {
323 745     745   1887 my $self = shift;
324 745         1944 my ($class, $args) = @_;
325              
326 745         2877 my $buildargs = $self->find_method_by_name("BUILDARGS");
327              
328 745 100 100     5461 if ($args eq '@_'
      66        
329             && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
330             return (
331 743         4405 'do {',
332             'my $params;',
333             'if (scalar @_ == 1) {',
334             'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
335             $self->_inline_throw_exception(
336             'SingleParamsToNewMustBeHashRef'
337             ) . ';',
338             '}',
339             '$params = { %{ $_[0] } };',
340             '}',
341             'elsif (@_ % 2) {',
342             'Carp::carp(',
343             '"The new() method for ' . $class . ' expects a '
344             . 'hash reference or a key/value list. You passed an '
345             . 'odd number of arguments"',
346             ');',
347             '$params = {@_, undef};',
348             '}',
349             'else {',
350             '$params = {@_};',
351             '}',
352             '$params;',
353             '}',
354             );
355             }
356             else {
357 2         21 return $class . '->BUILDARGS(' . $args . ')';
358             }
359             }
360              
361             sub _inline_slot_initializer {
362 2489     2489   4468 my $self = shift;
363 2489         5036 my ($attr, $idx) = @_;
364              
365             return (
366 2489         11346 '## ' . $attr->name,
367             $self->_inline_check_required_attr($attr),
368             $self->SUPER::_inline_slot_initializer(@_),
369             );
370             }
371              
372             sub _inline_check_required_attr {
373 2488     2488   4844 my $self = shift;
374 2488         4529 my ($attr) = @_;
375              
376 2488 100       9690 return unless defined $attr->init_arg;
377 2479 100 100     98939 return unless $attr->can('is_required') && $attr->is_required;
378 933 100 100     4060 return if $attr->has_default || $attr->has_builder;
379              
380 920         8387 my $throw = $self->_inline_throw_exception(
381             'AttributeIsRequired',
382             sprintf(
383             <<'EOF', quotemeta( $attr->name ), quotemeta( $attr->init_arg ) ), );
384             params => $params,
385             class_name => $class_name,
386             attribute_name => "%s",
387             attribute_init_arg => "%s",
388             EOF
389              
390 920         8980 return sprintf( <<'EOF', quotemeta( $attr->init_arg ), $throw )
391             if ( !exists $params->{"%s"} ) {
392             %s;
393             }
394             EOF
395             }
396              
397             # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
398             # through to _inline_set_value - this should probably be fixed, but i'm not
399             # quite sure how. -doy
400             sub _inline_init_attr_from_constructor {
401 2480     2480   4356 my $self = shift;
402 2480         5211 my ($attr, $idx) = @_;
403              
404 2480         16142 my @initial_value = $attr->_inline_set_value(
405             '$instance',
406             '$params->{\'' . $attr->init_arg . '\'}',
407             '$type_constraint_bodies[' . $idx . ']',
408             '$type_coercions[' . $idx . ']',
409             '$type_constraint_messages[' . $idx . ']',
410             'for constructor',
411             );
412              
413 2480 100       9264 push @initial_value, (
414             '$attrs->[' . $idx . ']->set_initial_value(',
415             '$instance,',
416             $attr->_inline_instance_get('$instance'),
417             ');',
418             ) if $attr->has_initializer;
419              
420 2480         9807 return @initial_value;
421             }
422              
423             sub _inline_init_attr_from_default {
424 2489     2489   4527 my $self = shift;
425 2489         6043 my ($attr, $idx) = @_;
426              
427 2489 100 100     88204 return if $attr->can('is_lazy') && $attr->is_lazy;
428 1218         6306 my $default = $self->_inline_default_value($attr, $idx);
429 1218 100       5149 return unless $default;
430              
431 141         1097 my @initial_value = (
432             'my $default = ' . $default . ';',
433             $attr->_inline_set_value(
434             '$instance',
435             '$default',
436             '$type_constraint_bodies[' . $idx . ']',
437             '$type_coercions[' . $idx . ']',
438             '$type_constraint_messages[' . $idx . ']',
439             'for constructor',
440             ),
441             );
442              
443 141 50       678 push @initial_value, (
444             '$attrs->[' . $idx . ']->set_initial_value(',
445             '$instance,',
446             $attr->_inline_instance_get('$instance'),
447             ');',
448             ) if $attr->has_initializer;
449              
450 141         827 return @initial_value;
451             }
452              
453             sub _inline_extra_init {
454 745     745   1806 my $self = shift;
455             return (
456 745         3237 $self->_inline_triggers,
457             $self->_inline_BUILDALL,
458             );
459             }
460              
461             sub _inline_triggers {
462 745     745   1532 my $self = shift;
463 745         2224 my @trigger_calls;
464              
465 745         2687 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
  3098         10091  
466 745         4537 for my $i (0 .. $#attrs) {
467 2489         4867 my $attr = $attrs[$i];
468              
469 2489 100 100     89517 next unless $attr->can('has_trigger') && $attr->has_trigger;
470              
471 13         79 my $init_arg = $attr->init_arg;
472 13 50       53 next unless defined $init_arg;
473              
474 13         115 push @trigger_calls,
475             'if (exists $params->{\'' . $init_arg . '\'}) {',
476             '$triggers->[' . $i . ']->(',
477             '$instance,',
478             $attr->_inline_instance_get('$instance') . ',',
479             ');',
480             '}';
481             }
482              
483 745         4703 return @trigger_calls;
484             }
485              
486             sub _inline_BUILDALL {
487 745     745   1749 my $self = shift;
488              
489 745         5771 my @methods = reverse $self->find_all_methods_by_name('BUILD');
490 745 100       3725 return () unless @methods;
491              
492 619         1522 my @BUILD_calls;
493              
494 619         1735 foreach my $method (@methods) {
495             push @BUILD_calls,
496 632         2941 '$instance->' . $method->{class} . '::BUILD($params);';
497             }
498              
499             return (
500 619         6643 'if (!$params->{__no_BUILD__}) {',
501             @BUILD_calls,
502             '}',
503             );
504             }
505              
506             sub _eval_environment {
507 746     746   1921 my $self = shift;
508              
509 746         3068 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
  3065         10602  
510              
511             my $triggers = [
512 746 100 100     2658 map { $_->can('has_trigger') && $_->has_trigger ? $_->trigger : undef }
  2489         93057  
513             @attrs
514             ];
515              
516             # We need to check if the attribute ->can('type_constraint')
517             # since we may be trying to immutabilize a Moose meta class,
518             # which in turn has attributes which are Class::MOP::Attribute
519             # objects, rather than Moose::Meta::Attribute. And
520             # Class::MOP::Attribute attributes have no type constraints.
521             # However we need to make sure we leave an undef value there
522             # because the inlined code is using the index of the attributes
523             # to determine where to find the type constraint
524              
525             my @type_constraints = map {
526 746 100       3652 $_->can('type_constraint') ? $_->type_constraint : undef
  2489         78136  
527             } @attrs;
528              
529             my @type_constraint_bodies = map {
530 746 100       3616 defined $_ ? $_->_compiled_type_constraint : undef;
  2489         89490  
531             } @type_constraints;
532              
533             my @type_coercions = map {
534 746 100 100     2426 defined $_ && $_->has_coercion
  2489         79397  
535             ? $_->coercion->_compiled_type_coercion
536             : undef
537             } @type_constraints;
538              
539             my @type_constraint_messages = map {
540 746 50       3294 defined $_
  2489 100       76755  
541             ? ($_->has_message ? $_->message : $_->_default_message)
542             : undef
543             } @type_constraints;
544              
545             return {
546 746         4493 %{ $self->SUPER::_eval_environment },
547 2488 50   2488   9048 ((any { defined && $_->has_initializer } @attrs)
548             ? ('$attrs' => \[@attrs])
549             : ()),
550             '$triggers' => \$triggers,
551             '@type_coercions' => \@type_coercions,
552             '@type_constraint_bodies' => \@type_constraint_bodies,
553             '@type_constraint_messages' => \@type_constraint_messages,
554 746 100       2116 ( map { defined($_) ? %{ $_->inline_environment } : () }
  2489 100       6271  
  2413         6933  
555             @type_constraints ),
556             # pretty sure this is only going to be closed over if you use a custom
557             # error class at this point, but we should still get rid of this
558             # at some point
559             '$meta' => \$self,
560             '$class_name' => \($self->name),
561             };
562             }
563              
564             sub superclasses {
565 15344     15344 1 29585 my $self = shift;
566 15344         52300 my $supers = Data::OptList::mkopt(\@_);
567 15344         353980 foreach my $super (@{ $supers }) {
  15344         36160  
568 3105         6718 my ($name, $opts) = @{ $super };
  3105         7933  
569 3105         14204 Moose::Util::_load_user_class($name, $opts);
570 3104         187243 my $meta = Class::MOP::class_of($name);
571 3104 100 100     31993 throw_exception( CanExtendOnlyClasses => role_name => $meta->name )
572             if $meta && $meta->isa('Moose::Meta::Role')
573             }
574 15341         26839 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
  3101         13074  
  15341         46780  
575             }
576              
577             ### ---------------------------------------------
578              
579             sub add_attribute {
580 2354     2354 1 7331 my $self = shift;
581 2354 100 66     18463 my $attr =
582             (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
583             ? $_[0]
584             : $self->_process_attribute(@_));
585 2314         14883 $self->SUPER::add_attribute($attr);
586             # it may be a Class::MOP::Attribute, theoretically, which doesn't have
587             # 'bare' and doesn't implement this method
588 2292 100       13783 if ($attr->can('_check_associated_methods')) {
589 2289         7801 $attr->_check_associated_methods;
590             }
591 2292         14623 return $attr;
592             }
593              
594             sub add_override_method_modifier {
595 1012     1012 1 2589 my ($self, $name, $method, $_super_package) = @_;
596              
597 1012         2851 my $existing_method = $self->get_method($name);
598 1012 100       2704 (!$existing_method)
599             || throw_exception( CannotOverrideLocalMethodIsPresent => class_name => $self->name,
600             method => $existing_method,
601             );
602 1010         5200 $self->add_method($name => Moose::Meta::Method::Overridden->new(
603             method => $method,
604             class => $self,
605             package => $_super_package, # need this for roles
606             name => $name,
607             ));
608             }
609              
610             sub add_augment_method_modifier {
611 16     16 1 52 my ($self, $name, $method) = @_;
612 16         106 my $existing_method = $self->get_method($name);
613 16 100       57 throw_exception( CannotAugmentIfLocalMethodPresent => class_name => $self->name,
614             method => $existing_method,
615             )
616             if( $existing_method );
617              
618 14         118 $self->add_method($name => Moose::Meta::Method::Augmented->new(
619             method => $method,
620             class => $self,
621             name => $name,
622             ));
623             }
624              
625             ## Private Utility methods ...
626              
627             sub _find_next_method_by_name_which_is_not_overridden {
628 1     1   5 my ($self, $name) = @_;
629 1         8 foreach my $method ($self->find_all_methods_by_name($name)) {
630             return $method->{code}
631 2 100 66     26 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
632             }
633 0         0 return undef;
634             }
635              
636             ## Metaclass compatibility
637              
638             sub _base_metaclasses {
639 6112     6112   10785 my $self = shift;
640 6112         16870 my %metaclasses = $self->SUPER::_base_metaclasses;
641 6112         20471 for my $class (keys %metaclasses) {
642 36672         119941 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
643             }
644             return (
645 6112         37018 %metaclasses,
646             );
647             }
648              
649             sub _fix_class_metaclass_incompatibility {
650 38     38   82 my $self = shift;
651 38         73 my ($super_meta) = @_;
652              
653 38         171 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
654              
655 35 50       184 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
656 0 0       0 ($self->is_pristine)
657             || throw_exception( CannotFixMetaclassCompatibility => class => $self,
658             superclass => $super_meta
659             );
660 0         0 my $super_meta_name = $super_meta->_real_ref_name;
661 0         0 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
662 0         0 my $new_self = $class_meta_subclass_meta_name->reinitialize(
663             $self->name,
664             );
665              
666 0         0 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
667             }
668             }
669              
670             sub _fix_single_metaclass_incompatibility {
671 124     124   214 my $self = shift;
672 124         226 my ($metaclass_type, $super_meta) = @_;
673              
674 124         461 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
675              
676 124 50       341 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
677 0 0       0 ($self->is_pristine)
678             || throw_exception( CannotFixMetaclassCompatibility => class => $self,
679             superclass => $super_meta,
680             metaclass_type => $metaclass_type
681             );
682 0         0 my $super_meta_name = $super_meta->_real_ref_name;
683 0         0 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
684 0         0 my $new_self = $super_meta->reinitialize(
685             $self->name,
686             $metaclass_type => $class_specific_meta_subclass_meta_name,
687             );
688              
689 0         0 $self->_replace_self( $new_self, $super_meta_name );
690             }
691             }
692              
693             sub _replace_self {
694 0     0   0 my $self = shift;
695 0         0 my ( $new_self, $new_class) = @_;
696              
697 0         0 %$self = %$new_self;
698 0         0 bless $self, $new_class;
699              
700             # We need to replace the cached metaclass instance or else when it goes
701             # out of scope Class::MOP::Class destroy's the namespace for the
702             # metaclass's class, causing much havoc.
703 0         0 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
704 0         0 Class::MOP::store_metaclass_by_name( $self->name, $self );
705 0 0       0 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
706             }
707              
708             sub _process_attribute {
709 1683     1683   6555 my ( $self, $name, @args ) = @_;
710              
711 1683 50 33     6506 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
  0         0  
712              
713 1683 100 100     7649 if (($name || '') =~ /^\+(.*)/) {
714 40         145 return $self->_process_inherited_attribute($1, @args);
715             }
716             else {
717 1643         5557 return $self->_process_new_attribute($name, @args);
718             }
719             }
720              
721             sub _process_new_attribute {
722 1643     1643   5380 my ( $self, $name, @args ) = @_;
723              
724 1643         14234 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
725             }
726              
727             sub _process_inherited_attribute {
728 40     40   223 my ($self, $attr_name, %options) = @_;
729              
730 40         241 my $inherited_attr = $self->find_attribute_by_name($attr_name);
731 40 100       202 (defined $inherited_attr)
732             || throw_exception( NoAttributeFoundInSuperClass => class_name => $self->name,
733             attribute_name => $attr_name,
734             params => \%options
735             );
736 36 50       163 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
737 36         191 return $inherited_attr->clone_and_inherit_options(%options);
738             }
739             else {
740             # NOTE:
741             # kind of a kludge to handle Class::MOP::Attributes
742 0         0 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
743             }
744             }
745              
746             # reinitialization support
747              
748             sub _restore_metaobjects_from {
749 104     104   262 my $self = shift;
750 104         247 my ($old_meta) = @_;
751              
752 104         475 $self->SUPER::_restore_metaobjects_from($old_meta);
753              
754 102         265 for my $role ( @{ $old_meta->roles } ) {
  102         3677  
755 8         29 $self->add_role($role);
756             }
757              
758 102         725 for my $application ( @{ $old_meta->_get_role_applications } ) {
  102         3693  
759 8         259 $application->class($self);
760 8         25 $self->add_role_application ($application);
761             }
762             }
763              
764             ## Immutability
765              
766             sub _immutable_options {
767 761     761   2413 my ( $self, @args ) = @_;
768              
769 761         3974 $self->SUPER::_immutable_options(
770             inline_destructor => 1,
771              
772             # Moose always does this when an attribute is created
773             inline_accessors => 0,
774              
775             @args,
776             );
777             }
778              
779             sub _fixup_attributes_after_rebless {
780 83     83   165 my $self = shift;
781 83         189 my ($instance, $rebless_from, %params) = @_;
782              
783 83         436 $self->SUPER::_fixup_attributes_after_rebless(
784             $instance,
785             $rebless_from,
786             %params
787             );
788              
789 79         405 $self->_call_all_triggers( $instance, \%params );
790             }
791              
792             ## -------------------------------------------------
793              
794             our $error_level;
795              
796             sub _inline_throw_exception {
797 1663     1663   4690 my ( $self, $exception_type, $throw_args ) = @_;
798 1663   100     17769 return 'die Module::Runtime::use_module("Moose::Exception::' . $exception_type . '")->new(' . ($throw_args || '') . ')';
799             }
800              
801             1;
802              
803             # ABSTRACT: The Moose metaclass
804              
805             __END__
806              
807             =pod
808              
809             =encoding UTF-8
810              
811             =head1 NAME
812              
813             Moose::Meta::Class - The Moose metaclass
814              
815             =head1 VERSION
816              
817             version 2.2205
818              
819             =head1 DESCRIPTION
820              
821             This class is a subclass of L<Class::MOP::Class> that provides
822             additional Moose-specific functionality.
823              
824             To really understand this class, you will need to start with the
825             L<Class::MOP::Class> documentation. This class can be understood as a
826             set of additional features on top of the basic feature provided by
827             that parent class.
828              
829             =head1 INHERITANCE
830              
831             C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
832              
833             =head1 METHODS
834              
835             =over 4
836              
837             =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
838              
839             This overrides the parent's method in order to provide its own
840             defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
841             C<method_metaclass> options.
842              
843             These all default to the appropriate Moose class.
844              
845             =item B<< Moose::Meta::Class->create($package_name, %options) >>
846              
847             This overrides the parent's method in order to accept a C<roles>
848             option. This should be an array reference containing roles
849             that the class does, each optionally followed by a hashref of options
850             (C<-excludes> and C<-alias>).
851              
852             my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
853              
854             =item B<< Moose::Meta::Class->create_anon_class >>
855              
856             This overrides the parent's method to accept a C<roles> option, just
857             as C<create> does.
858              
859             It also accepts a C<cache> option. If this is C<true>, then the anonymous
860             class will be cached based on its superclasses and roles. If an
861             existing anonymous class in the cache has the same superclasses and
862             roles, it will be reused.
863              
864             my $metaclass = Moose::Meta::Class->create_anon_class(
865             superclasses => ['Foo'],
866             roles => [qw/Some Roles Go Here/],
867             cache => 1,
868             );
869              
870             Each entry in both the C<superclasses> and the C<roles> option can be
871             followed by a hash reference with arguments. The C<superclasses>
872             option can be supplied with a L<-version|Class::MOP/Class Loading
873             Options> option that ensures the loaded superclass satisfies the
874             required version. The C<role> option also takes the C<-version> as an
875             argument, but the option hash reference can also contain any other
876             role relevant values like exclusions or parameterized role arguments.
877              
878             =item B<< $metaclass->new_object(%params) >>
879              
880             This overrides the parent's method in order to add support for
881             attribute triggers.
882              
883             =item B<< $metaclass->superclasses(@superclasses) >>
884              
885             This is the accessor allowing you to read or change the parents of
886             the class.
887              
888             Each superclass can be followed by a hash reference containing a
889             L<-version|Class::MOP/Class Loading Options> value. If the version
890             requirement is not satisfied an error will be thrown.
891              
892             When you pass classes to this method, we will attempt to load them if they are
893             not already loaded.
894              
895             =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
896              
897             This adds an C<override> method modifier to the package.
898              
899             =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
900              
901             This adds an C<augment> method modifier to the package.
902              
903             =item B<< $metaclass->calculate_all_roles >>
904              
905             This will return a unique array of L<Moose::Meta::Role> instances
906             which are attached to this class.
907              
908             =item B<< $metaclass->calculate_all_roles_with_inheritance >>
909              
910             This will return a unique array of L<Moose::Meta::Role> instances
911             which are attached to this class, and each of this class's ancestors.
912              
913             =item B<< $metaclass->add_role($role) >>
914              
915             This takes a L<Moose::Meta::Role> object, and adds it to the class's
916             list of roles. This I<does not> actually apply the role to the class.
917              
918             =item B<< $metaclass->role_applications >>
919              
920             Returns a list of L<Moose::Meta::Role::Application::ToClass>
921             objects, which contain the arguments to role application.
922              
923             =item B<< $metaclass->add_role_application($application) >>
924              
925             This takes a L<Moose::Meta::Role::Application::ToClass> object, and
926             adds it to the class's list of role applications. This I<does not>
927             actually apply any role to the class; it is only for tracking role
928             applications.
929              
930             =item B<< $metaclass->does_role($role) >>
931              
932             This returns a boolean indicating whether or not the class does the specified
933             role. The role provided can be either a role name or a L<Moose::Meta::Role>
934             object. This tests both the class and its parents.
935              
936             =item B<< $metaclass->excludes_role($role_name) >>
937              
938             A class excludes a role if it has already composed a role which
939             excludes the named role. This tests both the class and its parents.
940              
941             =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
942              
943             This overrides the parent's method in order to allow the parameters to
944             be provided as a hash reference.
945              
946             =item B<< $metaclass->constructor_class($class_name) >>
947              
948             =item B<< $metaclass->destructor_class($class_name) >>
949              
950             These are the names of classes used when making a class immutable. These
951             default to L<Moose::Meta::Method::Constructor> and
952             L<Moose::Meta::Method::Destructor> respectively. These accessors are
953             read-write, so you can use them to change the class name.
954              
955             =back
956              
957             =head1 BUGS
958              
959             See L<Moose/BUGS> for details on reporting bugs.
960              
961             =head1 AUTHORS
962              
963             =over 4
964              
965             =item *
966              
967             Stevan Little <stevan@cpan.org>
968              
969             =item *
970              
971             Dave Rolsky <autarch@urth.org>
972              
973             =item *
974              
975             Jesse Luehrs <doy@cpan.org>
976              
977             =item *
978              
979             Shawn M Moore <sartak@cpan.org>
980              
981             =item *
982              
983             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
984              
985             =item *
986              
987             Karen Etheridge <ether@cpan.org>
988              
989             =item *
990              
991             Florian Ragwitz <rafl@debian.org>
992              
993             =item *
994              
995             Hans Dieter Pearcey <hdp@cpan.org>
996              
997             =item *
998              
999             Chris Prather <chris@prather.org>
1000              
1001             =item *
1002              
1003             Matt S Trout <mstrout@cpan.org>
1004              
1005             =back
1006              
1007             =head1 COPYRIGHT AND LICENSE
1008              
1009             This software is copyright (c) 2006 by Infinity Interactive, Inc.
1010              
1011             This is free software; you can redistribute it and/or modify it under
1012             the same terms as the Perl 5 programming language system itself.
1013              
1014             =cut