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