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 ();
  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.04';
  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 does_role {
 204     my ($self, $role_name) = @_;
 205
 206     (defined $role_name)
 207         || $self->throw_error("You must supply a role name to look for");
 208
 209     foreach my $class ($self->class_precedence_list) {
 210         my $meta = Class::MOP::class_of($class);
 211         # when a Moose metaclass is itself extended with a role,
 212         # this check needs to be done since some items in the
 213         # class_precedence_list might in fact be Class::MOP
 214         # based still.
 215         next unless $meta && $meta->can('roles');
 216         foreach my $role (@{$meta->roles}) {
 217             return 1 if $role->does_role($role_name);
 218         }
 219     }
 220     return 0;
 221 }
 222
 223 sub excludes_role {
 224     my ($self, $role_name) = @_;
 225
 226     (defined $role_name)
 227         || $self->throw_error("You must supply a role name to look for");
 228
 229     foreach my $class ($self->class_precedence_list) {
 230         my $meta = Class::MOP::class_of($class);
 231         # when a Moose metaclass is itself extended with a role,
 232         # this check needs to be done since some items in the
 233         # class_precedence_list might in fact be Class::MOP
 234         # based still.
 235         next unless $meta && $meta->can('roles');
 236         foreach my $role (@{$meta->roles}) {
 237             return 1 if $role->excludes_role($role_name);
 238         }
 239     }
 240     return 0;
 241 }
 242
 243 sub new_object {
 244     my $self   = shift;
 245     my $params = @_ == 1 ? $_[0] : {@_};
 246     my $object = $self->SUPER::new_object($params);
 247
 248     foreach my $attr ( $self->get_all_attributes() ) {
 249
 250         next unless $attr->can('has_trigger') && $attr->has_trigger;
 251
 252         my $init_arg = $attr->init_arg;
 253
 254         next unless defined $init_arg;
 255
 256         next unless exists $params->{$init_arg};
 257
 258         $attr->trigger->(
 259             $object,
 260             (
 261                   $attr->should_coerce
 262                 ? $attr->get_read_method_ref->($object)
 263                 : $params->{$init_arg}
 264             ),
 265         );
 266     }
 267
 268     $object->BUILDALL($params) if $object->can('BUILDALL');
 269
 270     return $object;
 271 }
 272
 273 sub superclasses {
 274     my $self = shift;
 275     my $supers = Data::OptList::mkopt(\@_);
 276     foreach my $super (@{ $supers }) {
 277         my ($name, $opts) = @{ $super };
 278         Class::MOP::load_class($name, $opts);
 279         my $meta = Class::MOP::class_of($name);
 280         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 281             if $meta && $meta->isa('Moose::Meta::Role')
 282     }
 283     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 284 }
 285
 286 ### ---------------------------------------------
 287
 288 sub add_attribute {
 289     my $self = shift;
 290     my $attr =
 291         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 292             ? $_[0]
 293             : $self->_process_attribute(@_));
 294     $self->SUPER::add_attribute($attr);
 295     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 296     # 'bare' and doesn't implement this method
 297     if ($attr->can('_check_associated_methods')) {
 298         $attr->_check_associated_methods;
 299     }
 300     return $attr;
 301 }
 302
 303 sub add_override_method_modifier {
 304     my ($self, $name, $method, $_super_package) = @_;
 305
 306     (!$self->has_method($name))
 307         || $self->throw_error("Cannot add an override method if a local method is already present");
 308
 309     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 310         method  => $method,
 311         class   => $self,
 312         package => $_super_package, # need this for roles
 313         name    => $name,
 314     ));
 315 }
 316
 317 sub add_augment_method_modifier {
 318     my ($self, $name, $method) = @_;
 319     (!$self->has_method($name))
 320         || $self->throw_error("Cannot add an augment method if a local method is already present");
 321
 322     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 323         method  => $method,
 324         class   => $self,
 325         name    => $name,
 326     ));
 327 }
 328
 329 ## Private Utility methods ...
 330
 331 sub _find_next_method_by_name_which_is_not_overridden {
 332     my ($self, $name) = @_;
 333     foreach my $method ($self->find_all_methods_by_name($name)) {
 334         return $method->{code}
 335             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 336     }
 337     return undef;
 338 }
 339
 340 ## Metaclass compatibility
 341
 342 sub _base_metaclasses {
 343     my $self = shift;
 344     my %metaclasses = $self->SUPER::_base_metaclasses;
 345     for my $class (keys %metaclasses) {
 346         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 347     }
 348     return (
 349         %metaclasses,
 350         error_class => 'Moose::Error::Default',
 351     );
 352 }
 353
 354 sub _find_common_base {
 355     my $self = shift;
 356     my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
 357     return unless defined($meta1) && defined($meta2);
 358
 359     # FIXME? This doesn't account for multiple inheritance (not sure
 360     # if it needs to though). For example, is somewhere in $meta1's
 361     # history it inherits from both ClassA and ClassB, and $meta2
 362     # inherits from ClassB & ClassA, does it matter? And what crazy
 363     # fool would do that anyway?
 364
 365     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 366
 367     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 368 }
 369
 370 sub _get_ancestors_until {
 371     my $self = shift;
 372     my ($start, $until) = @_;
 373
 374     my @ancestors;
 375     for my $ancestor (Class::MOP::class_of($start)->linearized_isa) {
 376         last if $ancestor eq $until;
 377         push @ancestors, $ancestor;
 378     }
 379     return @ancestors;
 380 }
 381
 382 sub _is_role_only_subclass {
 383     my $self = shift;
 384     my ($class) = @_;
 385     my $meta = Class::MOP::Class->initialize($class);
 386     my @parents = $meta->superclasses;
 387
 388     # XXX: don't feel like messing with multiple inheritance here... what would
 389     # that even do?
 390     return unless @parents == 1;
 391     my ($parent) = @parents;
 392     my $parent_meta = Class::MOP::Class->initialize($parent);
 393
 394     # loop over all methods that are a part of the current class
 395     # (not inherited)
 396     for my $method (map { $meta->meta->get_method($_) } $meta->meta->get_method_list) {
 397         # always ignore meta
 398         next if $method->name eq 'meta';
 399         # we'll deal with attributes below
 400         next if $method->isa('Class::MOP::Method::Accessor');
 401         # if the method comes from a role we consumed, ignore it
 402         next if $meta->meta->can('does_role')
 403              && $meta->meta->does_role($method->original_package_name);
 404
 405         return 0;
 406     }
 407
 408     # loop over all attributes that are a part of the current class
 409     # (not inherited)
 410     # FIXME - this really isn't right. Just because an attribute is
 411     # defined in a role doesn't mean it isn't _also_ defined in the
 412     # subclass.
 413     for my $attr (map { $meta->meta->get_attribute($_) } $meta->meta->get_attribute_list) {
 414         next if any { $_->has_attribute($attr->name) }
 415                 map { $_->meta->can('calculate_all_roles')
 416                     ? $_->meta->calculate_all_roles
 417                     : () }
 418                 $meta->linearized_isa;
 419
 420         return 0;
 421     }
 422
 423     return 1;
 424 }
 425
 426 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
 427     my $self = shift;
 428     my ($super_meta) = @_;
 429
 430     my $common_base = $self->_find_common_base($self, $super_meta);
 431     # if they're not both moose metaclasses, and the cmop fixing couldn't
 432     # do anything, there's nothing more we can do
 433     return unless defined($common_base);
 434     return unless $common_base->isa('Moose::Meta::Class');
 435
 436     my @superclass_ancestors = $self->_get_ancestors_until($super_meta, $common_base);
 437     my @ancestors = $self->_get_ancestors_until($self, $common_base);
 438     # we're only dealing with roles here
 439     return unless all { $self->_is_role_only_subclass($_) }
 440                       (@superclass_ancestors, @ancestors);
 441
 442     return 1;
 443 }
 444
 445 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
 446     my $self = shift;
 447     my ($metaclass_type, $super_metaclass) = @_;
 448
 449     my $meta = $self->$metaclass_type;
 450     return unless $super_metaclass->can($metaclass_type);
 451     my $super_meta = $super_metaclass->$metaclass_type;
 452     my %metaclasses = $self->_base_metaclasses;
 453
 454     my $common_base = $self->_find_common_base($meta, $super_meta);
 455     # if they're not both moose metaclasses, and the cmop fixing couldn't
 456     # do anything, there's nothing more we can do
 457     return unless defined($common_base);
 458     return unless $common_base->isa($metaclasses{$metaclass_type});
 459
 460     my @superclass_ancestors = $self->_get_ancestors_until($super_meta, $common_base);
 461     my @ancestors = $self->_get_ancestors_until($meta, $common_base);
 462     # we're only dealing with roles here
 463     return unless all { $self->_is_role_only_subclass($_) }
 464                       (@superclass_ancestors, @ancestors);
 465
 466     return 1;
 467 }
 468
 469 sub _role_differences {
 470     my $self = shift;
 471     my ($meta, $super_meta) = @_;
 472     my @super_roles = $super_meta->meta->calculate_all_roles;
 473     my @roles = $meta->meta->calculate_all_roles;
 474     my @differences;
 475     for my $role (@super_roles) {
 476         push @differences, $role unless any { $_->name eq $role->name } @roles;
 477     }
 478     return @differences;
 479 }
 480
 481 sub _reconcile_roles_for_metaclass {
 482     my $self = shift;
 483     my ($meta, $super_meta, $base_class) = @_;
 484
 485     my @role_differences = $self->_role_differences($meta, $super_meta);
 486     return $self->meta->create_anon_class(
 487         superclasses => [$super_meta],
 488         roles        => \@role_differences,
 489         cache        => 1,
 490     );
 491 }
 492
 493 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
 494     my $self = shift;
 495     my ($super_meta) = @_;
 496
 497     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
 498
 499     my %base_metaclass = $self->_base_metaclasses;
 500     for my $metaclass_type (keys %base_metaclass) {
 501         next unless defined $self->$metaclass_type;
 502         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
 503     }
 504
 505     return;
 506 }
 507
 508 sub _can_fix_metaclass_incompatibility {
 509     my $self = shift;
 510     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
 511     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
 512 }
 513
 514 sub _fix_class_metaclass_incompatibility {
 515     my $self = shift;
 516     my ($super_meta) = @_;
 517
 518     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 519
 520     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 521         my $subclass = $self->_reconcile_roles_for_metaclass($self, $super_meta, 'Moose::Meta::Class');
 522         $subclass->meta->rebless_instace($self);
 523     }
 524 }
 525
 526 sub _fix_single_metaclass_incompatibility {
 527     my $self = shift;
 528     my ($metaclass_type, $super_meta) = @_;
 529
 530     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 531
 532     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 533         my %metaclasses = $self->_base_metaclasses;
 534         my $subclass = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type, $metaclasses{$metaclass_type});
 535         $self->$metaclass_type($subclass->name);
 536     }
 537 }
 538
 539 sub _process_attribute {
 540     my ( $self, $name, @args ) = @_;
 541
 542     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 543
 544     if (($name || '') =~ /^\+(.*)/) {
 545         return $self->_process_inherited_attribute($1, @args);
 546     }
 547     else {
 548         return $self->_process_new_attribute($name, @args);
 549     }
 550 }
 551
 552 sub _process_new_attribute {
 553     my ( $self, $name, @args ) = @_;
 554
 555     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 556 }
 557
 558 sub _process_inherited_attribute {
 559     my ($self, $attr_name, %options) = @_;
 560     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 561     (defined $inherited_attr)
 562         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 563     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 564         return $inherited_attr->clone_and_inherit_options(%options);
 565     }
 566     else {
 567         # NOTE:
 568         # kind of a kludge to handle Class::MOP::Attributes
 569         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 570     }
 571 }
 572
 573 ## -------------------------------------------------
 574
 575 our $error_level;
 576
 577 sub throw_error {
 578     my ( $self, @args ) = @_;
 579     local $error_level = ($error_level || 0) + 1;
 580     $self->raise_error($self->create_error(@args));
 581 }
 582
 583 sub raise_error {
 584     my ( $self, @args ) = @_;
 585     die @args;
 586 }
 587
 588 sub create_error {
 589     my ( $self, @args ) = @_;
 590
 591     require Carp::Heavy;
 592
 593     local $error_level = ($error_level || 0 ) + 1;
 594
 595     if ( @args % 2 == 1 ) {
 596         unshift @args, "message";
 597     }
 598
 599     my %args = ( metaclass => $self, last_error => $@, @args );
 600
 601     $args{depth} += $error_level;
 602
 603     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 604
 605     Class::MOP::load_class($class);
 606
 607     $class->new(
 608         Carp::caller_info($args{depth}),
 609         %args
 610     );
 611 }
 612
 613 1;
 614
 615 __END__
 616
 617 =pod
 618
 619 =head1 NAME
 620
 621 Moose::Meta::Class - The Moose metaclass
 622
 623 =head1 DESCRIPTION
 624
 625 This class is a subclass of L<Class::MOP::Class> that provides
 626 additional Moose-specific functionality.
 627
 628 To really understand this class, you will need to start with the
 629 L<Class::MOP::Class> documentation. This class can be understood as a
 630 set of additional features on top of the basic feature provided by
 631 that parent class.
 632
 633 =head1 INHERITANCE
 634
 635 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 636
 637 =head1 METHODS
 638
 639 =over 4
 640
 641 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 642
 643 This overrides the parent's method in order to provide its own
 644 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 645 C<method_metaclass> options.
 646
 647 These all default to the appropriate Moose class.
 648
 649 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 650
 651 This overrides the parent's method in order to accept a C<roles>
 652 option. This should be an array reference containing roles
 653 that the class does, each optionally followed by a hashref of options
 654 (C<-excludes> and C<-alias>).
 655
 656   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 657
 658 =item B<< Moose::Meta::Class->create_anon_class >>
 659
 660 This overrides the parent's method to accept a C<roles> option, just
 661 as C<create> does.
 662
 663 It also accepts a C<cache> option. If this is true, then the anonymous
 664 class will be cached based on its superclasses and roles. If an
 665 existing anonymous class in the cache has the same superclasses and
 666 roles, it will be reused.
 667
 668   my $metaclass = Moose::Meta::Class->create_anon_class(
 669       superclasses => ['Foo'],
 670       roles        => [qw/Some Roles Go Here/],
 671       cache        => 1,
 672   );
 673
 674 Each entry in both the C<superclasses> and the C<roles> option can be
 675 followed by a hash reference with arguments. The C<superclasses>
 676 option can be supplied with a L<-version|Class::MOP/Class Loading
 677 Options> option that ensures the loaded superclass satisfies the
 678 required version. The C<role> option also takes the C<-version> as an
 679 argument, but the option hash reference can also contain any other
 680 role relevant values like exclusions or parameterized role arguments.
 681
 682 =item B<< $metaclass->make_immutable(%options) >>
 683
 684 This overrides the parent's method to add a few options. Specifically,
 685 it uses the Moose-specific constructor and destructor classes, and
 686 enables inlining the destructor.
 687
 688 Also, since Moose always inlines attributes, it sets the
 689 C<inline_accessors> option to false.
 690
 691 =item B<< $metaclass->new_object(%params) >>
 692
 693 This overrides the parent's method in order to add support for
 694 attribute triggers.
 695
 696 =item B<< $metaclass->superclasses(@superclasses) >>
 697
 698 This is the accessor allowing you to read or change the parents of
 699 the class.
 700
 701 Each superclass can be followed by a hash reference containing a
 702 L<-version|Class::MOP/Class Loading Options> value. If the version
 703 requirement is not satisfied an error will be thrown.
 704
 705 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 706
 707 This adds an C<override> method modifier to the package.
 708
 709 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 710
 711 This adds an C<augment> method modifier to the package.
 712
 713 =item B<< $metaclass->calculate_all_roles >>
 714
 715 This will return a unique array of C<Moose::Meta::Role> instances
 716 which are attached to this class.
 717
 718 =item B<< $metaclass->add_role($role) >>
 719
 720 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 721 list of roles. This I<does not> actually apply the role to the class.
 722
 723 =item B<< $metaclass->role_applications >>
 724
 725 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 726 objects, which contain the arguments to role application.
 727
 728 =item B<< $metaclass->add_role_application($application) >>
 729
 730 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 731 adds it to the class's list of role applications. This I<does not>
 732 actually apply any role to the class; it is only for tracking role
 733 applications.
 734
 735 =item B<< $metaclass->does_role($role) >>
 736
 737 This returns a boolean indicating whether or not the class does the specified
 738 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 739 object. This tests both the class and its parents.
 740
 741 =item B<< $metaclass->excludes_role($role_name) >>
 742
 743 A class excludes a role if it has already composed a role which
 744 excludes the named role. This tests both the class and its parents.
 745
 746 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 747
 748 This overrides the parent's method in order to allow the parameters to
 749 be provided as a hash reference.
 750
 751 =item B<< $metaclass->constructor_class($class_name) >>
 752
 753 =item B<< $metaclass->destructor_class($class_name) >>
 754
 755 These are the names of classes used when making a class
 756 immutable. These default to L<Moose::Meta::Method::Constructor> and
 757 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 758 read-write, so you can use them to change the class name.
 759
 760 =item B<< $metaclass->error_class($class_name) >>
 761
 762 The name of the class used to throw errors. This defaults to
 763 L<Moose::Error::Default>, which generates an error with a stacktrace
 764 just like C<Carp::confess>.
 765
 766 =item B<< $metaclass->throw_error($message, %extra) >>
 767
 768 Throws the error created by C<create_error> using C<raise_error>
 769
 770 =back
 771
 772 =head1 BUGS
 773
 774 See L<Moose/BUGS> for details on reporting bugs.
 775
 776 =head1 AUTHOR
 777
 778 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 779
 780 =head1 COPYRIGHT AND LICENSE
 781
 782 Copyright 2006-2010 by Infinity Interactive, Inc.
 783
 784 L<http://www.iinteractive.com>
 785
 786 This library is free software; you can redistribute it and/or modify
 787 it under the same terms as Perl itself.
 788
 789 =cut
 790