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 List::Util qw( first );
  11 use List::MoreUtils qw( any all uniq first_index );
  12 use Scalar::Util 'weaken', 'blessed';
  13
  14 our $VERSION   = '0.77';
  15 $VERSION = eval $VERSION;
  16 our $AUTHORITY = 'cpan:STEVAN';
  17
  18 use Moose::Meta::Method::Overridden;
  19 use Moose::Meta::Method::Augmented;
  20 use Moose::Error::Default;
  21 use Moose::Meta::Class::Immutable::Trait;
  22 use Moose::Meta::Method::Constructor;
  23 use Moose::Meta::Method::Destructor;
  24
  25 use base 'Class::MOP::Class';
  26
  27 __PACKAGE__->meta->add_attribute('roles' => (
  28     reader  => 'roles',
  29     default => sub { [] }
  30 ));
  31
  32 __PACKAGE__->meta->add_attribute('role_applications' => (
  33     reader  => '_get_role_applications',
  34     default => sub { [] }
  35 ));
  36
  37 __PACKAGE__->meta->add_attribute(
  38     Class::MOP::Attribute->new('immutable_trait' => (
  39         accessor => "immutable_trait",
  40         default  => 'Moose::Meta::Class::Immutable::Trait',
  41     ))
  42 );
  43
  44 __PACKAGE__->meta->add_attribute('constructor_class' => (
  45     accessor => 'constructor_class',
  46     default  => 'Moose::Meta::Method::Constructor',
  47 ));
  48
  49 __PACKAGE__->meta->add_attribute('destructor_class' => (
  50     accessor => 'destructor_class',
  51     default  => 'Moose::Meta::Method::Destructor',
  52 ));
  53
  54 __PACKAGE__->meta->add_attribute('error_class' => (
  55     accessor => 'error_class',
  56     default  => 'Moose::Error::Default',
  57 ));
  58
  59 sub initialize {
  60     my $class = shift;
  61     my $pkg   = shift;
  62     return Class::MOP::get_metaclass_by_name($pkg)
  63         || $class->SUPER::initialize($pkg,
  64                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  65                 'method_metaclass'    => 'Moose::Meta::Method',
  66                 'instance_metaclass'  => 'Moose::Meta::Instance',
  67                 @_
  68             );
  69 }
  70
  71 sub _immutable_options {
  72     my ( $self, @args ) = @_;
  73
  74     $self->SUPER::_immutable_options(
  75         inline_destructor => 1,
  76
  77         # Moose always does this when an attribute is created
  78         inline_accessors => 0,
  79
  80         @args,
  81     );
  82 }
  83
  84 sub create {
  85     my ($self, $package_name, %options) = @_;
  86
  87     (ref $options{roles} eq 'ARRAY')
  88         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  89             if exists $options{roles};
  90     my $roles = delete $options{roles};
  91
  92     my $class = $self->SUPER::create($package_name, %options);
  93
  94     if ($roles) {
  95         Moose::Util::apply_all_roles( $class, @$roles );
  96     }
  97
  98     return $class;
  99 }
 100
 101 sub _check_metaclass_compatibility {
 102     my $self = shift;
 103
 104     if ( my @supers = $self->superclasses ) {
 105         $self->_fix_metaclass_incompatibility(@supers);
 106     }
 107
 108     $self->SUPER::_check_metaclass_compatibility(@_);
 109 }
 110
 111 my %ANON_CLASSES;
 112
 113 sub create_anon_class {
 114     my ($self, %options) = @_;
 115
 116     my $cache_ok = delete $options{cache};
 117
 118     # something like Super::Class|Super::Class::2=Role|Role::1
 119     my $cache_key = join '=' => (
 120         join('|', @{$options{superclasses} || []}),
 121         join('|', sort @{$options{roles}   || []}),
 122     );
 123
 124     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
 125         return $ANON_CLASSES{$cache_key};
 126     }
 127
 128     my $new_class = $self->SUPER::create_anon_class(%options);
 129
 130     $ANON_CLASSES{$cache_key} = $new_class
 131         if $cache_ok;
 132
 133     return $new_class;
 134 }
 135
 136 sub add_role {
 137     my ($self, $role) = @_;
 138     (blessed($role) && $role->isa('Moose::Meta::Role'))
 139         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 140     push @{$self->roles} => $role;
 141 }
 142
 143 sub role_applications {
 144     my ($self) = @_;
 145
 146     return @{$self->_get_role_applications};
 147 }
 148
 149 sub add_role_application {
 150     my ($self, $application) = @_;
 151     (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
 152         || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
 153     push @{$self->_get_role_applications} => $application;
 154 }
 155
 156 sub calculate_all_roles {
 157     my $self = shift;
 158     my %seen;
 159     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 160 }
 161
 162 sub does_role {
 163     my ($self, $role_name) = @_;
 164
 165     (defined $role_name)
 166         || $self->throw_error("You must supply a role name to look for");
 167
 168     foreach my $class ($self->class_precedence_list) {
 169         my $meta = Class::MOP::class_of($class);
 170         # when a Moose metaclass is itself extended with a role,
 171         # this check needs to be done since some items in the
 172         # class_precedence_list might in fact be Class::MOP
 173         # based still.
 174         next unless $meta && $meta->can('roles');
 175         foreach my $role (@{$meta->roles}) {
 176             return 1 if $role->does_role($role_name);
 177         }
 178     }
 179     return 0;
 180 }
 181
 182 sub excludes_role {
 183     my ($self, $role_name) = @_;
 184
 185     (defined $role_name)
 186         || $self->throw_error("You must supply a role name to look for");
 187
 188     foreach my $class ($self->class_precedence_list) {
 189         my $meta = Class::MOP::class_of($class);
 190         # when a Moose metaclass is itself extended with a role,
 191         # this check needs to be done since some items in the
 192         # class_precedence_list might in fact be Class::MOP
 193         # based still.
 194         next unless $meta && $meta->can('roles');
 195         foreach my $role (@{$meta->roles}) {
 196             return 1 if $role->excludes_role($role_name);
 197         }
 198     }
 199     return 0;
 200 }
 201
 202 sub new_object {
 203     my $class  = shift;
 204     my $params = @_ == 1 ? $_[0] : {@_};
 205     my $self   = $class->SUPER::new_object($params);
 206
 207     foreach my $attr ( $class->get_all_attributes() ) {
 208
 209         next unless $attr->can('has_trigger') && $attr->has_trigger;
 210
 211         my $init_arg = $attr->init_arg;
 212
 213         next unless defined $init_arg;
 214
 215         next unless exists $params->{$init_arg};
 216
 217         $attr->trigger->(
 218             $self,
 219             (
 220                   $attr->should_coerce
 221                 ? $attr->get_read_method_ref->($self)
 222                 : $params->{$init_arg}
 223             ),
 224         );
 225     }
 226
 227     return $self;
 228 }
 229
 230 sub _construct_instance {
 231     my $class = shift;
 232     my $params = @_ == 1 ? $_[0] : {@_};
 233     my $meta_instance = $class->get_meta_instance;
 234     # FIXME:
 235     # the code below is almost certainly incorrect
 236     # but this is foreign inheritance, so we might
 237     # have to kludge it in the end.
 238     my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance();
 239     foreach my $attr ($class->get_all_attributes()) {
 240         $attr->initialize_instance_slot($meta_instance, $instance, $params);
 241     }
 242     return $instance;
 243 }
 244
 245 sub superclasses {
 246     my $self = shift;
 247     my @supers = @_;
 248     foreach my $super (@supers) {
 249         my $meta = Class::MOP::load_class($super);
 250         Moose->throw_error("You cannot inherit from a Moose Role ($super)")
 251             if $meta && $meta->isa('Moose::Meta::Role')
 252     }
 253     return $self->SUPER::superclasses(@supers);
 254 }
 255
 256 ### ---------------------------------------------
 257
 258 sub add_attribute {
 259     my $self = shift;
 260     $self->SUPER::add_attribute(
 261         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 262             ? $_[0]
 263             : $self->_process_attribute(@_))
 264     );
 265 }
 266
 267 sub add_override_method_modifier {
 268     my ($self, $name, $method, $_super_package) = @_;
 269
 270     (!$self->has_method($name))
 271         || $self->throw_error("Cannot add an override method if a local method is already present");
 272
 273     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 274         method  => $method,
 275         class   => $self,
 276         package => $_super_package, # need this for roles
 277         name    => $name,
 278     ));
 279 }
 280
 281 sub add_augment_method_modifier {
 282     my ($self, $name, $method) = @_;
 283     (!$self->has_method($name))
 284         || $self->throw_error("Cannot add an augment method if a local method is already present");
 285
 286     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 287         method  => $method,
 288         class   => $self,
 289         name    => $name,
 290     ));
 291 }
 292
 293 ## Private Utility methods ...
 294
 295 sub _find_next_method_by_name_which_is_not_overridden {
 296     my ($self, $name) = @_;
 297     foreach my $method ($self->find_all_methods_by_name($name)) {
 298         return $method->{code}
 299             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 300     }
 301     return undef;
 302 }
 303
 304 sub _fix_metaclass_incompatibility {
 305     my ($self, @superclasses) = @_;
 306
 307     foreach my $super (@superclasses) {
 308         my $meta = Class::MOP::Class->initialize($super);
 309
 310         my @all_supers = $meta->linearized_isa;
 311         shift(@all_supers); # Discard self
 312         my @super_metas_to_fix = ( $meta );
 313
 314         # We need to check&fix the imediate superclass, and if its @ISA contains
 315         # a class without a metaclass instance, followed by a class with a
 316         # metaclass instance, init a metaclass instance for classes without
 317         # one and fix compat up to and including the class which was already
 318         # initialized.
 319         my $idx = first_index { Class::MOP::class_of($_) } @all_supers;
 320         push(@super_metas_to_fix,
 321             map { Class::MOP::Class->initialize($_) } @all_supers[0..$idx]
 322         ) if ($idx >= 0);
 323
 324         foreach my $super_meta (@super_metas_to_fix) {
 325             $self->_fix_one_incompatible_metaclass($super_meta);
 326         }
 327     }
 328 }
 329
 330 sub _fix_one_incompatible_metaclass {
 331     my ($self, $meta) = @_;
 332
 333     return if $self->_superclass_meta_is_compatible($meta);
 334
 335     unless ( $self->is_pristine ) {
 336         $self->throw_error(
 337               "Cannot attempt to reinitialize metaclass for "
 338             . $self->name
 339             . ", it isn't pristine" );
 340     }
 341     $self->_reconcile_with_superclass_meta($meta);
 342 }
 343
 344 sub _superclass_meta_is_compatible {
 345     my ($self, $super_meta) = @_;
 346
 347     next unless $super_meta->isa("Class::MOP::Class");
 348
 349     my $super_meta_name
 350         = $super_meta->is_immutable
 351         ? $super_meta->get_mutable_metaclass_name
 352         : ref($super_meta);
 353
 354     return 1
 355         if $self->isa($super_meta_name)
 356             and
 357            $self->instance_metaclass->isa( $super_meta->instance_metaclass );
 358 }
 359
 360 # I don't want to have to type this >1 time
 361 my @MetaClassTypes =
 362     qw( attribute_metaclass
 363         method_metaclass
 364         wrapped_method_metaclass
 365         instance_metaclass
 366         constructor_class
 367         destructor_class
 368         error_class );
 369
 370 sub _reconcile_with_superclass_meta {
 371     my ($self, $super_meta) = @_;
 372
 373     my $super_meta_name
 374         = $super_meta->is_immutable
 375         ? $super_meta->get_mutable_metaclass_name
 376         : ref($super_meta);
 377
 378     my $self_metaclass = ref $self;
 379
 380     # If neither of these is true we have a more serious
 381     # incompatibility that we just cannot fix (yet?).
 382     if ( $super_meta_name->isa( ref $self )
 383         && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) {
 384         $self->_reinitialize_with($super_meta);
 385     }
 386     elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) {
 387         $self->_reconcile_role_differences($super_meta);
 388     }
 389 }
 390
 391 sub _reinitialize_with {
 392     my ( $self, $new_meta ) = @_;
 393
 394     my $new_self = $new_meta->reinitialize(
 395         $self->name,
 396         attribute_metaclass => $new_meta->attribute_metaclass,
 397         method_metaclass    => $new_meta->method_metaclass,
 398         instance_metaclass  => $new_meta->instance_metaclass,
 399     );
 400
 401     $new_self->$_( $new_meta->$_ )
 402         for qw( constructor_class destructor_class error_class );
 403
 404     %$self = %$new_self;
 405
 406     bless $self, ref $new_self;
 407
 408     # We need to replace the cached metaclass instance or else when it
 409     # goes out of scope Class::MOP::Class destroy's the namespace for
 410     # the metaclass's class, causing much havoc.
 411     Class::MOP::store_metaclass_by_name( $self->name, $self );
 412     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 413 }
 414
 415 # In the more complex case, we share a common ancestor with our
 416 # superclass's metaclass, but each metaclass (ours and the parent's)
 417 # has a different set of roles applied. We reconcile this by first
 418 # reinitializing into the parent class, and _then_ applying our own
 419 # roles.
 420 sub _all_metaclasses_differ_by_roles_only {
 421     my ($self, $super_meta) = @_;
 422
 423     for my $pair (
 424         [ ref $self, ref $super_meta ],
 425         map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes
 426         ) {
 427
 428         next if $pair->[0] eq $pair->[1];
 429
 430         my $self_meta_meta  = Class::MOP::Class->initialize( $pair->[0] );
 431         my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] );
 432
 433         my $common_ancestor
 434             = _find_common_ancestor( $self_meta_meta, $super_meta_meta );
 435
 436         return unless $common_ancestor;
 437
 438         return
 439             unless _is_role_only_subclass_of(
 440             $self_meta_meta,
 441             $common_ancestor,
 442             )
 443             && _is_role_only_subclass_of(
 444             $super_meta_meta,
 445             $common_ancestor,
 446             );
 447     }
 448
 449     return 1;
 450 }
 451
 452 # This, and some other functions, could be called as methods, but
 453 # they're not for two reasons. One, we just end up ignoring the first
 454 # argument, because we can't call these directly on one of the real
 455 # arguments, because one of them could be a Class::MOP::Class object
 456 # and not a Moose::Meta::Class. Second, only a completely insane
 457 # person would attempt to subclass this stuff!
 458 sub _find_common_ancestor {
 459     my ($meta1, $meta2) = @_;
 460
 461     # FIXME? This doesn't account for multiple inheritance (not sure
 462     # if it needs to though). For example, is somewhere in $meta1's
 463     # history it inherits from both ClassA and ClassB, and $meta2
 464     # inherits from ClassB & ClassA, does it matter? And what crazy
 465     # fool would do that anyway?
 466
 467     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 468
 469     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 470 }
 471
 472 sub _is_role_only_subclass_of {
 473     my ($meta, $ancestor) = @_;
 474
 475     return 1 if $meta->name eq $ancestor;
 476
 477     my @roles = _all_roles_until( $meta, $ancestor );
 478
 479     my %role_packages = map { $_->name => 1 } @roles;
 480
 481     my $ancestor_meta = Class::MOP::Class->initialize($ancestor);
 482
 483     my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa;
 484
 485     for my $method ( $meta->get_all_methods() ) {
 486         next if $method->name eq 'meta';
 487         next if $method->can('associated_attribute');
 488
 489         next
 490             if $role_packages{ $method->original_package_name }
 491                 || $shared_ancestors{ $method->original_package_name };
 492
 493         return 0;
 494     }
 495
 496     # FIXME - this really isn't right. Just because an attribute is
 497     # defined in a role doesn't mean it isn't _also_ defined in the
 498     # subclass.
 499     for my $attr ( $meta->get_all_attributes ) {
 500         next if $shared_ancestors{ $attr->associated_class->name };
 501
 502         next if any { $_->has_attribute( $attr->name ) } @roles;
 503
 504         return 0;
 505     }
 506
 507     return 1;
 508 }
 509
 510 sub _all_roles {
 511     my $meta = shift;
 512
 513     return _all_roles_until($meta);
 514 }
 515
 516 sub _all_roles_until {
 517     my ($meta, $stop_at_class) = @_;
 518
 519     return unless $meta->can('calculate_all_roles');
 520
 521     my @roles = $meta->calculate_all_roles;
 522
 523     for my $class ( $meta->linearized_isa ) {
 524         last if $stop_at_class && $stop_at_class eq $class;
 525
 526         my $meta = Class::MOP::Class->initialize($class);
 527         last unless $meta->can('calculate_all_roles');
 528
 529         push @roles, $meta->calculate_all_roles;
 530     }
 531
 532     return uniq @roles;
 533 }
 534
 535 sub _reconcile_role_differences {
 536     my ($self, $super_meta) = @_;
 537
 538     my $self_meta = Class::MOP::class_of($self);
 539
 540     my %roles;
 541
 542     if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
 543         $roles{metaclass_roles} = \@roles;
 544     }
 545
 546     for my $thing (@MetaClassTypes) {
 547         my $name = $self->$thing();
 548
 549         my $thing_meta = Class::MOP::Class->initialize($name);
 550
 551         my @roles = map { $_->name } _all_roles($thing_meta)
 552             or next;
 553
 554         $roles{ $thing . '_roles' } = \@roles;
 555     }
 556
 557     $self->_reinitialize_with($super_meta);
 558
 559     Moose::Util::MetaRole::apply_metaclass_roles(
 560         for_class => $self->name,
 561         %roles,
 562     );
 563
 564     return $self;
 565 }
 566
 567 sub _process_attribute {
 568     my ( $self, $name, @args ) = @_;
 569
 570     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 571
 572     if (($name || '') =~ /^\+(.*)/) {
 573         return $self->_process_inherited_attribute($1, @args);
 574     }
 575     else {
 576         return $self->_process_new_attribute($name, @args);
 577     }
 578 }
 579
 580 sub _process_new_attribute {
 581     my ( $self, $name, @args ) = @_;
 582
 583     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 584 }
 585
 586 sub _process_inherited_attribute {
 587     my ($self, $attr_name, %options) = @_;
 588     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 589     (defined $inherited_attr)
 590         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 591     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 592         return $inherited_attr->clone_and_inherit_options(%options);
 593     }
 594     else {
 595         # NOTE:
 596         # kind of a kludge to handle Class::MOP::Attributes
 597         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 598     }
 599 }
 600
 601 ## -------------------------------------------------
 602
 603 our $error_level;
 604
 605 sub throw_error {
 606     my ( $self, @args ) = @_;
 607     local $error_level = ($error_level || 0) + 1;
 608     $self->raise_error($self->create_error(@args));
 609 }
 610
 611 sub raise_error {
 612     my ( $self, @args ) = @_;
 613     die @args;
 614 }
 615
 616 sub create_error {
 617     my ( $self, @args ) = @_;
 618
 619     require Carp::Heavy;
 620
 621     local $error_level = ($error_level || 0 ) + 1;
 622
 623     if ( @args % 2 == 1 ) {
 624         unshift @args, "message";
 625     }
 626
 627     my %args = ( metaclass => $self, last_error => $@, @args );
 628
 629     $args{depth} += $error_level;
 630
 631     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 632
 633     Class::MOP::load_class($class);
 634
 635     $class->new(
 636         Carp::caller_info($args{depth}),
 637         %args
 638     );
 639 }
 640
 641 1;
 642
 643 __END__
 644
 645 =pod
 646
 647 =head1 NAME
 648
 649 Moose::Meta::Class - The Moose metaclass
 650
 651 =head1 DESCRIPTION
 652
 653 This class is a subclass of L<Class::MOP::Class> that provides
 654 additional Moose-specific functionality.
 655
 656 To really understand this class, you will need to start with the
 657 L<Class::MOP::Class> documentation. This class can be understood as a
 658 set of additional features on top of the basic feature provided by
 659 that parent class.
 660
 661 =head1 INHERITANCE
 662
 663 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 664
 665 =head1 METHODS
 666
 667 =over 4
 668
 669 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 670
 671 This overrides the parent's method in order to provide its own
 672 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 673 C<method_metaclass> options.
 674
 675 These all default to the appropriate Moose class.
 676
 677 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 678
 679 This overrides the parent's method in order to accept a C<roles>
 680 option. This should be an array reference containing one more roles
 681 that the class does.
 682
 683   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 684
 685 =item B<< Moose::Meta::Class->create_anon_class >>
 686
 687 This overrides the parent's method to accept a C<roles> option, just
 688 as C<create> does.
 689
 690 It also accepts a C<cache> option. If this is true, then the anonymous
 691 class will be cached based on its superclasses and roles. If an
 692 existing anonymous class in the cache has the same superclasses and
 693 roles, it will be reused.
 694
 695   my $metaclass = Moose::Meta::Class->create_anon_class(
 696       superclasses => ['Foo'],
 697       roles        => [qw/Some Roles Go Here/],
 698       cache        => 1,
 699   );
 700
 701 =item B<< $metaclass->make_immutable(%options) >>
 702
 703 This overrides the parent's method to add a few options. Specifically,
 704 it uses the Moose-specific constructor and destructor classes, and
 705 enables inlining the destructor.
 706
 707 Also, since Moose always inlines attributes, it sets the
 708 C<inline_accessors> option to false.
 709
 710 =item B<< $metaclass->new_object(%params) >>
 711
 712 This overrides the parent's method in order to add support for
 713 attribute triggers.
 714
 715 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 716
 717 This adds an C<override> method modifier to the package.
 718
 719 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 720
 721 This adds an C<augment> method modifier to the package.
 722
 723 =item B<< $metaclass->calculate_all_roles >>
 724
 725 This will return a unique array of C<Moose::Meta::Role> instances
 726 which are attached to this class.
 727
 728 =item B<< $metaclass->add_role($role) >>
 729
 730 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 731 list of roles. This I<does not> actually apply the role to the class.
 732
 733 =item B<< $metaclass->role_applications >>
 734
 735 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 736 objects, which contain the arguments to role application.
 737
 738 =item B<< $metaclass->add_role_application($application) >>
 739
 740 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 741 adds it to the class's list of role applications. This I<does not>
 742 actually apply any role to the class; it is only for tracking role
 743 applications.
 744
 745 =item B<< $metaclass->does_role($role_name) >>
 746
 747 This returns a boolean indicating whether or not the class does the
 748 specified role. This tests both the class and its parents.
 749
 750 =item B<< $metaclass->excludes_role($role_name) >>
 751
 752 A class excludes a role if it has already composed a role which
 753 excludes the named role. This tests both the class and its parents.
 754
 755 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 756
 757 This overrides the parent's method in order to allow the parameters to
 758 be provided as a hash reference.
 759
 760 =item B<< $metaclass->constructor_class ($class_name) >>
 761
 762 =item B<< $metaclass->destructor_class ($class_name) >>
 763
 764 These are the names of classes used when making a class
 765 immutable. These default to L<Moose::Meta::Method::Constructor> and
 766 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 767 read-write, so you can use them to change the class name.
 768
 769 =item B<< $metaclass->error_class($class_name) >>
 770
 771 The name of the class used to throw errors. This defaults to
 772 L<Moose::Error::Default>, which generates an error with a stacktrace
 773 just like C<Carp::confess>.
 774
 775 =item B<< $metaclass->throw_error($message, %extra) >>
 776
 777 Throws the error created by C<create_error> using C<raise_error>
 778
 779 =back
 780
 781 =head1 BUGS
 782
 783 All complex software has bugs lurking in it, and this module is no
 784 exception. If you find a bug please either email me, or add the bug
 785 to cpan-RT.
 786
 787 =head1 AUTHOR
 788
 789 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 790
 791 =head1 COPYRIGHT AND LICENSE
 792
 793 Copyright 2006-2009 by Infinity Interactive, Inc.
 794
 795 L<http://www.iinteractive.com>
 796
 797 This library is free software; you can redistribute it and/or modify
 798 it under the same terms as Perl itself.
 799
 800 =cut
 801