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.79';
  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         Class::MOP::load_class($super);
 250         my $meta = Class::MOP::class_of($super);
 251         Moose->throw_error("You cannot inherit from a Moose Role ($super)")
 252             if $meta && $meta->isa('Moose::Meta::Role')
 253     }
 254     return $self->SUPER::superclasses(@supers);
 255 }
 256
 257 ### ---------------------------------------------
 258
 259 sub add_attribute {
 260     my $self = shift;
 261     $self->SUPER::add_attribute(
 262         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 263             ? $_[0]
 264             : $self->_process_attribute(@_))
 265     );
 266 }
 267
 268 sub add_override_method_modifier {
 269     my ($self, $name, $method, $_super_package) = @_;
 270
 271     (!$self->has_method($name))
 272         || $self->throw_error("Cannot add an override method if a local method is already present");
 273
 274     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 275         method  => $method,
 276         class   => $self,
 277         package => $_super_package, # need this for roles
 278         name    => $name,
 279     ));
 280 }
 281
 282 sub add_augment_method_modifier {
 283     my ($self, $name, $method) = @_;
 284     (!$self->has_method($name))
 285         || $self->throw_error("Cannot add an augment method if a local method is already present");
 286
 287     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 288         method  => $method,
 289         class   => $self,
 290         name    => $name,
 291     ));
 292 }
 293
 294 ## Private Utility methods ...
 295
 296 sub _find_next_method_by_name_which_is_not_overridden {
 297     my ($self, $name) = @_;
 298     foreach my $method ($self->find_all_methods_by_name($name)) {
 299         return $method->{code}
 300             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 301     }
 302     return undef;
 303 }
 304
 305 sub _fix_metaclass_incompatibility {
 306     my ($self, @superclasses) = @_;
 307
 308     foreach my $super (@superclasses) {
 309         my $meta = Class::MOP::Class->initialize($super);
 310
 311         my @all_supers = $meta->linearized_isa;
 312         shift @all_supers;
 313
 314         my @super_metas_to_fix = ($meta);
 315
 316         # We need to check & fix the immediate superclass. If its @ISA
 317         # contains a class without a metaclass instance, followed by a
 318         # class _with_ a metaclass instance, init a metaclass instance
 319         # for classes without one and fix compat up to and including
 320         # the class which was already initialized.
 321         my $idx = first_index { Class::MOP::class_of($_) } @all_supers;
 322
 323         push @super_metas_to_fix,
 324             map { Class::MOP::Class->initialize($_) } @all_supers[ 0 .. $idx ]
 325             if $idx >= 0;
 326
 327         foreach my $super_meta (@super_metas_to_fix) {
 328             $self->_fix_one_incompatible_metaclass($super_meta);
 329         }
 330     }
 331 }
 332
 333 sub _fix_one_incompatible_metaclass {
 334     my ($self, $meta) = @_;
 335
 336     return if $self->_superclass_meta_is_compatible($meta);
 337
 338     unless ( $self->is_pristine ) {
 339         $self->throw_error(
 340               "Cannot attempt to reinitialize metaclass for "
 341             . $self->name
 342             . ", it isn't pristine" );
 343     }
 344
 345     $self->_reconcile_with_superclass_meta($meta);
 346 }
 347
 348 sub _superclass_meta_is_compatible {
 349     my ($self, $super_meta) = @_;
 350
 351     next unless $super_meta->isa("Class::MOP::Class");
 352
 353     my $super_meta_name
 354         = $super_meta->is_immutable
 355         ? $super_meta->get_mutable_metaclass_name
 356         : ref($super_meta);
 357
 358     return 1
 359         if $self->isa($super_meta_name)
 360             and
 361            $self->instance_metaclass->isa( $super_meta->instance_metaclass );
 362 }
 363
 364 # I don't want to have to type this >1 time
 365 my @MetaClassTypes =
 366     qw( attribute_metaclass
 367         method_metaclass
 368         wrapped_method_metaclass
 369         instance_metaclass
 370         constructor_class
 371         destructor_class
 372         error_class );
 373
 374 sub _reconcile_with_superclass_meta {
 375     my ($self, $super_meta) = @_;
 376
 377     my $super_meta_name
 378         = $super_meta->is_immutable
 379         ? $super_meta->get_mutable_metaclass_name
 380         : ref($super_meta);
 381
 382     my $self_metaclass = ref $self;
 383
 384     # If neither of these is true we have a more serious
 385     # incompatibility that we just cannot fix (yet?).
 386     if ( $super_meta_name->isa( ref $self )
 387         && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) {
 388         $self->_reinitialize_with($super_meta);
 389     }
 390     elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) {
 391         $self->_reconcile_role_differences($super_meta);
 392     }
 393 }
 394
 395 sub _reinitialize_with {
 396     my ( $self, $new_meta ) = @_;
 397
 398     my $new_self = $new_meta->reinitialize(
 399         $self->name,
 400         attribute_metaclass => $new_meta->attribute_metaclass,
 401         method_metaclass    => $new_meta->method_metaclass,
 402         instance_metaclass  => $new_meta->instance_metaclass,
 403     );
 404
 405     $new_self->$_( $new_meta->$_ )
 406         for qw( constructor_class destructor_class error_class );
 407
 408     %$self = %$new_self;
 409
 410     bless $self, ref $new_self;
 411
 412     # We need to replace the cached metaclass instance or else when it
 413     # goes out of scope Class::MOP::Class destroy's the namespace for
 414     # the metaclass's class, causing much havoc.
 415     Class::MOP::store_metaclass_by_name( $self->name, $self );
 416     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 417 }
 418
 419 # In the more complex case, we share a common ancestor with our
 420 # superclass's metaclass, but each metaclass (ours and the parent's)
 421 # has a different set of roles applied. We reconcile this by first
 422 # reinitializing into the parent class, and _then_ applying our own
 423 # roles.
 424 sub _all_metaclasses_differ_by_roles_only {
 425     my ($self, $super_meta) = @_;
 426
 427     for my $pair (
 428         [ ref $self, ref $super_meta ],
 429         map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes
 430         ) {
 431
 432         next if $pair->[0] eq $pair->[1];
 433
 434         my $self_meta_meta  = Class::MOP::Class->initialize( $pair->[0] );
 435         my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] );
 436
 437         my $common_ancestor
 438             = _find_common_ancestor( $self_meta_meta, $super_meta_meta );
 439
 440         return unless $common_ancestor;
 441
 442         return
 443             unless _is_role_only_subclass_of(
 444             $self_meta_meta,
 445             $common_ancestor,
 446             )
 447             && _is_role_only_subclass_of(
 448             $super_meta_meta,
 449             $common_ancestor,
 450             );
 451     }
 452
 453     return 1;
 454 }
 455
 456 # This, and some other functions, could be called as methods, but
 457 # they're not for two reasons. One, we just end up ignoring the first
 458 # argument, because we can't call these directly on one of the real
 459 # arguments, because one of them could be a Class::MOP::Class object
 460 # and not a Moose::Meta::Class. Second, only a completely insane
 461 # person would attempt to subclass this stuff!
 462 sub _find_common_ancestor {
 463     my ($meta1, $meta2) = @_;
 464
 465     # FIXME? This doesn't account for multiple inheritance (not sure
 466     # if it needs to though). For example, is somewhere in $meta1's
 467     # history it inherits from both ClassA and ClassB, and $meta2
 468     # inherits from ClassB & ClassA, does it matter? And what crazy
 469     # fool would do that anyway?
 470
 471     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 472
 473     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 474 }
 475
 476 sub _is_role_only_subclass_of {
 477     my ($meta, $ancestor) = @_;
 478
 479     return 1 if $meta->name eq $ancestor;
 480
 481     my @roles = _all_roles_until( $meta, $ancestor );
 482
 483     my %role_packages = map { $_->name => 1 } @roles;
 484
 485     my $ancestor_meta = Class::MOP::Class->initialize($ancestor);
 486
 487     my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa;
 488
 489     for my $method ( $meta->get_all_methods() ) {
 490         next if $method->name eq 'meta';
 491         next if $method->can('associated_attribute');
 492
 493         next
 494             if $role_packages{ $method->original_package_name }
 495                 || $shared_ancestors{ $method->original_package_name };
 496
 497         return 0;
 498     }
 499
 500     # FIXME - this really isn't right. Just because an attribute is
 501     # defined in a role doesn't mean it isn't _also_ defined in the
 502     # subclass.
 503     for my $attr ( $meta->get_all_attributes ) {
 504         next if $shared_ancestors{ $attr->associated_class->name };
 505
 506         next if any { $_->has_attribute( $attr->name ) } @roles;
 507
 508         return 0;
 509     }
 510
 511     return 1;
 512 }
 513
 514 sub _all_roles {
 515     my $meta = shift;
 516
 517     return _all_roles_until($meta);
 518 }
 519
 520 sub _all_roles_until {
 521     my ($meta, $stop_at_class) = @_;
 522
 523     return unless $meta->can('calculate_all_roles');
 524
 525     my @roles = $meta->calculate_all_roles;
 526
 527     for my $class ( $meta->linearized_isa ) {
 528         last if $stop_at_class && $stop_at_class eq $class;
 529
 530         my $meta = Class::MOP::Class->initialize($class);
 531         last unless $meta->can('calculate_all_roles');
 532
 533         push @roles, $meta->calculate_all_roles;
 534     }
 535
 536     return uniq @roles;
 537 }
 538
 539 sub _reconcile_role_differences {
 540     my ($self, $super_meta) = @_;
 541
 542     my $self_meta = Class::MOP::class_of($self);
 543
 544     my %roles;
 545
 546     if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
 547         $roles{metaclass_roles} = \@roles;
 548     }
 549
 550     for my $thing (@MetaClassTypes) {
 551         my $name = $self->$thing();
 552
 553         my $thing_meta = Class::MOP::Class->initialize($name);
 554
 555         my @roles = map { $_->name } _all_roles($thing_meta)
 556             or next;
 557
 558         $roles{ $thing . '_roles' } = \@roles;
 559     }
 560
 561     $self->_reinitialize_with($super_meta);
 562
 563     Moose::Util::MetaRole::apply_metaclass_roles(
 564         for_class => $self->name,
 565         %roles,
 566     );
 567
 568     return $self;
 569 }
 570
 571 sub _process_attribute {
 572     my ( $self, $name, @args ) = @_;
 573
 574     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 575
 576     if (($name || '') =~ /^\+(.*)/) {
 577         return $self->_process_inherited_attribute($1, @args);
 578     }
 579     else {
 580         return $self->_process_new_attribute($name, @args);
 581     }
 582 }
 583
 584 sub _process_new_attribute {
 585     my ( $self, $name, @args ) = @_;
 586
 587     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 588 }
 589
 590 sub _process_inherited_attribute {
 591     my ($self, $attr_name, %options) = @_;
 592     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 593     (defined $inherited_attr)
 594         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 595     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 596         return $inherited_attr->clone_and_inherit_options(%options);
 597     }
 598     else {
 599         # NOTE:
 600         # kind of a kludge to handle Class::MOP::Attributes
 601         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 602     }
 603 }
 604
 605 ## -------------------------------------------------
 606
 607 our $error_level;
 608
 609 sub throw_error {
 610     my ( $self, @args ) = @_;
 611     local $error_level = ($error_level || 0) + 1;
 612     $self->raise_error($self->create_error(@args));
 613 }
 614
 615 sub raise_error {
 616     my ( $self, @args ) = @_;
 617     die @args;
 618 }
 619
 620 sub create_error {
 621     my ( $self, @args ) = @_;
 622
 623     require Carp::Heavy;
 624
 625     local $error_level = ($error_level || 0 ) + 1;
 626
 627     if ( @args % 2 == 1 ) {
 628         unshift @args, "message";
 629     }
 630
 631     my %args = ( metaclass => $self, last_error => $@, @args );
 632
 633     $args{depth} += $error_level;
 634
 635     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 636
 637     Class::MOP::load_class($class);
 638
 639     $class->new(
 640         Carp::caller_info($args{depth}),
 641         %args
 642     );
 643 }
 644
 645 1;
 646
 647 __END__
 648
 649 =pod
 650
 651 =head1 NAME
 652
 653 Moose::Meta::Class - The Moose metaclass
 654
 655 =head1 DESCRIPTION
 656
 657 This class is a subclass of L<Class::MOP::Class> that provides
 658 additional Moose-specific functionality.
 659
 660 To really understand this class, you will need to start with the
 661 L<Class::MOP::Class> documentation. This class can be understood as a
 662 set of additional features on top of the basic feature provided by
 663 that parent class.
 664
 665 =head1 INHERITANCE
 666
 667 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 668
 669 =head1 METHODS
 670
 671 =over 4
 672
 673 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 674
 675 This overrides the parent's method in order to provide its own
 676 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 677 C<method_metaclass> options.
 678
 679 These all default to the appropriate Moose class.
 680
 681 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 682
 683 This overrides the parent's method in order to accept a C<roles>
 684 option. This should be an array reference containing one more roles
 685 that the class does.
 686
 687   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 688
 689 =item B<< Moose::Meta::Class->create_anon_class >>
 690
 691 This overrides the parent's method to accept a C<roles> option, just
 692 as C<create> does.
 693
 694 It also accepts a C<cache> option. If this is true, then the anonymous
 695 class will be cached based on its superclasses and roles. If an
 696 existing anonymous class in the cache has the same superclasses and
 697 roles, it will be reused.
 698
 699   my $metaclass = Moose::Meta::Class->create_anon_class(
 700       superclasses => ['Foo'],
 701       roles        => [qw/Some Roles Go Here/],
 702       cache        => 1,
 703   );
 704
 705 =item B<< $metaclass->make_immutable(%options) >>
 706
 707 This overrides the parent's method to add a few options. Specifically,
 708 it uses the Moose-specific constructor and destructor classes, and
 709 enables inlining the destructor.
 710
 711 Also, since Moose always inlines attributes, it sets the
 712 C<inline_accessors> option to false.
 713
 714 =item B<< $metaclass->new_object(%params) >>
 715
 716 This overrides the parent's method in order to add support for
 717 attribute triggers.
 718
 719 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 720
 721 This adds an C<override> method modifier to the package.
 722
 723 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 724
 725 This adds an C<augment> method modifier to the package.
 726
 727 =item B<< $metaclass->calculate_all_roles >>
 728
 729 This will return a unique array of C<Moose::Meta::Role> instances
 730 which are attached to this class.
 731
 732 =item B<< $metaclass->add_role($role) >>
 733
 734 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 735 list of roles. This I<does not> actually apply the role to the class.
 736
 737 =item B<< $metaclass->role_applications >>
 738
 739 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 740 objects, which contain the arguments to role application.
 741
 742 =item B<< $metaclass->add_role_application($application) >>
 743
 744 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 745 adds it to the class's list of role applications. This I<does not>
 746 actually apply any role to the class; it is only for tracking role
 747 applications.
 748
 749 =item B<< $metaclass->does_role($role_name) >>
 750
 751 This returns a boolean indicating whether or not the class does the
 752 specified role. This tests both the class and its parents.
 753
 754 =item B<< $metaclass->excludes_role($role_name) >>
 755
 756 A class excludes a role if it has already composed a role which
 757 excludes the named role. This tests both the class and its parents.
 758
 759 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 760
 761 This overrides the parent's method in order to allow the parameters to
 762 be provided as a hash reference.
 763
 764 =item B<< $metaclass->constructor_class ($class_name) >>
 765
 766 =item B<< $metaclass->destructor_class ($class_name) >>
 767
 768 These are the names of classes used when making a class
 769 immutable. These default to L<Moose::Meta::Method::Constructor> and
 770 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 771 read-write, so you can use them to change the class name.
 772
 773 =item B<< $metaclass->error_class($class_name) >>
 774
 775 The name of the class used to throw errors. This defaults to
 776 L<Moose::Error::Default>, which generates an error with a stacktrace
 777 just like C<Carp::confess>.
 778
 779 =item B<< $metaclass->throw_error($message, %extra) >>
 780
 781 Throws the error created by C<create_error> using C<raise_error>
 782
 783 =back
 784
 785 =head1 BUGS
 786
 787 All complex software has bugs lurking in it, and this module is no
 788 exception. If you find a bug please either email me, or add the bug
 789 to cpan-RT.
 790
 791 =head1 AUTHOR
 792
 793 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 794
 795 =head1 COPYRIGHT AND LICENSE
 796
 797 Copyright 2006-2009 by Infinity Interactive, Inc.
 798
 799 L<http://www.iinteractive.com>
 800
 801 This library is free software; you can redistribute it and/or modify
 802 it under the same terms as Perl itself.
 803
 804 =cut
 805