Version 1.06
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
CommitLineData
c0e30cf5 1
2package Moose::Meta::Class;
3
4use strict;
5use warnings;
6
0addec44 7use Class::MOP;
648e79ae 8
590e8894 9use Carp qw( confess );
2e7f6cf4 10use Data::OptList;
f8b6827f 11use List::Util qw( first );
349cda54 12use List::MoreUtils qw( any all uniq first_index );
21f1e231 13use Scalar::Util 'weaken', 'blessed';
a15dff8d 14
ae7820b1 15our $VERSION = '1.06';
e606ae5f 16$VERSION = eval $VERSION;
d44714be 17our $AUTHORITY = 'cpan:STEVAN';
bc1e29b5 18
74862722 19use Moose::Meta::Method::Overridden;
3f9e4b0a 20use Moose::Meta::Method::Augmented;
77f14411 21use Moose::Error::Default;
0fa70d03 22use Moose::Meta::Class::Immutable::Trait;
23use Moose::Meta::Method::Constructor;
24use Moose::Meta::Method::Destructor;
8ee73eeb 25
c0e30cf5 26use base 'Class::MOP::Class';
27
598340d5 28__PACKAGE__->meta->add_attribute('roles' => (
ef333f17 29 reader => 'roles',
30 default => sub { [] }
31));
32
a9b63d79 33__PACKAGE__->meta->add_attribute('role_applications' => (
639f9a1a 34 reader => '_get_role_applications',
a9b63d79 35 default => sub { [] }
36));
37
0fa70d03 38__PACKAGE__->meta->add_attribute(
39 Class::MOP::Attribute->new('immutable_trait' => (
40 accessor => "immutable_trait",
41 default => 'Moose::Meta::Class::Immutable::Trait',
42 ))
43);
44
e606ae5f 45__PACKAGE__->meta->add_attribute('constructor_class' => (
46 accessor => 'constructor_class',
e0001338 47 default => 'Moose::Meta::Method::Constructor',
e606ae5f 48));
49
50__PACKAGE__->meta->add_attribute('destructor_class' => (
51 accessor => 'destructor_class',
e0001338 52 default => 'Moose::Meta::Method::Destructor',
e606ae5f 53));
54
11c86f15 55__PACKAGE__->meta->add_attribute('error_class' => (
bf6fa6b3 56 accessor => 'error_class',
57 default => 'Moose::Error::Default',
11c86f15 58));
59
590868a3 60sub initialize {
61 my $class = shift;
62 my $pkg = shift;
d03bd989 63 return Class::MOP::get_metaclass_by_name($pkg)
685f7e44 64 || $class->SUPER::initialize($pkg,
65 'attribute_metaclass' => 'Moose::Meta::Attribute',
66 'method_metaclass' => 'Moose::Meta::Method',
67 'instance_metaclass' => 'Moose::Meta::Instance',
68 @_
d03bd989 69 );
ac2dc464 70}
590868a3 71
0fa70d03 72sub _immutable_options {
73 my ( $self, @args ) = @_;
74
75 $self->SUPER::_immutable_options(
76 inline_destructor => 1,
77
78 # Moose always does this when an attribute is created
79 inline_accessors => 0,
80
81 @args,
82 );
83}
84
61bdd94f 85sub create {
7d4035ae 86 my ($class, $package_name, %options) = @_;
d03bd989 87
61bdd94f 88 (ref $options{roles} eq 'ARRAY')
7d4035ae 89 || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
61bdd94f 90 if exists $options{roles};
310ba883 91 my $roles = delete $options{roles};
dd37a5be 92
7d4035ae 93 my $new_meta = $class->SUPER::create($package_name, %options);
dd37a5be 94
310ba883 95 if ($roles) {
7d4035ae 96 Moose::Util::apply_all_roles( $new_meta, @$roles );
61bdd94f 97 }
d03bd989 98
7d4035ae 99 return $new_meta;
61bdd94f 100}
101
17594769 102my %ANON_CLASSES;
103
104sub create_anon_class {
105 my ($self, %options) = @_;
106
107 my $cache_ok = delete $options{cache};
d03bd989 108
cf600c83 109 my $cache_key
110 = _anon_cache_key( $options{superclasses}, $options{roles} );
d03bd989 111
6d5cbd2b 112 if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
17594769 113 return $ANON_CLASSES{$cache_key};
114 }
d03bd989 115
17594769 116 my $new_class = $self->SUPER::create_anon_class(%options);
117
6d5cbd2b 118 $ANON_CLASSES{$cache_key} = $new_class
119 if $cache_ok;
17594769 120
121 return $new_class;
122}
123
cf600c83 124sub _anon_cache_key {
125 # Makes something like Super::Class|Super::Class::2=Role|Role::1
126 return join '=' => (
127 join( '|', @{ $_[0] || [] } ),
128 join( '|', sort @{ $_[1] || [] } ),
129 );
130}
131
132sub reinitialize {
133 my $self = shift;
134 my $pkg = shift;
135
136 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
137
138 my $cache_key;
139
140 my %existing_classes;
141 if ($meta) {
142 %existing_classes = map { $_ => $meta->$_() } qw(
143 attribute_metaclass
144 method_metaclass
145 wrapped_method_metaclass
146 instance_metaclass
147 constructor_class
148 destructor_class
149 error_class
150 );
151
152 $cache_key = _anon_cache_key(
153 [ $meta->superclasses ],
154 [ map { $_->name } @{ $meta->roles } ],
155 ) if $meta->is_anon_class;
156 }
157
158 my $new_meta = $self->SUPER::reinitialize(
159 $pkg,
160 %existing_classes,
161 @_,
162 );
163
164 return $new_meta unless defined $cache_key;
165
166 my $new_cache_key = _anon_cache_key(
167 [ $meta->superclasses ],
168 [ map { $_->name } @{ $meta->roles } ],
169 );
170
171 delete $ANON_CLASSES{$cache_key};
172 $ANON_CLASSES{$new_cache_key} = $new_meta;
173
174 return $new_meta;
175}
176
ef333f17 177sub add_role {
178 my ($self, $role) = @_;
179 (blessed($role) && $role->isa('Moose::Meta::Role'))
11c86f15 180 || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
ef333f17 181 push @{$self->roles} => $role;
182}
183
639f9a1a 184sub role_applications {
185 my ($self) = @_;
186
187 return @{$self->_get_role_applications};
188}
189
a9b63d79 190sub add_role_application {
191 my ($self, $application) = @_;
192 (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
193 || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
639f9a1a 194 push @{$self->_get_role_applications} => $application;
a9b63d79 195}
196
b8aeb4dc 197sub calculate_all_roles {
198 my $self = shift;
199 my %seen;
200 grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
201}
202
9f83eb5d 203sub calculate_all_roles_with_inheritance {
204 my $self = shift;
205 my %seen;
206 grep { !$seen{$_->name}++ }
207 map { Class::MOP::class_of($_)->can('calculate_all_roles')
208 ? Class::MOP::class_of($_)->calculate_all_roles
209 : () }
210 $self->linearized_isa;
211}
212
ef333f17 213sub does_role {
214 my ($self, $role_name) = @_;
322abb07 215
ef333f17 216 (defined $role_name)
11c86f15 217 || $self->throw_error("You must supply a role name to look for");
322abb07 218
9c429218 219 foreach my $class ($self->class_precedence_list) {
322abb07 220 my $meta = Class::MOP::class_of($class);
3d0f5a27 221 # when a Moose metaclass is itself extended with a role,
222 # this check needs to be done since some items in the
223 # class_precedence_list might in fact be Class::MOP
224 # based still.
322abb07 225 next unless $meta && $meta->can('roles');
226 foreach my $role (@{$meta->roles}) {
9c429218 227 return 1 if $role->does_role($role_name);
228 }
ef333f17 229 }
230 return 0;
231}
232
d79e62fd 233sub excludes_role {
234 my ($self, $role_name) = @_;
ebfc4d0f 235
d79e62fd 236 (defined $role_name)
11c86f15 237 || $self->throw_error("You must supply a role name to look for");
ebfc4d0f 238
ac2dc464 239 foreach my $class ($self->class_precedence_list) {
ebfc4d0f 240 my $meta = Class::MOP::class_of($class);
241 # when a Moose metaclass is itself extended with a role,
242 # this check needs to be done since some items in the
243 # class_precedence_list might in fact be Class::MOP
244 # based still.
245 next unless $meta && $meta->can('roles');
246 foreach my $role (@{$meta->roles}) {
9c429218 247 return 1 if $role->excludes_role($role_name);
248 }
d79e62fd 249 }
250 return 0;
251}
252
8c9d74e7 253sub new_object {
7d4035ae 254 my $self = shift;
e606ae5f 255 my $params = @_ == 1 ? $_[0] : {@_};
7d4035ae 256 my $object = $self->SUPER::new_object($params);
1308deb4 257
7d4035ae 258 foreach my $attr ( $self->get_all_attributes() ) {
1308deb4 259
260 next unless $attr->can('has_trigger') && $attr->has_trigger;
261
262 my $init_arg = $attr->init_arg;
263
264 next unless defined $init_arg;
265
266 next unless exists $params->{$init_arg};
267
268 $attr->trigger->(
7d4035ae 269 $object,
1308deb4 270 (
271 $attr->should_coerce
7d4035ae 272 ? $attr->get_read_method_ref->($object)
1308deb4 273 : $params->{$init_arg}
274 ),
1308deb4 275 );
8c9d74e7 276 }
1308deb4 277
7d4035ae 278 $object->BUILDALL($params) if $object->can('BUILDALL');
a19ae3d7 279
7d4035ae 280 return $object;
8c9d74e7 281}
282
e2eef3a5 283sub superclasses {
284 my $self = shift;
2e7f6cf4 285 my $supers = Data::OptList::mkopt(\@_);
286 foreach my $super (@{ $supers }) {
287 my ($name, $opts) = @{ $super };
288 Class::MOP::load_class($name, $opts);
289 my $meta = Class::MOP::class_of($name);
290 $self->throw_error("You cannot inherit from a Moose Role ($name)")
e2eef3a5 291 if $meta && $meta->isa('Moose::Meta::Role')
292 }
2e7f6cf4 293 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
e2eef3a5 294}
295
093b12c2 296### ---------------------------------------------
297
a2eec5e7 298sub add_attribute {
299 my $self = shift;
28af3424 300 my $attr =
e472c9a5 301 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
d03bd989 302 ? $_[0]
28af3424 303 : $self->_process_attribute(@_));
304 $self->SUPER::add_attribute($attr);
305 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
306 # 'bare' and doesn't implement this method
9340e346 307 if ($attr->can('_check_associated_methods')) {
308 $attr->_check_associated_methods;
28af3424 309 }
310 return $attr;
a2eec5e7 311}
312
78cd1d3b 313sub add_override_method_modifier {
314 my ($self, $name, $method, $_super_package) = @_;
18c2ec0e 315
d05cd563 316 (!$self->has_method($name))
11c86f15 317 || $self->throw_error("Cannot add an override method if a local method is already present");
18c2ec0e 318
74862722 319 $self->add_method($name => Moose::Meta::Method::Overridden->new(
3f9e4b0a 320 method => $method,
321 class => $self,
322 package => $_super_package, # need this for roles
323 name => $name,
18c2ec0e 324 ));
78cd1d3b 325}
326
327sub add_augment_method_modifier {
ac2dc464 328 my ($self, $name, $method) = @_;
d05cd563 329 (!$self->has_method($name))
11c86f15 330 || $self->throw_error("Cannot add an augment method if a local method is already present");
3f9e4b0a 331
332 $self->add_method($name => Moose::Meta::Method::Augmented->new(
333 method => $method,
334 class => $self,
335 name => $name,
336 ));
78cd1d3b 337}
338
1341f10c 339## Private Utility methods ...
340
05d9eaf6 341sub _find_next_method_by_name_which_is_not_overridden {
342 my ($self, $name) = @_;
68efb014 343 foreach my $method ($self->find_all_methods_by_name($name)) {
ac2dc464 344 return $method->{code}
74862722 345 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
05d9eaf6 346 }
347 return undef;
348}
349
f6df97ae 350## Metaclass compatibility
f8b6827f 351
f6df97ae 352sub _base_metaclasses {
353 my $self = shift;
354 my %metaclasses = $self->SUPER::_base_metaclasses;
355 for my $class (keys %metaclasses) {
356 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
1341f10c 357 }
f6df97ae 358 return (
359 %metaclasses,
360 error_class => 'Moose::Error::Default',
f8b6827f 361 );
f8b6827f 362}
363
f6df97ae 364sub _find_common_base {
365 my $self = shift;
366 my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
0b91067b 367 return unless defined $meta1 && defined $meta2;
f8b6827f 368
369 # FIXME? This doesn't account for multiple inheritance (not sure
79ca665e 370 # if it needs to though). For example, if somewhere in $meta1's
db9fda52 371 # history it inherits from both ClassA and ClassB, and $meta2
f8b6827f 372 # inherits from ClassB & ClassA, does it matter? And what crazy
373 # fool would do that anyway?
374
375 my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
376
377 return first { $meta1_parents{$_} } $meta2->linearized_isa;
378}
379
f6df97ae 380sub _get_ancestors_until {
381 my $self = shift;
dd3ac8f9 382 my ($start_name, $until_name) = @_;
f8b6827f 383
dd3ac8f9 384 my @ancestor_names;
385 for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) {
386 last if $ancestor_name eq $until_name;
387 push @ancestor_names, $ancestor_name;
f6df97ae 388 }
dd3ac8f9 389 return @ancestor_names;
f6df97ae 390}
f8b6827f 391
f6df97ae 392sub _is_role_only_subclass {
393 my $self = shift;
dd3ac8f9 394 my ($meta_name) = @_;
395 my $meta = Class::MOP::Class->initialize($meta_name);
396 my @parent_names = $meta->superclasses;
f6df97ae 397
398 # XXX: don't feel like messing with multiple inheritance here... what would
399 # that even do?
dd3ac8f9 400 return unless @parent_names == 1;
401 my ($parent_name) = @parent_names;
402 my $parent_meta = Class::MOP::Class->initialize($parent_name);
f6df97ae 403
593152a0 404 my @roles = $meta->can('calculate_all_roles_with_inheritance')
405 ? $meta->calculate_all_roles_with_inheritance
406 : ();
407
f6df97ae 408 # loop over all methods that are a part of the current class
409 # (not inherited)
dd3ac8f9 410 for my $method (map { $meta->get_method($_) } $meta->get_method_list) {
f6df97ae 411 # always ignore meta
f8b6827f 412 next if $method->name eq 'meta';
f6df97ae 413 # we'll deal with attributes below
593152a0 414 next if $method->can('associated_attribute');
f6df97ae 415 # if the method comes from a role we consumed, ignore it
dd3ac8f9 416 next if $meta->can('does_role')
417 && $meta->does_role($method->original_package_name);
593152a0 418 # FIXME - this really isn't right. Just because a modifier is
419 # defined in a role doesn't mean it isn't _also_ defined in the
420 # subclass.
421 next if $method->isa('Class::MOP::Method::Wrapped')
422 && (
423 (!scalar($method->around_modifiers)
424 || any { $_->has_around_method_modifiers($method->name) } @roles)
425 && (!scalar($method->before_modifiers)
426 || any { $_->has_before_method_modifiers($method->name) } @roles)
427 && (!scalar($method->after_modifiers)
428 || any { $_->has_after_method_modifiers($method->name) } @roles)
429 );
f8b6827f 430
431 return 0;
432 }
433
f6df97ae 434 # loop over all attributes that are a part of the current class
435 # (not inherited)
f8b6827f 436 # FIXME - this really isn't right. Just because an attribute is
437 # defined in a role doesn't mean it isn't _also_ defined in the
438 # subclass.
dd3ac8f9 439 for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
593152a0 440 next if any { $_->has_attribute($attr->name) } @roles;
f8b6827f 441
442 return 0;
443 }
444
445 return 1;
446}
447
f6df97ae 448sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
449 my $self = shift;
450 my ($super_meta) = @_;
451
a907317a 452 my $super_meta_name = $super_meta->_real_ref_name;
f6df97ae 453
bc9dc5fb 454 return $self->_classes_differ_by_roles_only(
455 blessed($self),
456 $super_meta_name,
457 'Moose::Meta::Class',
458 );
f8b6827f 459}
460
f6df97ae 461sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
462 my $self = shift;
dd3ac8f9 463 my ($metaclass_type, $super_meta) = @_;
f8b6827f 464
dd3ac8f9 465 my $class_specific_meta_name = $self->$metaclass_type;
466 return unless $super_meta->can($metaclass_type);
467 my $super_specific_meta_name = $super_meta->$metaclass_type;
f6df97ae 468 my %metaclasses = $self->_base_metaclasses;
f8b6827f 469
bc9dc5fb 470 return $self->_classes_differ_by_roles_only(
471 $class_specific_meta_name,
472 $super_specific_meta_name,
473 $metaclasses{$metaclass_type},
474 );
475}
476
477sub _classes_differ_by_roles_only {
478 my $self = shift;
479 my ( $self_meta_name, $super_meta_name, $expected_ancestor ) = @_;
480
481 my $common_base_name
482 = $self->_find_common_base( $self_meta_name, $super_meta_name );
483
484 # If they're not both moose metaclasses, and the cmop fixing couldn't do
485 # anything, there's nothing more we can do. The $expected_ancestor should
486 # always be a Moose metaclass name like Moose::Meta::Class or
487 # Moose::Meta::Attribute.
0b91067b 488 return unless defined $common_base_name;
bc9dc5fb 489 return unless $common_base_name->isa($expected_ancestor);
490
491 my @super_meta_name_ancestor_names
492 = $self->_get_ancestors_until( $super_meta_name, $common_base_name );
493 my @class_meta_name_ancestor_names
494 = $self->_get_ancestors_until( $self_meta_name, $common_base_name );
495
496 return
497 unless all { $self->_is_role_only_subclass($_) }
498 @super_meta_name_ancestor_names,
499 @class_meta_name_ancestor_names;
f8b6827f 500
f6df97ae 501 return 1;
502}
f8b6827f 503
f6df97ae 504sub _role_differences {
505 my $self = shift;
dd3ac8f9 506 my ($class_meta_name, $super_meta_name) = @_;
9f83eb5d 507 my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance')
508 ? $super_meta_name->meta->calculate_all_roles_with_inheritance
dd3ac8f9 509 : ();
9f83eb5d 510 my @role_metas = $class_meta_name->meta->can('calculate_all_roles_with_inheritance')
511 ? $class_meta_name->meta->calculate_all_roles_with_inheritance
dd3ac8f9 512 : ();
f6df97ae 513 my @differences;
dd3ac8f9 514 for my $role_meta (@role_metas) {
515 push @differences, $role_meta
516 unless any { $_->name eq $role_meta->name } @super_role_metas;
f8b6827f 517 }
f6df97ae 518 return @differences;
f8b6827f 519}
520
f6df97ae 521sub _reconcile_roles_for_metaclass {
522 my $self = shift;
dd3ac8f9 523 my ($class_meta_name, $super_meta_name) = @_;
f8b6827f 524
dd3ac8f9 525 my @role_differences = $self->_role_differences(
526 $class_meta_name, $super_meta_name,
527 );
9f83eb5d 528 return Moose::Meta::Class->create_anon_class(
dd3ac8f9 529 superclasses => [$super_meta_name],
f6df97ae 530 roles => \@role_differences,
531 cache => 1,
532 );
533}
534
535sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
536 my $self = shift;
537 my ($super_meta) = @_;
f8b6827f 538
f6df97ae 539 return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
f8b6827f 540
f6df97ae 541 my %base_metaclass = $self->_base_metaclasses;
542 for my $metaclass_type (keys %base_metaclass) {
543 next unless defined $self->$metaclass_type;
544 return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
f8b6827f 545 }
546
f6df97ae 547 return;
548}
f8b6827f 549
f6df97ae 550sub _can_fix_metaclass_incompatibility {
551 my $self = shift;
552 return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
553 return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
554}
555
556sub _fix_class_metaclass_incompatibility {
557 my $self = shift;
558 my ($super_meta) = @_;
f8b6827f 559
f6df97ae 560 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
f8b6827f 561
f6df97ae 562 if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
590e8894 563 ($self->is_pristine)
564 || confess "Can't fix metaclass incompatibility for "
565 . $self->name
566 . " because it is not pristine.";
a907317a 567 my $super_meta_name = $super_meta->_real_ref_name;
9f83eb5d 568 my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
cf7febc7 569 my $new_self = $class_meta_subclass_meta->name->reinitialize(
570 $self->name,
571 );
6a52b083 572
573 $self->_replace_self( $new_self, $class_meta_subclass_meta->name );
f8b6827f 574 }
f6df97ae 575}
f8b6827f 576
f6df97ae 577sub _fix_single_metaclass_incompatibility {
578 my $self = shift;
579 my ($metaclass_type, $super_meta) = @_;
f8b6827f 580
f6df97ae 581 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
f8b6827f 582
f6df97ae 583 if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
590e8894 584 ($self->is_pristine)
585 || confess "Can't fix metaclass incompatibility for "
586 . $self->name
587 . " because it is not pristine.";
dd3ac8f9 588 my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
cf7febc7 589 my $new_self = $super_meta->reinitialize(
590 $self->name,
591 $metaclass_type => $class_specific_meta_subclass_meta->name,
592 );
6a52b083 593
594 $self->_replace_self( $new_self, blessed($super_meta) );
f6df97ae 595 }
f8b6827f 596}
597
6a52b083 598
599sub _replace_self {
600 my $self = shift;
601 my ( $new_self, $new_class) = @_;
602
603 %$self = %$new_self;
604 bless $self, $new_class;
605
606 # We need to replace the cached metaclass instance or else when it goes
607 # out of scope Class::MOP::Class destroy's the namespace for the
608 # metaclass's class, causing much havoc.
609 Class::MOP::store_metaclass_by_name( $self->name, $self );
610 Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
611}
612
1341f10c 613sub _process_attribute {
a3738e5b 614 my ( $self, $name, @args ) = @_;
7e59b803 615
616 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
d9bb6c63 617
f9b5f5f8 618 if (($name || '') =~ /^\+(.*)/) {
7e59b803 619 return $self->_process_inherited_attribute($1, @args);
1341f10c 620 }
621 else {
7e59b803 622 return $self->_process_new_attribute($name, @args);
623 }
624}
625
626sub _process_new_attribute {
627 my ( $self, $name, @args ) = @_;
7e59b803 628
d5c30e52 629 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
1341f10c 630}
631
632sub _process_inherited_attribute {
633 my ($self, $attr_name, %options) = @_;
634 my $inherited_attr = $self->find_attribute_by_name($attr_name);
635 (defined $inherited_attr)
329c5dd4 636 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
1341f10c 637 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
d7d8a8c7 638 return $inherited_attr->clone_and_inherit_options(%options);
1341f10c 639 }
640 else {
641 # NOTE:
642 # kind of a kludge to handle Class::MOP::Attributes
d7d8a8c7 643 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
ac2dc464 644 }
1341f10c 645}
646
5cf3dbcf 647## -------------------------------------------------
648
bf6fa6b3 649our $error_level;
11c86f15 650
651sub throw_error {
652 my ( $self, @args ) = @_;
bf6fa6b3 653 local $error_level = ($error_level || 0) + 1;
11c86f15 654 $self->raise_error($self->create_error(@args));
655}
656
657sub raise_error {
658 my ( $self, @args ) = @_;
659 die @args;
660}
661
662sub create_error {
663 my ( $self, @args ) = @_;
664
18748ad6 665 require Carp::Heavy;
666
bf6fa6b3 667 local $error_level = ($error_level || 0 ) + 1;
18748ad6 668
11c86f15 669 if ( @args % 2 == 1 ) {
670 unshift @args, "message";
671 }
672
fcab1742 673 my %args = ( metaclass => $self, last_error => $@, @args );
11c86f15 674
bf6fa6b3 675 $args{depth} += $error_level;
11c86f15 676
bf6fa6b3 677 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
11c86f15 678
a810a01f 679 Class::MOP::load_class($class);
680
11c86f15 681 $class->new(
bf6fa6b3 682 Carp::caller_info($args{depth}),
683 %args
11c86f15 684 );
685}
686
c0e30cf5 6871;
688
689__END__
690
691=pod
692
693=head1 NAME
694
e522431d 695Moose::Meta::Class - The Moose metaclass
c0e30cf5 696
c0e30cf5 697=head1 DESCRIPTION
698
70bb0f97 699This class is a subclass of L<Class::MOP::Class> that provides
700additional Moose-specific functionality.
e522431d 701
7854b409 702To really understand this class, you will need to start with the
703L<Class::MOP::Class> documentation. This class can be understood as a
704set of additional features on top of the basic feature provided by
705that parent class.
6ba6d68c 706
d4b1449e 707=head1 INHERITANCE
708
709C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
710
c0e30cf5 711=head1 METHODS
712
713=over 4
714
70bb0f97 715=item B<< Moose::Meta::Class->initialize($package_name, %options) >>
590868a3 716
70bb0f97 717This overrides the parent's method in order to provide its own
718defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
719C<method_metaclass> options.
61bdd94f 720
70bb0f97 721These all default to the appropriate Moose class.
61bdd94f 722
70bb0f97 723=item B<< Moose::Meta::Class->create($package_name, %options) >>
17594769 724
70bb0f97 725This overrides the parent's method in order to accept a C<roles>
9e25a72a 726option. This should be an array reference containing roles
727that the class does, each optionally followed by a hashref of options
728(C<-excludes> and C<-alias>).
17594769 729
70bb0f97 730 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
17594769 731
70bb0f97 732=item B<< Moose::Meta::Class->create_anon_class >>
17594769 733
70bb0f97 734This overrides the parent's method to accept a C<roles> option, just
735as C<create> does.
5cf3dbcf 736
70bb0f97 737It also accepts a C<cache> option. If this is true, then the anonymous
738class will be cached based on its superclasses and roles. If an
739existing anonymous class in the cache has the same superclasses and
740roles, it will be reused.
ac2dc464 741
70bb0f97 742 my $metaclass = Moose::Meta::Class->create_anon_class(
743 superclasses => ['Foo'],
744 roles => [qw/Some Roles Go Here/],
745 cache => 1,
746 );
ac2dc464 747
2e7f6cf4 748Each entry in both the C<superclasses> and the C<roles> option can be
b2d54db8 749followed by a hash reference with arguments. The C<superclasses>
2e7f6cf4 750option can be supplied with a L<-version|Class::MOP/Class Loading
751Options> option that ensures the loaded superclass satisfies the
752required version. The C<role> option also takes the C<-version> as an
753argument, but the option hash reference can also contain any other
754role relevant values like exclusions or parameterized role arguments.
755
70bb0f97 756=item B<< $metaclass->make_immutable(%options) >>
ac2dc464 757
70bb0f97 758This overrides the parent's method to add a few options. Specifically,
759it uses the Moose-specific constructor and destructor classes, and
760enables inlining the destructor.
8c9d74e7 761
70bb0f97 762Also, since Moose always inlines attributes, it sets the
763C<inline_accessors> option to false.
02a0fb52 764
70bb0f97 765=item B<< $metaclass->new_object(%params) >>
a15dff8d 766
70bb0f97 767This overrides the parent's method in order to add support for
768attribute triggers.
6ba6d68c 769
2e7f6cf4 770=item B<< $metaclass->superclasses(@superclasses) >>
771
6b958a3e 772This is the accessor allowing you to read or change the parents of
2e7f6cf4 773the class.
774
775Each superclass can be followed by a hash reference containing a
776L<-version|Class::MOP/Class Loading Options> value. If the version
777requirement is not satisfied an error will be thrown.
778
70bb0f97 779=item B<< $metaclass->add_override_method_modifier($name, $sub) >>
ef1d5f4b 780
70bb0f97 781This adds an C<override> method modifier to the package.
e9ec68d6 782
70bb0f97 783=item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
e9ec68d6 784
70bb0f97 785This adds an C<augment> method modifier to the package.
78cd1d3b 786
70bb0f97 787=item B<< $metaclass->calculate_all_roles >>
02a0fb52 788
70bb0f97 789This will return a unique array of C<Moose::Meta::Role> instances
790which are attached to this class.
78cd1d3b 791
9f83eb5d 792=item B<< $metaclass->calculate_all_roles_with_inheritance >>
793
794This will return a unique array of C<Moose::Meta::Role> instances
795which are attached to this class, and each of this class's ancestors.
796
70bb0f97 797=item B<< $metaclass->add_role($role) >>
02a0fb52 798
70bb0f97 799This takes a L<Moose::Meta::Role> object, and adds it to the class's
800list of roles. This I<does not> actually apply the role to the class.
2b14ac61 801
b90dd4ef 802=item B<< $metaclass->role_applications >>
803
639f9a1a 804Returns a list of L<Moose::Meta::Role::Application::ToClass>
b90dd4ef 805objects, which contain the arguments to role application.
806
807=item B<< $metaclass->add_role_application($application) >>
808
809This takes a L<Moose::Meta::Role::Application::ToClass> object, and
810adds it to the class's list of role applications. This I<does not>
811actually apply any role to the class; it is only for tracking role
812applications.
813
560c498d 814=item B<< $metaclass->does_role($role) >>
ef333f17 815
560c498d 816This returns a boolean indicating whether or not the class does the specified
817role. The role provided can be either a role name or a L<Moose::Meta::Role>
818object. This tests both the class and its parents.
02a0fb52 819
70bb0f97 820=item B<< $metaclass->excludes_role($role_name) >>
ef333f17 821
70bb0f97 822A class excludes a role if it has already composed a role which
823excludes the named role. This tests both the class and its parents.
02a0fb52 824
70bb0f97 825=item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
ef333f17 826
70bb0f97 827This overrides the parent's method in order to allow the parameters to
828be provided as a hash reference.
02a0fb52 829
9f9fdd08 830=item B<< $metaclass->constructor_class($class_name) >>
d79e62fd 831
9f9fdd08 832=item B<< $metaclass->destructor_class($class_name) >>
e606ae5f 833
834These are the names of classes used when making a class
835immutable. These default to L<Moose::Meta::Method::Constructor> and
836L<Moose::Meta::Method::Destructor> respectively. These accessors are
837read-write, so you can use them to change the class name.
838
70bb0f97 839=item B<< $metaclass->error_class($class_name) >>
8b1d510f 840
70bb0f97 841The name of the class used to throw errors. This defaults to
8b1d510f 842L<Moose::Error::Default>, which generates an error with a stacktrace
843just like C<Carp::confess>.
844
70bb0f97 845=item B<< $metaclass->throw_error($message, %extra) >>
11c86f15 846
847Throws the error created by C<create_error> using C<raise_error>
848
c0e30cf5 849=back
850
851=head1 BUGS
852
d4048ef3 853See L<Moose/BUGS> for details on reporting bugs.
c0e30cf5 854
c0e30cf5 855=head1 AUTHOR
856
857Stevan Little E<lt>stevan@iinteractive.comE<gt>
858
859=head1 COPYRIGHT AND LICENSE
860
7e0492d3 861Copyright 2006-2010 by Infinity Interactive, Inc.
c0e30cf5 862
863L<http://www.iinteractive.com>
864
865This library is free software; you can redistribute it and/or modify
ac2dc464 866it under the same terms as Perl itself.
c0e30cf5 867
8a7a9c53 868=cut
1a563243 869