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