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.93_03';
  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 reinitialize {
  72     my $self = shift;
  73     my $pkg  = shift;
  74
  75     my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
  76
  77     my %existing_classes;
  78     if ($meta) {
  79         %existing_classes = map { $_ => $meta->$_() } qw(
  80             attribute_metaclass
  81             method_metaclass
  82             wrapped_method_metaclass
  83             instance_metaclass
  84             constructor_class
  85             destructor_class
  86             error_class
  87         );
  88     }
  89
  90     return $self->SUPER::reinitialize(
  91         $pkg,
  92         %existing_classes,
  93         @_,
  94     );
  95 }
  96
  97 sub _immutable_options {
  98     my ( $self, @args ) = @_;
  99
 100     $self->SUPER::_immutable_options(
 101         inline_destructor => 1,
 102
 103         # Moose always does this when an attribute is created
 104         inline_accessors => 0,
 105
 106         @args,
 107     );
 108 }
 109
 110 sub create {
 111     my ($self, $package_name, %options) = @_;
 112
 113     (ref $options{roles} eq 'ARRAY')
 114         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
 115             if exists $options{roles};
 116     my $roles = delete $options{roles};
 117
 118     my $class = $self->SUPER::create($package_name, %options);
 119
 120     if ($roles) {
 121         Moose::Util::apply_all_roles( $class, @$roles );
 122     }
 123
 124     return $class;
 125 }
 126
 127 sub _check_metaclass_compatibility {
 128     my $self = shift;
 129
 130     if ( my @supers = $self->superclasses ) {
 131         $self->_fix_metaclass_incompatibility(@supers);
 132     }
 133
 134     $self->SUPER::_check_metaclass_compatibility(@_);
 135 }
 136
 137 my %ANON_CLASSES;
 138
 139 sub create_anon_class {
 140     my ($self, %options) = @_;
 141
 142     my $cache_ok = delete $options{cache};
 143
 144     # something like Super::Class|Super::Class::2=Role|Role::1
 145     my $cache_key = join '=' => (
 146         join('|', @{$options{superclasses} || []}),
 147         join('|', sort @{$options{roles}   || []}),
 148     );
 149
 150     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
 151         return $ANON_CLASSES{$cache_key};
 152     }
 153
 154     my $new_class = $self->SUPER::create_anon_class(%options);
 155
 156     $ANON_CLASSES{$cache_key} = $new_class
 157         if $cache_ok;
 158
 159     return $new_class;
 160 }
 161
 162 sub add_role {
 163     my ($self, $role) = @_;
 164     (blessed($role) && $role->isa('Moose::Meta::Role'))
 165         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 166     push @{$self->roles} => $role;
 167 }
 168
 169 sub role_applications {
 170     my ($self) = @_;
 171
 172     return @{$self->_get_role_applications};
 173 }
 174
 175 sub add_role_application {
 176     my ($self, $application) = @_;
 177     (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
 178         || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
 179     push @{$self->_get_role_applications} => $application;
 180 }
 181
 182 sub calculate_all_roles {
 183     my $self = shift;
 184     my %seen;
 185     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 186 }
 187
 188 sub does_role {
 189     my ($self, $role_name) = @_;
 190
 191     (defined $role_name)
 192         || $self->throw_error("You must supply a role name to look for");
 193
 194     foreach my $class ($self->class_precedence_list) {
 195         my $meta = Class::MOP::class_of($class);
 196         # when a Moose metaclass is itself extended with a role,
 197         # this check needs to be done since some items in the
 198         # class_precedence_list might in fact be Class::MOP
 199         # based still.
 200         next unless $meta && $meta->can('roles');
 201         foreach my $role (@{$meta->roles}) {
 202             return 1 if $role->does_role($role_name);
 203         }
 204     }
 205     return 0;
 206 }
 207
 208 sub excludes_role {
 209     my ($self, $role_name) = @_;
 210
 211     (defined $role_name)
 212         || $self->throw_error("You must supply a role name to look for");
 213
 214     foreach my $class ($self->class_precedence_list) {
 215         my $meta = Class::MOP::class_of($class);
 216         # when a Moose metaclass is itself extended with a role,
 217         # this check needs to be done since some items in the
 218         # class_precedence_list might in fact be Class::MOP
 219         # based still.
 220         next unless $meta && $meta->can('roles');
 221         foreach my $role (@{$meta->roles}) {
 222             return 1 if $role->excludes_role($role_name);
 223         }
 224     }
 225     return 0;
 226 }
 227
 228 sub new_object {
 229     my $class  = shift;
 230     my $params = @_ == 1 ? $_[0] : {@_};
 231     my $self   = $class->SUPER::new_object($params);
 232
 233     foreach my $attr ( $class->get_all_attributes() ) {
 234
 235         next unless $attr->can('has_trigger') && $attr->has_trigger;
 236
 237         my $init_arg = $attr->init_arg;
 238
 239         next unless defined $init_arg;
 240
 241         next unless exists $params->{$init_arg};
 242
 243         $attr->trigger->(
 244             $self,
 245             (
 246                   $attr->should_coerce
 247                 ? $attr->get_read_method_ref->($self)
 248                 : $params->{$init_arg}
 249             ),
 250         );
 251     }
 252
 253     return $self;
 254 }
 255
 256 sub superclasses {
 257     my $self = shift;
 258     my @supers = @_;
 259     foreach my $super (@supers) {
 260         Class::MOP::load_class($super);
 261         my $meta = Class::MOP::class_of($super);
 262         $self->throw_error("You cannot inherit from a Moose Role ($super)")
 263             if $meta && $meta->isa('Moose::Meta::Role')
 264     }
 265     return $self->SUPER::superclasses(@supers);
 266 }
 267
 268 ### ---------------------------------------------
 269
 270 sub add_attribute {
 271     my $self = shift;
 272     my $attr =
 273         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 274             ? $_[0]
 275             : $self->_process_attribute(@_));
 276     $self->SUPER::add_attribute($attr);
 277     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 278     # 'bare' and doesn't implement this method
 279     if ($attr->can('_check_associated_methods')) {
 280         $attr->_check_associated_methods;
 281     }
 282     return $attr;
 283 }
 284
 285 sub add_override_method_modifier {
 286     my ($self, $name, $method, $_super_package) = @_;
 287
 288     (!$self->has_method($name))
 289         || $self->throw_error("Cannot add an override method if a local method is already present");
 290
 291     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 292         method  => $method,
 293         class   => $self,
 294         package => $_super_package, # need this for roles
 295         name    => $name,
 296     ));
 297 }
 298
 299 sub add_augment_method_modifier {
 300     my ($self, $name, $method) = @_;
 301     (!$self->has_method($name))
 302         || $self->throw_error("Cannot add an augment method if a local method is already present");
 303
 304     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 305         method  => $method,
 306         class   => $self,
 307         name    => $name,
 308     ));
 309 }
 310
 311 ## Private Utility methods ...
 312
 313 sub _find_next_method_by_name_which_is_not_overridden {
 314     my ($self, $name) = @_;
 315     foreach my $method ($self->find_all_methods_by_name($name)) {
 316         return $method->{code}
 317             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 318     }
 319     return undef;
 320 }
 321
 322 sub _fix_metaclass_incompatibility {
 323     my ($self, @superclasses) = @_;
 324
 325     $self->_fix_one_incompatible_metaclass($_)
 326         for map { Moose::Meta::Class->initialize($_) } @superclasses;
 327 }
 328
 329 sub _fix_one_incompatible_metaclass {
 330     my ($self, $meta) = @_;
 331
 332     return if $self->_superclass_meta_is_compatible($meta);
 333
 334     unless ( $self->is_pristine ) {
 335         $self->throw_error(
 336               "Cannot attempt to reinitialize metaclass for "
 337             . $self->name
 338             . ", it isn't pristine" );
 339     }
 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 roles
 681 that the class does, each optionally followed by a hashref of options
 682 (C<-excludes> and C<-alias>).
 683
 684   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 685
 686 =item B<< Moose::Meta::Class->create_anon_class >>
 687
 688 This overrides the parent's method to accept a C<roles> option, just
 689 as C<create> does.
 690
 691 It also accepts a C<cache> option. If this is true, then the anonymous
 692 class will be cached based on its superclasses and roles. If an
 693 existing anonymous class in the cache has the same superclasses and
 694 roles, it will be reused.
 695
 696   my $metaclass = Moose::Meta::Class->create_anon_class(
 697       superclasses => ['Foo'],
 698       roles        => [qw/Some Roles Go Here/],
 699       cache        => 1,
 700   );
 701
 702 =item B<< $metaclass->make_immutable(%options) >>
 703
 704 This overrides the parent's method to add a few options. Specifically,
 705 it uses the Moose-specific constructor and destructor classes, and
 706 enables inlining the destructor.
 707
 708 Also, since Moose always inlines attributes, it sets the
 709 C<inline_accessors> option to false.
 710
 711 =item B<< $metaclass->new_object(%params) >>
 712
 713 This overrides the parent's method in order to add support for
 714 attribute triggers.
 715
 716 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 717
 718 This adds an C<override> method modifier to the package.
 719
 720 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 721
 722 This adds an C<augment> method modifier to the package.
 723
 724 =item B<< $metaclass->calculate_all_roles >>
 725
 726 This will return a unique array of C<Moose::Meta::Role> instances
 727 which are attached to this class.
 728
 729 =item B<< $metaclass->add_role($role) >>
 730
 731 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 732 list of roles. This I<does not> actually apply the role to the class.
 733
 734 =item B<< $metaclass->role_applications >>
 735
 736 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 737 objects, which contain the arguments to role application.
 738
 739 =item B<< $metaclass->add_role_application($application) >>
 740
 741 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 742 adds it to the class's list of role applications. This I<does not>
 743 actually apply any role to the class; it is only for tracking role
 744 applications.
 745
 746 =item B<< $metaclass->does_role($role) >>
 747
 748 This returns a boolean indicating whether or not the class does the specified
 749 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 750 object. This tests both the class and its parents.
 751
 752 =item B<< $metaclass->excludes_role($role_name) >>
 753
 754 A class excludes a role if it has already composed a role which
 755 excludes the named role. This tests both the class and its parents.
 756
 757 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 758
 759 This overrides the parent's method in order to allow the parameters to
 760 be provided as a hash reference.
 761
 762 =item B<< $metaclass->constructor_class ($class_name) >>
 763
 764 =item B<< $metaclass->destructor_class ($class_name) >>
 765
 766 These are the names of classes used when making a class
 767 immutable. These default to L<Moose::Meta::Method::Constructor> and
 768 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 769 read-write, so you can use them to change the class name.
 770
 771 =item B<< $metaclass->error_class($class_name) >>
 772
 773 The name of the class used to throw errors. This defaults to
 774 L<Moose::Error::Default>, which generates an error with a stacktrace
 775 just like C<Carp::confess>.
 776
 777 =item B<< $metaclass->throw_error($message, %extra) >>
 778
 779 Throws the error created by C<create_error> using C<raise_error>
 780
 781 =back
 782
 783 =head1 BUGS
 784
 785 See L<Moose/BUGS> for details on reporting bugs.
 786
 787 =head1 AUTHOR
 788
 789 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 790
 791 =head1 COPYRIGHT AND LICENSE
 792
 793 Copyright 2006-2010 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