7e1788aa21f2b7d69e12707c9fb4e29398ac4e93
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
1
2 package Moose::Meta::Class;
3
4 use strict;
5 use warnings;
6
7 use Class::MOP;
8
9 use Carp qw( confess );
10 use Data::OptList;
11 use List::Util qw( first );
12 use List::MoreUtils qw( any all uniq first_index );
13 use Scalar::Util 'weaken', 'blessed';
14
15 our $VERSION   = '1.12';
16 $VERSION = eval $VERSION;
17 our $AUTHORITY = 'cpan:STEVAN';
18
19 use Moose::Meta::Method::Overridden;
20 use Moose::Meta::Method::Augmented;
21 use Moose::Error::Default;
22 use Moose::Meta::Class::Immutable::Trait;
23 use Moose::Meta::Method::Constructor;
24 use Moose::Meta::Method::Destructor;
25
26 use base 'Class::MOP::Class';
27
28 __PACKAGE__->meta->add_attribute('roles' => (
29     reader  => 'roles',
30     default => sub { [] }
31 ));
32
33 __PACKAGE__->meta->add_attribute('role_applications' => (
34     reader  => '_get_role_applications',
35     default => sub { [] }
36 ));
37
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
45 __PACKAGE__->meta->add_attribute('constructor_class' => (
46     accessor => 'constructor_class',
47     default  => 'Moose::Meta::Method::Constructor',
48 ));
49
50 __PACKAGE__->meta->add_attribute('destructor_class' => (
51     accessor => 'destructor_class',
52     default  => 'Moose::Meta::Method::Destructor',
53 ));
54
55 __PACKAGE__->meta->add_attribute('error_class' => (
56     accessor => 'error_class',
57     default  => 'Moose::Error::Default',
58 ));
59
60 sub initialize {
61     my $class = shift;
62     my $pkg   = shift;
63     return Class::MOP::get_metaclass_by_name($pkg)
64         || $class->SUPER::initialize($pkg,
65                 'attribute_metaclass' => 'Moose::Meta::Attribute',
66                 'method_metaclass'    => 'Moose::Meta::Method',
67                 'instance_metaclass'  => 'Moose::Meta::Instance',
68                 @_
69             );
70 }
71
72 sub _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
85 sub create {
86     my ($class, $package_name, %options) = @_;
87
88     (ref $options{roles} eq 'ARRAY')
89         || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
90             if exists $options{roles};
91     my $roles = delete $options{roles};
92
93     my $new_meta = $class->SUPER::create($package_name, %options);
94
95     if ($roles) {
96         Moose::Util::apply_all_roles( $new_meta, @$roles );
97     }
98
99     return $new_meta;
100 }
101
102 my %ANON_CLASSES;
103
104 sub create_anon_class {
105     my ($self, %options) = @_;
106
107     my $cache_ok = delete $options{cache};
108
109     my $cache_key
110         = _anon_cache_key( $options{superclasses}, $options{roles} );
111
112     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
113         return $ANON_CLASSES{$cache_key};
114     }
115
116     my $new_class = $self->SUPER::create_anon_class(%options);
117
118     $ANON_CLASSES{$cache_key} = $new_class
119         if $cache_ok;
120
121     return $new_class;
122 }
123
124 sub _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
132 sub 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
177 sub add_role {
178     my ($self, $role) = @_;
179     (blessed($role) && $role->isa('Moose::Meta::Role'))
180         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
181     push @{$self->roles} => $role;
182 }
183
184 sub role_applications {
185     my ($self) = @_;
186
187     return @{$self->_get_role_applications};
188 }
189
190 sub 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);
194     push @{$self->_get_role_applications} => $application;
195 }
196
197 sub calculate_all_roles {
198     my $self = shift;
199     my %seen;
200     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
201 }
202
203 sub 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
213 sub does_role {
214     my ($self, $role_name) = @_;
215
216     (defined $role_name)
217         || $self->throw_error("You must supply a role name to look for");
218
219     foreach my $class ($self->class_precedence_list) {
220         my $meta = Class::MOP::class_of($class);
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.
225         next unless $meta && $meta->can('roles');
226         foreach my $role (@{$meta->roles}) {
227             return 1 if $role->does_role($role_name);
228         }
229     }
230     return 0;
231 }
232
233 sub excludes_role {
234     my ($self, $role_name) = @_;
235
236     (defined $role_name)
237         || $self->throw_error("You must supply a role name to look for");
238
239     foreach my $class ($self->class_precedence_list) {
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}) {
247             return 1 if $role->excludes_role($role_name);
248         }
249     }
250     return 0;
251 }
252
253 sub new_object {
254     my $self   = shift;
255     my $params = @_ == 1 ? $_[0] : {@_};
256     my $object = $self->SUPER::new_object($params);
257
258     foreach my $attr ( $self->get_all_attributes() ) {
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->(
269             $object,
270             (
271                   $attr->should_coerce
272                 ? $attr->get_read_method_ref->($object)
273                 : $params->{$init_arg}
274             ),
275         );
276     }
277
278     $object->BUILDALL($params) if $object->can('BUILDALL');
279
280     return $object;
281 }
282
283 sub superclasses {
284     my $self = shift;
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)")
291             if $meta && $meta->isa('Moose::Meta::Role')
292     }
293     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
294 }
295
296 ### ---------------------------------------------
297
298 sub add_attribute {
299     my $self = shift;
300     my $attr =
301         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
302             ? $_[0]
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
307     if ($attr->can('_check_associated_methods')) {
308         $attr->_check_associated_methods;
309     }
310     return $attr;
311 }
312
313 sub add_override_method_modifier {
314     my ($self, $name, $method, $_super_package) = @_;
315
316     (!$self->has_method($name))
317         || $self->throw_error("Cannot add an override method if a local method is already present");
318
319     $self->add_method($name => Moose::Meta::Method::Overridden->new(
320         method  => $method,
321         class   => $self,
322         package => $_super_package, # need this for roles
323         name    => $name,
324     ));
325 }
326
327 sub add_augment_method_modifier {
328     my ($self, $name, $method) = @_;
329     (!$self->has_method($name))
330         || $self->throw_error("Cannot add an augment method if a local method is already present");
331
332     $self->add_method($name => Moose::Meta::Method::Augmented->new(
333         method  => $method,
334         class   => $self,
335         name    => $name,
336     ));
337 }
338
339 ## Private Utility methods ...
340
341 sub _find_next_method_by_name_which_is_not_overridden {
342     my ($self, $name) = @_;
343     foreach my $method ($self->find_all_methods_by_name($name)) {
344         return $method->{code}
345             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
346     }
347     return undef;
348 }
349
350 ## Metaclass compatibility
351
352 sub _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/;
357     }
358     return (
359         %metaclasses,
360         error_class => 'Moose::Error::Default',
361     );
362 }
363
364 sub _find_common_base {
365     my $self = shift;
366     my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
367     return unless defined $meta1 && defined $meta2;
368
369     # FIXME? This doesn't account for multiple inheritance (not sure
370     # if it needs to though). For example, if somewhere in $meta1's
371     # history it inherits from both ClassA and ClassB, and $meta2
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
380 sub _get_ancestors_until {
381     my $self = shift;
382     my ($start_name, $until_name) = @_;
383
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;
388     }
389     return @ancestor_names;
390 }
391
392 sub _is_role_only_subclass {
393     my $self = shift;
394     my ($meta_name) = @_;
395     my $meta = Class::MOP::Class->initialize($meta_name);
396     my @parent_names = $meta->superclasses;
397
398     # XXX: don't feel like messing with multiple inheritance here... what would
399     # that even do?
400     return unless @parent_names == 1;
401     my ($parent_name) = @parent_names;
402     my $parent_meta = Class::MOP::Class->initialize($parent_name);
403
404     my @roles = $meta->can('calculate_all_roles_with_inheritance')
405                     ? $meta->calculate_all_roles_with_inheritance
406                     : ();
407
408     # loop over all methods that are a part of the current class
409     # (not inherited)
410     for my $method ( $meta->_get_local_methods ) {
411         # always ignore meta
412         next if $method->name eq 'meta';
413         # we'll deal with attributes below
414         next if $method->can('associated_attribute');
415         # if the method comes from a role we consumed, ignore it
416         next if $meta->can('does_role')
417              && $meta->does_role($method->original_package_name);
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                 );
430
431         return 0;
432     }
433
434     # loop over all attributes that are a part of the current class
435     # (not inherited)
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.
439     for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
440         next if any { $_->has_attribute($attr->name) } @roles;
441
442         return 0;
443     }
444
445     return 1;
446 }
447
448 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
449     my $self = shift;
450     my ($super_meta) = @_;
451
452     my $super_meta_name = $super_meta->_real_ref_name;
453
454     return $self->_classes_differ_by_roles_only(
455         blessed($self),
456         $super_meta_name,
457         'Moose::Meta::Class',
458     );
459 }
460
461 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
462     my $self = shift;
463     my ($metaclass_type, $super_meta) = @_;
464
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;
468     my %metaclasses = $self->_base_metaclasses;
469
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
477 sub _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.
488     return unless defined $common_base_name;
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;
500
501     return 1;
502 }
503
504 sub _role_differences {
505     my $self = shift;
506     my ($class_meta_name, $super_meta_name) = @_;
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
509                          : ();
510     my @role_metas       = $class_meta_name->meta->can('calculate_all_roles_with_inheritance')
511                          ? $class_meta_name->meta->calculate_all_roles_with_inheritance
512                          : ();
513     my @differences;
514     for my $role_meta (@role_metas) {
515         push @differences, $role_meta
516             unless any { $_->name eq $role_meta->name } @super_role_metas;
517     }
518     return @differences;
519 }
520
521 sub _reconcile_roles_for_metaclass {
522     my $self = shift;
523     my ($class_meta_name, $super_meta_name) = @_;
524
525     my @role_differences = $self->_role_differences(
526         $class_meta_name, $super_meta_name,
527     );
528
529     # handle the case where we need to fix compatibility between a class and
530     # its parent, but all roles in the class are already also done by the
531     # parent
532     # see t/050/054.t
533     return Class::MOP::class_of($super_meta_name)
534         unless @role_differences;
535
536     return Moose::Meta::Class->create_anon_class(
537         superclasses => [$super_meta_name],
538         roles        => \@role_differences,
539         cache        => 1,
540     );
541 }
542
543 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
544     my $self = shift;
545     my ($super_meta) = @_;
546
547     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
548
549     my %base_metaclass = $self->_base_metaclasses;
550     for my $metaclass_type (keys %base_metaclass) {
551         next unless defined $self->$metaclass_type;
552         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
553     }
554
555     return;
556 }
557
558 sub _can_fix_metaclass_incompatibility {
559     my $self = shift;
560     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
561     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
562 }
563
564 sub _fix_class_metaclass_incompatibility {
565     my $self = shift;
566     my ($super_meta) = @_;
567
568     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
569
570     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
571         ($self->is_pristine)
572             || confess "Can't fix metaclass incompatibility for "
573                      . $self->name
574                      . " because it is not pristine.";
575         my $super_meta_name = $super_meta->_real_ref_name;
576         my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
577         my $new_self = $class_meta_subclass_meta->name->reinitialize(
578             $self->name,
579         );
580
581         $self->_replace_self( $new_self, $class_meta_subclass_meta->name );
582     }
583 }
584
585 sub _fix_single_metaclass_incompatibility {
586     my $self = shift;
587     my ($metaclass_type, $super_meta) = @_;
588
589     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
590
591     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
592         ($self->is_pristine)
593             || confess "Can't fix metaclass incompatibility for "
594                      . $self->name
595                      . " because it is not pristine.";
596         my $super_meta_name = $super_meta->_real_ref_name;
597         my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
598         my $new_self = $super_meta->reinitialize(
599             $self->name,
600             $metaclass_type => $class_specific_meta_subclass_meta->name,
601         );
602
603         $self->_replace_self( $new_self, $super_meta_name );
604     }
605 }
606
607
608 sub _replace_self {
609     my $self      = shift;
610     my ( $new_self, $new_class)   = @_;
611
612     %$self = %$new_self;
613     bless $self, $new_class;
614
615     # We need to replace the cached metaclass instance or else when it goes
616     # out of scope Class::MOP::Class destroy's the namespace for the
617     # metaclass's class, causing much havoc.
618     Class::MOP::store_metaclass_by_name( $self->name, $self );
619     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
620 }
621
622 sub _process_attribute {
623     my ( $self, $name, @args ) = @_;
624
625     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
626
627     if (($name || '') =~ /^\+(.*)/) {
628         return $self->_process_inherited_attribute($1, @args);
629     }
630     else {
631         return $self->_process_new_attribute($name, @args);
632     }
633 }
634
635 sub _process_new_attribute {
636     my ( $self, $name, @args ) = @_;
637
638     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
639 }
640
641 sub _process_inherited_attribute {
642     my ($self, $attr_name, %options) = @_;
643     my $inherited_attr = $self->find_attribute_by_name($attr_name);
644     (defined $inherited_attr)
645         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
646     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
647         return $inherited_attr->clone_and_inherit_options(%options);
648     }
649     else {
650         # NOTE:
651         # kind of a kludge to handle Class::MOP::Attributes
652         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
653     }
654 }
655
656 ## -------------------------------------------------
657
658 our $error_level;
659
660 sub throw_error {
661     my ( $self, @args ) = @_;
662     local $error_level = ($error_level || 0) + 1;
663     $self->raise_error($self->create_error(@args));
664 }
665
666 sub raise_error {
667     my ( $self, @args ) = @_;
668     die @args;
669 }
670
671 sub create_error {
672     my ( $self, @args ) = @_;
673
674     require Carp::Heavy;
675
676     local $error_level = ($error_level || 0 ) + 1;
677
678     if ( @args % 2 == 1 ) {
679         unshift @args, "message";
680     }
681
682     my %args = ( metaclass => $self, last_error => $@, @args );
683
684     $args{depth} += $error_level;
685
686     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
687
688     Class::MOP::load_class($class);
689
690     $class->new(
691         Carp::caller_info($args{depth}),
692         %args
693     );
694 }
695
696 1;
697
698 __END__
699
700 =pod
701
702 =head1 NAME
703
704 Moose::Meta::Class - The Moose metaclass
705
706 =head1 DESCRIPTION
707
708 This class is a subclass of L<Class::MOP::Class> that provides
709 additional Moose-specific functionality.
710
711 To really understand this class, you will need to start with the
712 L<Class::MOP::Class> documentation. This class can be understood as a
713 set of additional features on top of the basic feature provided by
714 that parent class.
715
716 =head1 INHERITANCE
717
718 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
719
720 =head1 METHODS
721
722 =over 4
723
724 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
725
726 This overrides the parent's method in order to provide its own
727 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
728 C<method_metaclass> options.
729
730 These all default to the appropriate Moose class.
731
732 =item B<< Moose::Meta::Class->create($package_name, %options) >>
733
734 This overrides the parent's method in order to accept a C<roles>
735 option. This should be an array reference containing roles
736 that the class does, each optionally followed by a hashref of options
737 (C<-excludes> and C<-alias>).
738
739   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
740
741 =item B<< Moose::Meta::Class->create_anon_class >>
742
743 This overrides the parent's method to accept a C<roles> option, just
744 as C<create> does.
745
746 It also accepts a C<cache> option. If this is true, then the anonymous
747 class will be cached based on its superclasses and roles. If an
748 existing anonymous class in the cache has the same superclasses and
749 roles, it will be reused.
750
751   my $metaclass = Moose::Meta::Class->create_anon_class(
752       superclasses => ['Foo'],
753       roles        => [qw/Some Roles Go Here/],
754       cache        => 1,
755   );
756
757 Each entry in both the C<superclasses> and the C<roles> option can be
758 followed by a hash reference with arguments. The C<superclasses>
759 option can be supplied with a L<-version|Class::MOP/Class Loading
760 Options> option that ensures the loaded superclass satisfies the
761 required version. The C<role> option also takes the C<-version> as an
762 argument, but the option hash reference can also contain any other
763 role relevant values like exclusions or parameterized role arguments.
764
765 =item B<< $metaclass->make_immutable(%options) >>
766
767 This overrides the parent's method to add a few options. Specifically,
768 it uses the Moose-specific constructor and destructor classes, and
769 enables inlining the destructor.
770
771 Also, since Moose always inlines attributes, it sets the
772 C<inline_accessors> option to false.
773
774 =item B<< $metaclass->new_object(%params) >>
775
776 This overrides the parent's method in order to add support for
777 attribute triggers.
778
779 =item B<< $metaclass->superclasses(@superclasses) >>
780
781 This is the accessor allowing you to read or change the parents of
782 the class.
783
784 Each superclass can be followed by a hash reference containing a
785 L<-version|Class::MOP/Class Loading Options> value. If the version
786 requirement is not satisfied an error will be thrown.
787
788 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
789
790 This adds an C<override> method modifier to the package.
791
792 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
793
794 This adds an C<augment> method modifier to the package.
795
796 =item B<< $metaclass->calculate_all_roles >>
797
798 This will return a unique array of C<Moose::Meta::Role> instances
799 which are attached to this class.
800
801 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
802
803 This will return a unique array of C<Moose::Meta::Role> instances
804 which are attached to this class, and each of this class's ancestors.
805
806 =item B<< $metaclass->add_role($role) >>
807
808 This takes a L<Moose::Meta::Role> object, and adds it to the class's
809 list of roles. This I<does not> actually apply the role to the class.
810
811 =item B<< $metaclass->role_applications >>
812
813 Returns a list of L<Moose::Meta::Role::Application::ToClass>
814 objects, which contain the arguments to role application.
815
816 =item B<< $metaclass->add_role_application($application) >>
817
818 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
819 adds it to the class's list of role applications. This I<does not>
820 actually apply any role to the class; it is only for tracking role
821 applications.
822
823 =item B<< $metaclass->does_role($role) >>
824
825 This returns a boolean indicating whether or not the class does the specified
826 role. The role provided can be either a role name or a L<Moose::Meta::Role>
827 object. This tests both the class and its parents.
828
829 =item B<< $metaclass->excludes_role($role_name) >>
830
831 A class excludes a role if it has already composed a role which
832 excludes the named role. This tests both the class and its parents.
833
834 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
835
836 This overrides the parent's method in order to allow the parameters to
837 be provided as a hash reference.
838
839 =item B<< $metaclass->constructor_class($class_name) >>
840
841 =item B<< $metaclass->destructor_class($class_name) >>
842
843 These are the names of classes used when making a class
844 immutable. These default to L<Moose::Meta::Method::Constructor> and
845 L<Moose::Meta::Method::Destructor> respectively. These accessors are
846 read-write, so you can use them to change the class name.
847
848 =item B<< $metaclass->error_class($class_name) >>
849
850 The name of the class used to throw errors. This defaults to
851 L<Moose::Error::Default>, which generates an error with a stacktrace
852 just like C<Carp::confess>.
853
854 =item B<< $metaclass->throw_error($message, %extra) >>
855
856 Throws the error created by C<create_error> using C<raise_error>
857
858 =back
859
860 =head1 BUGS
861
862 See L<Moose/BUGS> for details on reporting bugs.
863
864 =head1 AUTHOR
865
866 Stevan Little E<lt>stevan@iinteractive.comE<gt>
867
868 =head1 COPYRIGHT AND LICENSE
869
870 Copyright 2006-2010 by Infinity Interactive, Inc.
871
872 L<http://www.iinteractive.com>
873
874 This library is free software; you can redistribute it and/or modify
875 it under the same terms as Perl itself.
876
877 =cut
878