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