Bump version to 1.9900 for new version numbering scheme
[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
bb8ef151 15our $VERSION = '1.9900';
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;
699a2e32 25use Moose::Meta::Method::Meta;
61907a02 26use Moose::Util;
d2782813 27use Class::MOP::MiniTrait;
8ee73eeb 28
c0e30cf5 29use base 'Class::MOP::Class';
30
d2782813 31Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
32
598340d5 33__PACKAGE__->meta->add_attribute('roles' => (
ef333f17 34 reader => 'roles',
35 default => sub { [] }
36));
37
a9b63d79 38__PACKAGE__->meta->add_attribute('role_applications' => (
639f9a1a 39 reader => '_get_role_applications',
a9b63d79 40 default => sub { [] }
41));
42
0fa70d03 43__PACKAGE__->meta->add_attribute(
44 Class::MOP::Attribute->new('immutable_trait' => (
45 accessor => "immutable_trait",
46 default => 'Moose::Meta::Class::Immutable::Trait',
47 ))
48);
49
e606ae5f 50__PACKAGE__->meta->add_attribute('constructor_class' => (
51 accessor => 'constructor_class',
e0001338 52 default => 'Moose::Meta::Method::Constructor',
e606ae5f 53));
54
55__PACKAGE__->meta->add_attribute('destructor_class' => (
56 accessor => 'destructor_class',
e0001338 57 default => 'Moose::Meta::Method::Destructor',
e606ae5f 58));
59
11c86f15 60__PACKAGE__->meta->add_attribute('error_class' => (
bf6fa6b3 61 accessor => 'error_class',
62 default => 'Moose::Error::Default',
11c86f15 63));
64
590868a3 65sub initialize {
66 my $class = shift;
67 my $pkg = shift;
d03bd989 68 return Class::MOP::get_metaclass_by_name($pkg)
685f7e44 69 || $class->SUPER::initialize($pkg,
70 'attribute_metaclass' => 'Moose::Meta::Attribute',
71 'method_metaclass' => 'Moose::Meta::Method',
72 'instance_metaclass' => 'Moose::Meta::Instance',
73 @_
d03bd989 74 );
ac2dc464 75}
590868a3 76
61bdd94f 77sub create {
7d4035ae 78 my ($class, $package_name, %options) = @_;
d03bd989 79
61bdd94f 80 (ref $options{roles} eq 'ARRAY')
7d4035ae 81 || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
61bdd94f 82 if exists $options{roles};
310ba883 83 my $roles = delete $options{roles};
dd37a5be 84
7d4035ae 85 my $new_meta = $class->SUPER::create($package_name, %options);
dd37a5be 86
310ba883 87 if ($roles) {
7d4035ae 88 Moose::Util::apply_all_roles( $new_meta, @$roles );
61bdd94f 89 }
d03bd989 90
7d4035ae 91 return $new_meta;
61bdd94f 92}
93
17594769 94my %ANON_CLASSES;
95
96sub create_anon_class {
97 my ($self, %options) = @_;
98
99 my $cache_ok = delete $options{cache};
d03bd989 100
cf600c83 101 my $cache_key
102 = _anon_cache_key( $options{superclasses}, $options{roles} );
d03bd989 103
6d5cbd2b 104 if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
17594769 105 return $ANON_CLASSES{$cache_key};
106 }
d03bd989 107
dcc8dc06 108 $options{weaken} = !$cache_ok
109 unless exists $options{weaken};
110
17594769 111 my $new_class = $self->SUPER::create_anon_class(%options);
112
dcc8dc06 113 if ($cache_ok) {
114 $ANON_CLASSES{$cache_key} = $new_class;
115 weaken($ANON_CLASSES{$cache_key});
116 }
17594769 117
118 return $new_class;
119}
120
699a2e32 121sub _meta_method_class { 'Moose::Meta::Method::Meta' }
122
cf600c83 123sub _anon_cache_key {
124 # Makes something like Super::Class|Super::Class::2=Role|Role::1
125 return join '=' => (
126 join( '|', @{ $_[0] || [] } ),
127 join( '|', sort @{ $_[1] || [] } ),
128 );
129}
130
131sub reinitialize {
132 my $self = shift;
133 my $pkg = shift;
134
135 my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
136
137 my $cache_key;
138
139 my %existing_classes;
140 if ($meta) {
141 %existing_classes = map { $_ => $meta->$_() } qw(
142 attribute_metaclass
143 method_metaclass
144 wrapped_method_metaclass
145 instance_metaclass
146 constructor_class
147 destructor_class
148 error_class
149 );
150
151 $cache_key = _anon_cache_key(
152 [ $meta->superclasses ],
153 [ map { $_->name } @{ $meta->roles } ],
154 ) if $meta->is_anon_class;
155 }
156
157 my $new_meta = $self->SUPER::reinitialize(
158 $pkg,
159 %existing_classes,
160 @_,
161 );
162
163 return $new_meta unless defined $cache_key;
164
165 my $new_cache_key = _anon_cache_key(
166 [ $meta->superclasses ],
167 [ map { $_->name } @{ $meta->roles } ],
168 );
169
170 delete $ANON_CLASSES{$cache_key};
171 $ANON_CLASSES{$new_cache_key} = $new_meta;
dcc8dc06 172 weaken($ANON_CLASSES{$new_cache_key});
cf600c83 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
e3225a0f 283sub _generate_fallback_constructor {
284 my $self = shift;
285 my ($class) = @_;
286 return $class . '->Moose::Object::new(@_)'
287}
288
289sub _inline_params {
290 my $self = shift;
291 my ($params, $class) = @_;
292 return (
293 'my ' . $params . ' = ',
294 $self->_inline_BUILDARGS($class, '@_'),
295 ';',
296 );
297}
298
299sub _inline_BUILDARGS {
300 my $self = shift;
301 my ($class, $args) = @_;
302
303 my $buildargs = $self->find_method_by_name("BUILDARGS");
304
305 if ($args eq '@_'
306 && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
307 return (
308 'do {',
309 'my $params;',
310 'if (scalar @_ == 1) {',
311 'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
312 $self->_inline_throw_error(
313 '"Single parameters to new() must be a HASH ref"',
314 'data => $_[0]',
315 ) . ';',
316 '}',
317 '$params = { %{ $_[0] } };',
318 '}',
319 'elsif (@_ % 2) {',
320 'Carp::carp(',
321 '"The new() method for ' . $class . ' expects a '
322 . 'hash reference or a key/value list. You passed an '
323 . 'odd number of arguments"',
324 ');',
325 '$params = {@_, undef};',
326 '}',
327 'else {',
328 '$params = {@_};',
329 '}',
330 '$params;',
331 '}',
332 );
333 }
334 else {
335 return $class . '->BUILDARGS(' . $args . ')';
336 }
337}
338
339sub _inline_slot_initializer {
340 my $self = shift;
ec86bdff 341 my ($attr, $idx) = @_;
e3225a0f 342
ec86bdff 343 return (
344 '## ' . $attr->name,
345 $self->_inline_check_required_attr($attr),
346 $self->SUPER::_inline_slot_initializer(@_),
347 );
e3225a0f 348}
349
350sub _inline_check_required_attr {
351 my $self = shift;
352 my ($attr) = @_;
353
354 return unless defined $attr->init_arg;
355 return unless $attr->can('is_required') && $attr->is_required;
356 return if $attr->has_default || $attr->has_builder;
357
358 return (
359 'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
360 $self->_inline_throw_error(
361 '"Attribute (' . quotemeta($attr->name) . ') is required"'
362 ) . ';',
363 '}',
364 );
365}
366
7106ce79 367# XXX: these two are duplicated from cmop, because we have to pass the tc stuff
368# through to _inline_set_value - this should probably be fixed, but i'm not
369# quite sure how. -doy
e3225a0f 370sub _inline_init_attr_from_constructor {
371 my $self = shift;
ec86bdff 372 my ($attr, $idx) = @_;
373
374 my @initial_value = $attr->_inline_set_value(
375 '$instance',
376 '$params->{\'' . $attr->init_arg . '\'}',
377 '$type_constraint_bodies[' . $idx . ']',
378 '$type_constraints[' . $idx . ']',
379 'for constructor',
e3225a0f 380 );
381
ec86bdff 382 push @initial_value, (
383 '$attrs->[' . $idx . ']->set_initial_value(',
384 '$instance,',
385 $attr->_inline_instance_get('$instance'),
386 ');',
387 ) if $attr->has_initializer;
e3225a0f 388
ec86bdff 389 return @initial_value;
e3225a0f 390}
391
ec86bdff 392sub _inline_init_attr_from_default {
e3225a0f 393 my $self = shift;
ec86bdff 394 my ($attr, $idx) = @_;
e3225a0f 395
ec86bdff 396 my $default = $self->_inline_default_value($attr, $idx);
397 return unless $default;
e3225a0f 398
ec86bdff 399 my @initial_value = (
400 'my $default = ' . $default . ';',
401 $attr->_inline_set_value(
402 '$instance',
403 '$default',
404 '$type_constraint_bodies[' . $idx . ']',
405 '$type_constraints[' . $idx . ']',
406 'for constructor',
407 ),
e3225a0f 408 );
409
ec86bdff 410 push @initial_value, (
411 '$attrs->[' . $idx . ']->set_initial_value(',
412 '$instance,',
413 $attr->_inline_instance_get('$instance'),
414 ');',
415 ) if $attr->has_initializer;
e3225a0f 416
ec86bdff 417 return @initial_value;
e3225a0f 418}
419
420sub _inline_extra_init {
421 my $self = shift;
422 return (
423 $self->_inline_triggers,
424 $self->_inline_BUILDALL,
425 );
426}
427
428sub _inline_triggers {
429 my $self = shift;
430 my @trigger_calls;
431
ec86bdff 432 my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
e3225a0f 433 for my $i (0 .. $#attrs) {
434 my $attr = $attrs[$i];
435
436 next unless $attr->can('has_trigger') && $attr->has_trigger;
437
438 my $init_arg = $attr->init_arg;
439 next unless defined $init_arg;
440
441 push @trigger_calls,
442 'if (exists $params->{\'' . $init_arg . '\'}) {',
443 '$attrs->[' . $i . ']->trigger->(',
444 '$instance,',
445 $attr->_inline_instance_get('$instance') . ',',
446 ');',
447 '}';
448 }
449
450 return @trigger_calls;
451}
452
453sub _inline_BUILDALL {
454 my $self = shift;
455
456 my @methods = reverse $self->find_all_methods_by_name('BUILD');
457 my @BUILD_calls;
458
459 foreach my $method (@methods) {
460 push @BUILD_calls,
461 '$instance->' . $method->{class} . '::BUILD($params);';
462 }
463
464 return @BUILD_calls;
465}
466
e2eef3a5 467sub superclasses {
468 my $self = shift;
2e7f6cf4 469 my $supers = Data::OptList::mkopt(\@_);
470 foreach my $super (@{ $supers }) {
471 my ($name, $opts) = @{ $super };
472 Class::MOP::load_class($name, $opts);
473 my $meta = Class::MOP::class_of($name);
474 $self->throw_error("You cannot inherit from a Moose Role ($name)")
e2eef3a5 475 if $meta && $meta->isa('Moose::Meta::Role')
476 }
2e7f6cf4 477 return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
e2eef3a5 478}
479
093b12c2 480### ---------------------------------------------
481
a2eec5e7 482sub add_attribute {
483 my $self = shift;
28af3424 484 my $attr =
e472c9a5 485 (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
d03bd989 486 ? $_[0]
28af3424 487 : $self->_process_attribute(@_));
488 $self->SUPER::add_attribute($attr);
489 # it may be a Class::MOP::Attribute, theoretically, which doesn't have
490 # 'bare' and doesn't implement this method
9340e346 491 if ($attr->can('_check_associated_methods')) {
492 $attr->_check_associated_methods;
28af3424 493 }
494 return $attr;
a2eec5e7 495}
496
78cd1d3b 497sub add_override_method_modifier {
498 my ($self, $name, $method, $_super_package) = @_;
18c2ec0e 499
d05cd563 500 (!$self->has_method($name))
11c86f15 501 || $self->throw_error("Cannot add an override method if a local method is already present");
18c2ec0e 502
74862722 503 $self->add_method($name => Moose::Meta::Method::Overridden->new(
3f9e4b0a 504 method => $method,
505 class => $self,
506 package => $_super_package, # need this for roles
507 name => $name,
18c2ec0e 508 ));
78cd1d3b 509}
510
511sub add_augment_method_modifier {
ac2dc464 512 my ($self, $name, $method) = @_;
d05cd563 513 (!$self->has_method($name))
11c86f15 514 || $self->throw_error("Cannot add an augment method if a local method is already present");
3f9e4b0a 515
516 $self->add_method($name => Moose::Meta::Method::Augmented->new(
517 method => $method,
518 class => $self,
519 name => $name,
520 ));
78cd1d3b 521}
522
1341f10c 523## Private Utility methods ...
524
05d9eaf6 525sub _find_next_method_by_name_which_is_not_overridden {
526 my ($self, $name) = @_;
68efb014 527 foreach my $method ($self->find_all_methods_by_name($name)) {
ac2dc464 528 return $method->{code}
74862722 529 if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
05d9eaf6 530 }
531 return undef;
532}
533
f6df97ae 534## Metaclass compatibility
f8b6827f 535
f6df97ae 536sub _base_metaclasses {
537 my $self = shift;
538 my %metaclasses = $self->SUPER::_base_metaclasses;
539 for my $class (keys %metaclasses) {
540 $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
1341f10c 541 }
f6df97ae 542 return (
543 %metaclasses,
544 error_class => 'Moose::Error::Default',
f8b6827f 545 );
f8b6827f 546}
547
f6df97ae 548sub _fix_class_metaclass_incompatibility {
549 my $self = shift;
550 my ($super_meta) = @_;
f8b6827f 551
f6df97ae 552 $self->SUPER::_fix_class_metaclass_incompatibility(@_);
f8b6827f 553
88f2e008 554 if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
590e8894 555 ($self->is_pristine)
556 || confess "Can't fix metaclass incompatibility for "
557 . $self->name
558 . " because it is not pristine.";
a907317a 559 my $super_meta_name = $super_meta->_real_ref_name;
61907a02 560 my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
8450b001 561 my $new_self = $class_meta_subclass_meta_name->reinitialize(
cf7febc7 562 $self->name,
563 );
6a52b083 564
8450b001 565 $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
f8b6827f 566 }
f6df97ae 567}
f8b6827f 568
f6df97ae 569sub _fix_single_metaclass_incompatibility {
570 my $self = shift;
571 my ($metaclass_type, $super_meta) = @_;
f8b6827f 572
f6df97ae 573 $self->SUPER::_fix_single_metaclass_incompatibility(@_);
f8b6827f 574
88f2e008 575 if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
590e8894 576 ($self->is_pristine)
577 || confess "Can't fix metaclass incompatibility for "
578 . $self->name
579 . " because it is not pristine.";
7f6c8567 580 my $super_meta_name = $super_meta->_real_ref_name;
61907a02 581 my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
cf7febc7 582 my $new_self = $super_meta->reinitialize(
583 $self->name,
8450b001 584 $metaclass_type => $class_specific_meta_subclass_meta_name,
cf7febc7 585 );
6a52b083 586
7f6c8567 587 $self->_replace_self( $new_self, $super_meta_name );
f6df97ae 588 }
f8b6827f 589}
590
6a52b083 591sub _replace_self {
592 my $self = shift;
593 my ( $new_self, $new_class) = @_;
594
595 %$self = %$new_self;
596 bless $self, $new_class;
597
598 # We need to replace the cached metaclass instance or else when it goes
599 # out of scope Class::MOP::Class destroy's the namespace for the
600 # metaclass's class, causing much havoc.
dcc8dc06 601 my $weaken = Class::MOP::metaclass_is_weak( $self->name );
6a52b083 602 Class::MOP::store_metaclass_by_name( $self->name, $self );
dcc8dc06 603 Class::MOP::weaken_metaclass( $self->name ) if $weaken;
6a52b083 604}
605
1341f10c 606sub _process_attribute {
a3738e5b 607 my ( $self, $name, @args ) = @_;
7e59b803 608
609 @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
d9bb6c63 610
f9b5f5f8 611 if (($name || '') =~ /^\+(.*)/) {
7e59b803 612 return $self->_process_inherited_attribute($1, @args);
1341f10c 613 }
614 else {
7e59b803 615 return $self->_process_new_attribute($name, @args);
616 }
617}
618
619sub _process_new_attribute {
620 my ( $self, $name, @args ) = @_;
7e59b803 621
d5c30e52 622 $self->attribute_metaclass->interpolate_class_and_new($name, @args);
1341f10c 623}
624
625sub _process_inherited_attribute {
626 my ($self, $attr_name, %options) = @_;
627 my $inherited_attr = $self->find_attribute_by_name($attr_name);
628 (defined $inherited_attr)
329c5dd4 629 || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
1341f10c 630 if ($inherited_attr->isa('Moose::Meta::Attribute')) {
d7d8a8c7 631 return $inherited_attr->clone_and_inherit_options(%options);
1341f10c 632 }
633 else {
634 # NOTE:
635 # kind of a kludge to handle Class::MOP::Attributes
d7d8a8c7 636 return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
ac2dc464 637 }
1341f10c 638}
639
948cd189 640## Immutability
641
642sub _immutable_options {
643 my ( $self, @args ) = @_;
644
645 $self->SUPER::_immutable_options(
646 inline_destructor => 1,
948cd189 647
648 # Moose always does this when an attribute is created
649 inline_accessors => 0,
650
651 @args,
652 );
653}
654
5cf3dbcf 655## -------------------------------------------------
656
bf6fa6b3 657our $error_level;
11c86f15 658
659sub throw_error {
660 my ( $self, @args ) = @_;
bf6fa6b3 661 local $error_level = ($error_level || 0) + 1;
11c86f15 662 $self->raise_error($self->create_error(@args));
663}
664
e3225a0f 665sub _inline_throw_error {
666 my ( $self, $msg, $args ) = @_;
667 "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
668}
669
11c86f15 670sub raise_error {
671 my ( $self, @args ) = @_;
672 die @args;
673}
674
675sub create_error {
676 my ( $self, @args ) = @_;
677
18748ad6 678 require Carp::Heavy;
679
bf6fa6b3 680 local $error_level = ($error_level || 0 ) + 1;
18748ad6 681
11c86f15 682 if ( @args % 2 == 1 ) {
683 unshift @args, "message";
684 }
685
fcab1742 686 my %args = ( metaclass => $self, last_error => $@, @args );
11c86f15 687
bf6fa6b3 688 $args{depth} += $error_level;
11c86f15 689
bf6fa6b3 690 my $class = ref $self ? $self->error_class : "Moose::Error::Default";
11c86f15 691
a810a01f 692 Class::MOP::load_class($class);
693
11c86f15 694 $class->new(
bf6fa6b3 695 Carp::caller_info($args{depth}),
696 %args
11c86f15 697 );
698}
699
c0e30cf5 7001;
701
702__END__
703
704=pod
705
706=head1 NAME
707
e522431d 708Moose::Meta::Class - The Moose metaclass
c0e30cf5 709
c0e30cf5 710=head1 DESCRIPTION
711
70bb0f97 712This class is a subclass of L<Class::MOP::Class> that provides
713additional Moose-specific functionality.
e522431d 714
7854b409 715To really understand this class, you will need to start with the
716L<Class::MOP::Class> documentation. This class can be understood as a
717set of additional features on top of the basic feature provided by
718that parent class.
6ba6d68c 719
d4b1449e 720=head1 INHERITANCE
721
722C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
723
c0e30cf5 724=head1 METHODS
725
726=over 4
727
70bb0f97 728=item B<< Moose::Meta::Class->initialize($package_name, %options) >>
590868a3 729
70bb0f97 730This overrides the parent's method in order to provide its own
731defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
732C<method_metaclass> options.
61bdd94f 733
70bb0f97 734These all default to the appropriate Moose class.
61bdd94f 735
70bb0f97 736=item B<< Moose::Meta::Class->create($package_name, %options) >>
17594769 737
70bb0f97 738This overrides the parent's method in order to accept a C<roles>
9e25a72a 739option. This should be an array reference containing roles
740that the class does, each optionally followed by a hashref of options
741(C<-excludes> and C<-alias>).
17594769 742
70bb0f97 743 my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
17594769 744
70bb0f97 745=item B<< Moose::Meta::Class->create_anon_class >>
17594769 746
70bb0f97 747This overrides the parent's method to accept a C<roles> option, just
748as C<create> does.
5cf3dbcf 749
70bb0f97 750It also accepts a C<cache> option. If this is true, then the anonymous
751class will be cached based on its superclasses and roles. If an
752existing anonymous class in the cache has the same superclasses and
753roles, it will be reused.
ac2dc464 754
70bb0f97 755 my $metaclass = Moose::Meta::Class->create_anon_class(
756 superclasses => ['Foo'],
757 roles => [qw/Some Roles Go Here/],
758 cache => 1,
759 );
ac2dc464 760
2e7f6cf4 761Each entry in both the C<superclasses> and the C<roles> option can be
b2d54db8 762followed by a hash reference with arguments. The C<superclasses>
2e7f6cf4 763option can be supplied with a L<-version|Class::MOP/Class Loading
764Options> option that ensures the loaded superclass satisfies the
765required version. The C<role> option also takes the C<-version> as an
766argument, but the option hash reference can also contain any other
767role relevant values like exclusions or parameterized role arguments.
768
70bb0f97 769=item B<< $metaclass->make_immutable(%options) >>
ac2dc464 770
70bb0f97 771This overrides the parent's method to add a few options. Specifically,
772it uses the Moose-specific constructor and destructor classes, and
773enables inlining the destructor.
8c9d74e7 774
dcdceb38 775Since Moose always inlines attributes, it sets the C<inline_accessors> option
776to false.
777
70bb0f97 778=item B<< $metaclass->new_object(%params) >>
a15dff8d 779
70bb0f97 780This overrides the parent's method in order to add support for
781attribute triggers.
6ba6d68c 782
2e7f6cf4 783=item B<< $metaclass->superclasses(@superclasses) >>
784
6b958a3e 785This is the accessor allowing you to read or change the parents of
2e7f6cf4 786the class.
787
788Each superclass can be followed by a hash reference containing a
789L<-version|Class::MOP/Class Loading Options> value. If the version
790requirement is not satisfied an error will be thrown.
791
70bb0f97 792=item B<< $metaclass->add_override_method_modifier($name, $sub) >>
ef1d5f4b 793
70bb0f97 794This adds an C<override> method modifier to the package.
e9ec68d6 795
70bb0f97 796=item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
e9ec68d6 797
70bb0f97 798This adds an C<augment> method modifier to the package.
78cd1d3b 799
70bb0f97 800=item B<< $metaclass->calculate_all_roles >>
02a0fb52 801
70bb0f97 802This will return a unique array of C<Moose::Meta::Role> instances
803which are attached to this class.
78cd1d3b 804
9f83eb5d 805=item B<< $metaclass->calculate_all_roles_with_inheritance >>
806
807This will return a unique array of C<Moose::Meta::Role> instances
808which are attached to this class, and each of this class's ancestors.
809
70bb0f97 810=item B<< $metaclass->add_role($role) >>
02a0fb52 811
70bb0f97 812This takes a L<Moose::Meta::Role> object, and adds it to the class's
813list of roles. This I<does not> actually apply the role to the class.
2b14ac61 814
b90dd4ef 815=item B<< $metaclass->role_applications >>
816
639f9a1a 817Returns a list of L<Moose::Meta::Role::Application::ToClass>
b90dd4ef 818objects, which contain the arguments to role application.
819
820=item B<< $metaclass->add_role_application($application) >>
821
822This takes a L<Moose::Meta::Role::Application::ToClass> object, and
823adds it to the class's list of role applications. This I<does not>
824actually apply any role to the class; it is only for tracking role
825applications.
826
560c498d 827=item B<< $metaclass->does_role($role) >>
ef333f17 828
560c498d 829This returns a boolean indicating whether or not the class does the specified
830role. The role provided can be either a role name or a L<Moose::Meta::Role>
831object. This tests both the class and its parents.
02a0fb52 832
70bb0f97 833=item B<< $metaclass->excludes_role($role_name) >>
ef333f17 834
70bb0f97 835A class excludes a role if it has already composed a role which
836excludes the named role. This tests both the class and its parents.
02a0fb52 837
70bb0f97 838=item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
ef333f17 839
70bb0f97 840This overrides the parent's method in order to allow the parameters to
841be provided as a hash reference.
02a0fb52 842
9f9fdd08 843=item B<< $metaclass->constructor_class($class_name) >>
d79e62fd 844
9f9fdd08 845=item B<< $metaclass->destructor_class($class_name) >>
e606ae5f 846
948cd189 847These are the names of classes used when making a class immutable. These
90a49845 848default to L<Moose::Meta::Method::Constructor> and
849L<Moose::Meta::Method::Destructor> respectively. These accessors are
850read-write, so you can use them to change the class name.
e606ae5f 851
70bb0f97 852=item B<< $metaclass->error_class($class_name) >>
8b1d510f 853
70bb0f97 854The name of the class used to throw errors. This defaults to
8b1d510f 855L<Moose::Error::Default>, which generates an error with a stacktrace
856just like C<Carp::confess>.
857
70bb0f97 858=item B<< $metaclass->throw_error($message, %extra) >>
11c86f15 859
860Throws the error created by C<create_error> using C<raise_error>
861
c0e30cf5 862=back
863
864=head1 BUGS
865
d4048ef3 866See L<Moose/BUGS> for details on reporting bugs.
c0e30cf5 867
c0e30cf5 868=head1 AUTHOR
869
870Stevan Little E<lt>stevan@iinteractive.comE<gt>
871
872=head1 COPYRIGHT AND LICENSE
873
7e0492d3 874Copyright 2006-2010 by Infinity Interactive, Inc.
c0e30cf5 875
876L<http://www.iinteractive.com>
877
878This library is free software; you can redistribute it and/or modify
ac2dc464 879it under the same terms as Perl itself.
c0e30cf5 880
8a7a9c53 881=cut
1a563243 882