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 Data::OptList;
  11 use List::Util qw( first );
  12 use List::MoreUtils qw( any all uniq first_index );
  13 use Scalar::Util 'weaken', 'blessed';
  14
  15 our $VERSION   = '1.04';
  16 $VERSION = eval $VERSION;
  17 our $AUTHORITY = 'cpan:STEVAN';
  18
  19 use Moose::Meta::Method::Overridden;
  20 use Moose::Meta::Method::Augmented;
  21 use Moose::Error::Default;
  22 use Moose::Meta::Class::Immutable::Trait;
  23 use Moose::Meta::Method::Constructor;
  24 use Moose::Meta::Method::Destructor;
  25
  26 use base 'Class::MOP::Class';
  27
  28 __PACKAGE__->meta->add_attribute('roles' => (
  29     reader  => 'roles',
  30     default => sub { [] }
  31 ));
  32
  33 __PACKAGE__->meta->add_attribute('role_applications' => (
  34     reader  => '_get_role_applications',
  35     default => sub { [] }
  36 ));
  37
  38 __PACKAGE__->meta->add_attribute(
  39     Class::MOP::Attribute->new('immutable_trait' => (
  40         accessor => "immutable_trait",
  41         default  => 'Moose::Meta::Class::Immutable::Trait',
  42     ))
  43 );
  44
  45 __PACKAGE__->meta->add_attribute('constructor_class' => (
  46     accessor => 'constructor_class',
  47     default  => 'Moose::Meta::Method::Constructor',
  48 ));
  49
  50 __PACKAGE__->meta->add_attribute('destructor_class' => (
  51     accessor => 'destructor_class',
  52     default  => 'Moose::Meta::Method::Destructor',
  53 ));
  54
  55 __PACKAGE__->meta->add_attribute('error_class' => (
  56     accessor => 'error_class',
  57     default  => 'Moose::Error::Default',
  58 ));
  59
  60 sub initialize {
  61     my $class = shift;
  62     my $pkg   = shift;
  63     return Class::MOP::get_metaclass_by_name($pkg)
  64         || $class->SUPER::initialize($pkg,
  65                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  66                 'method_metaclass'    => 'Moose::Meta::Method',
  67                 'instance_metaclass'  => 'Moose::Meta::Instance',
  68                 @_
  69             );
  70 }
  71
  72 sub _immutable_options {
  73     my ( $self, @args ) = @_;
  74
  75     $self->SUPER::_immutable_options(
  76         inline_destructor => 1,
  77
  78         # Moose always does this when an attribute is created
  79         inline_accessors => 0,
  80
  81         @args,
  82     );
  83 }
  84
  85 sub create {
  86     my ($class, $package_name, %options) = @_;
  87
  88     (ref $options{roles} eq 'ARRAY')
  89         || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  90             if exists $options{roles};
  91     my $roles = delete $options{roles};
  92
  93     my $new_meta = $class->SUPER::create($package_name, %options);
  94
  95     if ($roles) {
  96         Moose::Util::apply_all_roles( $new_meta, @$roles );
  97     }
  98
  99     return $new_meta;
 100 }
 101
 102 my %ANON_CLASSES;
 103
 104 sub create_anon_class {
 105     my ($self, %options) = @_;
 106
 107     my $cache_ok = delete $options{cache};
 108
 109     my $cache_key
 110         = _anon_cache_key( $options{superclasses}, $options{roles} );
 111
 112     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
 113         return $ANON_CLASSES{$cache_key};
 114     }
 115
 116     my $new_class = $self->SUPER::create_anon_class(%options);
 117
 118     $ANON_CLASSES{$cache_key} = $new_class
 119         if $cache_ok;
 120
 121     return $new_class;
 122 }
 123
 124 sub _anon_cache_key {
 125     # Makes something like Super::Class|Super::Class::2=Role|Role::1
 126     return join '=' => (
 127         join( '|', @{ $_[0]      || [] } ),
 128         join( '|', sort @{ $_[1] || [] } ),
 129     );
 130 }
 131
 132 sub reinitialize {
 133     my $self = shift;
 134     my $pkg  = shift;
 135
 136     my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
 137
 138     my $cache_key;
 139
 140     my %existing_classes;
 141     if ($meta) {
 142         %existing_classes = map { $_ => $meta->$_() } qw(
 143             attribute_metaclass
 144             method_metaclass
 145             wrapped_method_metaclass
 146             instance_metaclass
 147             constructor_class
 148             destructor_class
 149             error_class
 150         );
 151
 152         $cache_key = _anon_cache_key(
 153             [ $meta->superclasses ],
 154             [ map { $_->name } @{ $meta->roles } ],
 155         ) if $meta->is_anon_class;
 156     }
 157
 158     my $new_meta = $self->SUPER::reinitialize(
 159         $pkg,
 160         %existing_classes,
 161         @_,
 162     );
 163
 164     return $new_meta unless defined $cache_key;
 165
 166     my $new_cache_key = _anon_cache_key(
 167         [ $meta->superclasses ],
 168         [ map { $_->name } @{ $meta->roles } ],
 169     );
 170
 171     delete $ANON_CLASSES{$cache_key};
 172     $ANON_CLASSES{$new_cache_key} = $new_meta;
 173
 174     return $new_meta;
 175 }
 176
 177 sub add_role {
 178     my ($self, $role) = @_;
 179     (blessed($role) && $role->isa('Moose::Meta::Role'))
 180         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 181     push @{$self->roles} => $role;
 182 }
 183
 184 sub role_applications {
 185     my ($self) = @_;
 186
 187     return @{$self->_get_role_applications};
 188 }
 189
 190 sub add_role_application {
 191     my ($self, $application) = @_;
 192     (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
 193         || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
 194     push @{$self->_get_role_applications} => $application;
 195 }
 196
 197 sub calculate_all_roles {
 198     my $self = shift;
 199     my %seen;
 200     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 201 }
 202
 203 sub does_role {
 204     my ($self, $role_name) = @_;
 205
 206     (defined $role_name)
 207         || $self->throw_error("You must supply a role name to look for");
 208
 209     foreach my $class ($self->class_precedence_list) {
 210         my $meta = Class::MOP::class_of($class);
 211         # when a Moose metaclass is itself extended with a role,
 212         # this check needs to be done since some items in the
 213         # class_precedence_list might in fact be Class::MOP
 214         # based still.
 215         next unless $meta && $meta->can('roles');
 216         foreach my $role (@{$meta->roles}) {
 217             return 1 if $role->does_role($role_name);
 218         }
 219     }
 220     return 0;
 221 }
 222
 223 sub excludes_role {
 224     my ($self, $role_name) = @_;
 225
 226     (defined $role_name)
 227         || $self->throw_error("You must supply a role name to look for");
 228
 229     foreach my $class ($self->class_precedence_list) {
 230         my $meta = Class::MOP::class_of($class);
 231         # when a Moose metaclass is itself extended with a role,
 232         # this check needs to be done since some items in the
 233         # class_precedence_list might in fact be Class::MOP
 234         # based still.
 235         next unless $meta && $meta->can('roles');
 236         foreach my $role (@{$meta->roles}) {
 237             return 1 if $role->excludes_role($role_name);
 238         }
 239     }
 240     return 0;
 241 }
 242
 243 sub new_object {
 244     my $self   = shift;
 245     my $params = @_ == 1 ? $_[0] : {@_};
 246     my $object = $self->SUPER::new_object($params);
 247
 248     foreach my $attr ( $self->get_all_attributes() ) {
 249
 250         next unless $attr->can('has_trigger') && $attr->has_trigger;
 251
 252         my $init_arg = $attr->init_arg;
 253
 254         next unless defined $init_arg;
 255
 256         next unless exists $params->{$init_arg};
 257
 258         $attr->trigger->(
 259             $object,
 260             (
 261                   $attr->should_coerce
 262                 ? $attr->get_read_method_ref->($object)
 263                 : $params->{$init_arg}
 264             ),
 265         );
 266     }
 267
 268     $object->BUILDALL($params) if $object->can('BUILDALL');
 269
 270     return $object;
 271 }
 272
 273 sub superclasses {
 274     my $self = shift;
 275     my $supers = Data::OptList::mkopt(\@_);
 276     foreach my $super (@{ $supers }) {
 277         my ($name, $opts) = @{ $super };
 278         Class::MOP::load_class($name, $opts);
 279         my $meta = Class::MOP::class_of($name);
 280         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 281             if $meta && $meta->isa('Moose::Meta::Role')
 282     }
 283     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 284 }
 285
 286 ### ---------------------------------------------
 287
 288 sub add_attribute {
 289     my $self = shift;
 290     my $attr =
 291         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 292             ? $_[0]
 293             : $self->_process_attribute(@_));
 294     $self->SUPER::add_attribute($attr);
 295     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 296     # 'bare' and doesn't implement this method
 297     if ($attr->can('_check_associated_methods')) {
 298         $attr->_check_associated_methods;
 299     }
 300     return $attr;
 301 }
 302
 303 sub add_override_method_modifier {
 304     my ($self, $name, $method, $_super_package) = @_;
 305
 306     (!$self->has_method($name))
 307         || $self->throw_error("Cannot add an override method if a local method is already present");
 308
 309     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 310         method  => $method,
 311         class   => $self,
 312         package => $_super_package, # need this for roles
 313         name    => $name,
 314     ));
 315 }
 316
 317 sub add_augment_method_modifier {
 318     my ($self, $name, $method) = @_;
 319     (!$self->has_method($name))
 320         || $self->throw_error("Cannot add an augment method if a local method is already present");
 321
 322     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 323         method  => $method,
 324         class   => $self,
 325         name    => $name,
 326     ));
 327 }
 328
 329 ## Private Utility methods ...
 330
 331 sub _find_next_method_by_name_which_is_not_overridden {
 332     my ($self, $name) = @_;
 333     foreach my $method ($self->find_all_methods_by_name($name)) {
 334         return $method->{code}
 335             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 336     }
 337     return undef;
 338 }
 339
 340 ## Metaclass compatibility
 341
 342 sub _base_metaclasses {
 343     my $self = shift;
 344     my %metaclasses = $self->SUPER::_base_metaclasses;
 345     for my $class (keys %metaclasses) {
 346         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 347     }
 348     return (
 349         %metaclasses,
 350         error_class => 'Moose::Error::Default',
 351     );
 352 }
 353
 354 sub _find_common_base {
 355     my $self = shift;
 356     my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
 357     return unless defined($meta1) && defined($meta2);
 358
 359     # FIXME? This doesn't account for multiple inheritance (not sure
 360     # if it needs to though). For example, is somewhere in $meta1's
 361     # history it inherits from both ClassA and ClassB, and $meta2
 362     # inherits from ClassB & ClassA, does it matter? And what crazy
 363     # fool would do that anyway?
 364
 365     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 366
 367     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 368 }
 369
 370 sub _get_ancestors_until {
 371     my $self = shift;
 372     my ($start_name, $until_name) = @_;
 373
 374     my @ancestor_names;
 375     for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) {
 376         last if $ancestor_name eq $until_name;
 377         push @ancestor_names, $ancestor_name;
 378     }
 379     return @ancestor_names;
 380 }
 381
 382 sub _is_role_only_subclass {
 383     my $self = shift;
 384     my ($meta_name) = @_;
 385     my $meta = Class::MOP::Class->initialize($meta_name);
 386     my @parent_names = $meta->superclasses;
 387
 388     # XXX: don't feel like messing with multiple inheritance here... what would
 389     # that even do?
 390     return unless @parent_names == 1;
 391     my ($parent_name) = @parent_names;
 392     my $parent_meta = Class::MOP::Class->initialize($parent_name);
 393
 394     # loop over all methods that are a part of the current class
 395     # (not inherited)
 396     for my $method (map { $meta->get_method($_) } $meta->get_method_list) {
 397         # always ignore meta
 398         next if $method->name eq 'meta';
 399         # we'll deal with attributes below
 400         next if $method->isa('Class::MOP::Method::Accessor');
 401         # if the method comes from a role we consumed, ignore it
 402         next if $meta->can('does_role')
 403              && $meta->does_role($method->original_package_name);
 404
 405         return 0;
 406     }
 407
 408     # loop over all attributes that are a part of the current class
 409     # (not inherited)
 410     # FIXME - this really isn't right. Just because an attribute is
 411     # defined in a role doesn't mean it isn't _also_ defined in the
 412     # subclass.
 413     for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
 414         next if any { $_->has_attribute($attr->name) }
 415                 map { $_->meta->can('calculate_all_roles')
 416                     ? $_->meta->calculate_all_roles
 417                     : () }
 418                 $meta->linearized_isa;
 419
 420         return 0;
 421     }
 422
 423     return 1;
 424 }
 425
 426 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
 427     my $self = shift;
 428     my ($super_meta) = @_;
 429
 430     my $common_base_name = $self->_find_common_base(blessed($self), blessed($super_meta));
 431     # if they're not both moose metaclasses, and the cmop fixing couldn't
 432     # do anything, there's nothing more we can do
 433     return unless defined($common_base_name);
 434     return unless $common_base_name->isa('Moose::Meta::Class');
 435
 436     my @super_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($super_meta), $common_base_name);
 437     my @class_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($self), $common_base_name);
 438     # we're only dealing with roles here
 439     return unless all { $self->_is_role_only_subclass($_) }
 440                       (@super_meta_name_ancestor_names,
 441                        @class_meta_name_ancestor_names);
 442
 443     return 1;
 444 }
 445
 446 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
 447     my $self = shift;
 448     my ($metaclass_type, $super_meta) = @_;
 449
 450     my $class_specific_meta_name = $self->$metaclass_type;
 451     return unless $super_meta->can($metaclass_type);
 452     my $super_specific_meta_name = $super_meta->$metaclass_type;
 453     my %metaclasses = $self->_base_metaclasses;
 454
 455     my $common_base_name = $self->_find_common_base($class_specific_meta_name, $super_specific_meta_name);
 456     # if they're not both moose metaclasses, and the cmop fixing couldn't
 457     # do anything, there's nothing more we can do
 458     return unless defined($common_base_name);
 459     return unless $common_base_name->isa($metaclasses{$metaclass_type});
 460
 461     my @super_specific_meta_name_ancestor_names = $self->_get_ancestors_until($super_specific_meta_name, $common_base_name);
 462     my @class_specific_meta_name_ancestor_names = $self->_get_ancestors_until($class_specific_meta_name, $common_base_name);
 463     # we're only dealing with roles here
 464     return unless all { $self->_is_role_only_subclass($_) }
 465                       (@super_specific_meta_name_ancestor_names,
 466                        @class_specific_meta_name_ancestor_names);
 467
 468     return 1;
 469 }
 470
 471 sub _role_differences {
 472     my $self = shift;
 473     my ($class_meta_name, $super_meta_name) = @_;
 474     my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles')
 475                          ? $super_meta_name->meta->calculate_all_roles
 476                          : ();
 477     my @role_metas       = $class_meta_name->meta->can('calculate_all_roles')
 478                          ? $class_meta_name->meta->calculate_all_roles
 479                          : ();
 480     my @differences;
 481     for my $role_meta (@role_metas) {
 482         push @differences, $role_meta
 483             unless any { $_->name eq $role_meta->name } @super_role_metas;
 484     }
 485     return @differences;
 486 }
 487
 488 sub _reconcile_roles_for_metaclass {
 489     my $self = shift;
 490     my ($class_meta_name, $super_meta_name) = @_;
 491
 492     my @role_differences = $self->_role_differences(
 493         $class_meta_name, $super_meta_name,
 494     );
 495     return $self->create_anon_class(
 496         superclasses => [$super_meta_name],
 497         roles        => \@role_differences,
 498         cache        => 1,
 499     );
 500 }
 501
 502 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
 503     my $self = shift;
 504     my ($super_meta) = @_;
 505
 506     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
 507
 508     my %base_metaclass = $self->_base_metaclasses;
 509     for my $metaclass_type (keys %base_metaclass) {
 510         next unless defined $self->$metaclass_type;
 511         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
 512     }
 513
 514     return;
 515 }
 516
 517 sub _can_fix_metaclass_incompatibility {
 518     my $self = shift;
 519     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
 520     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
 521 }
 522
 523 sub _fix_class_metaclass_incompatibility {
 524     my $self = shift;
 525     my ($super_meta) = @_;
 526
 527     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 528
 529     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 530         my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), blessed($super_meta));
 531         # XXX: this doesn't work! we're reblessing $self into a subclass of
 532         # $super_meta, not of itself... probably do need to just go ahead and
 533         # reinitialize things here
 534         $class_meta_subclass_meta->rebless_instance($self);
 535     }
 536 }
 537
 538 sub _fix_single_metaclass_incompatibility {
 539     my $self = shift;
 540     my ($metaclass_type, $super_meta) = @_;
 541
 542     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 543
 544     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 545         my %metaclasses = $self->_base_metaclasses;
 546         my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 547         $self->$metaclass_type($class_specific_meta_subclass_meta->name);
 548     }
 549 }
 550
 551 sub _process_attribute {
 552     my ( $self, $name, @args ) = @_;
 553
 554     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 555
 556     if (($name || '') =~ /^\+(.*)/) {
 557         return $self->_process_inherited_attribute($1, @args);
 558     }
 559     else {
 560         return $self->_process_new_attribute($name, @args);
 561     }
 562 }
 563
 564 sub _process_new_attribute {
 565     my ( $self, $name, @args ) = @_;
 566
 567     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 568 }
 569
 570 sub _process_inherited_attribute {
 571     my ($self, $attr_name, %options) = @_;
 572     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 573     (defined $inherited_attr)
 574         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 575     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 576         return $inherited_attr->clone_and_inherit_options(%options);
 577     }
 578     else {
 579         # NOTE:
 580         # kind of a kludge to handle Class::MOP::Attributes
 581         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 582     }
 583 }
 584
 585 ## -------------------------------------------------
 586
 587 our $error_level;
 588
 589 sub throw_error {
 590     my ( $self, @args ) = @_;
 591     local $error_level = ($error_level || 0) + 1;
 592     $self->raise_error($self->create_error(@args));
 593 }
 594
 595 sub raise_error {
 596     my ( $self, @args ) = @_;
 597     die @args;
 598 }
 599
 600 sub create_error {
 601     my ( $self, @args ) = @_;
 602
 603     require Carp::Heavy;
 604
 605     local $error_level = ($error_level || 0 ) + 1;
 606
 607     if ( @args % 2 == 1 ) {
 608         unshift @args, "message";
 609     }
 610
 611     my %args = ( metaclass => $self, last_error => $@, @args );
 612
 613     $args{depth} += $error_level;
 614
 615     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 616
 617     Class::MOP::load_class($class);
 618
 619     $class->new(
 620         Carp::caller_info($args{depth}),
 621         %args
 622     );
 623 }
 624
 625 1;
 626
 627 __END__
 628
 629 =pod
 630
 631 =head1 NAME
 632
 633 Moose::Meta::Class - The Moose metaclass
 634
 635 =head1 DESCRIPTION
 636
 637 This class is a subclass of L<Class::MOP::Class> that provides
 638 additional Moose-specific functionality.
 639
 640 To really understand this class, you will need to start with the
 641 L<Class::MOP::Class> documentation. This class can be understood as a
 642 set of additional features on top of the basic feature provided by
 643 that parent class.
 644
 645 =head1 INHERITANCE
 646
 647 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 648
 649 =head1 METHODS
 650
 651 =over 4
 652
 653 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 654
 655 This overrides the parent's method in order to provide its own
 656 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 657 C<method_metaclass> options.
 658
 659 These all default to the appropriate Moose class.
 660
 661 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 662
 663 This overrides the parent's method in order to accept a C<roles>
 664 option. This should be an array reference containing roles
 665 that the class does, each optionally followed by a hashref of options
 666 (C<-excludes> and C<-alias>).
 667
 668   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 669
 670 =item B<< Moose::Meta::Class->create_anon_class >>
 671
 672 This overrides the parent's method to accept a C<roles> option, just
 673 as C<create> does.
 674
 675 It also accepts a C<cache> option. If this is true, then the anonymous
 676 class will be cached based on its superclasses and roles. If an
 677 existing anonymous class in the cache has the same superclasses and
 678 roles, it will be reused.
 679
 680   my $metaclass = Moose::Meta::Class->create_anon_class(
 681       superclasses => ['Foo'],
 682       roles        => [qw/Some Roles Go Here/],
 683       cache        => 1,
 684   );
 685
 686 Each entry in both the C<superclasses> and the C<roles> option can be
 687 followed by a hash reference with arguments. The C<superclasses>
 688 option can be supplied with a L<-version|Class::MOP/Class Loading
 689 Options> option that ensures the loaded superclass satisfies the
 690 required version. The C<role> option also takes the C<-version> as an
 691 argument, but the option hash reference can also contain any other
 692 role relevant values like exclusions or parameterized role arguments.
 693
 694 =item B<< $metaclass->make_immutable(%options) >>
 695
 696 This overrides the parent's method to add a few options. Specifically,
 697 it uses the Moose-specific constructor and destructor classes, and
 698 enables inlining the destructor.
 699
 700 Also, since Moose always inlines attributes, it sets the
 701 C<inline_accessors> option to false.
 702
 703 =item B<< $metaclass->new_object(%params) >>
 704
 705 This overrides the parent's method in order to add support for
 706 attribute triggers.
 707
 708 =item B<< $metaclass->superclasses(@superclasses) >>
 709
 710 This is the accessor allowing you to read or change the parents of
 711 the class.
 712
 713 Each superclass can be followed by a hash reference containing a
 714 L<-version|Class::MOP/Class Loading Options> value. If the version
 715 requirement is not satisfied an error will be thrown.
 716
 717 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 718
 719 This adds an C<override> method modifier to the package.
 720
 721 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 722
 723 This adds an C<augment> method modifier to the package.
 724
 725 =item B<< $metaclass->calculate_all_roles >>
 726
 727 This will return a unique array of C<Moose::Meta::Role> instances
 728 which are attached to this class.
 729
 730 =item B<< $metaclass->add_role($role) >>
 731
 732 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 733 list of roles. This I<does not> actually apply the role to the class.
 734
 735 =item B<< $metaclass->role_applications >>
 736
 737 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 738 objects, which contain the arguments to role application.
 739
 740 =item B<< $metaclass->add_role_application($application) >>
 741
 742 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 743 adds it to the class's list of role applications. This I<does not>
 744 actually apply any role to the class; it is only for tracking role
 745 applications.
 746
 747 =item B<< $metaclass->does_role($role) >>
 748
 749 This returns a boolean indicating whether or not the class does the specified
 750 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 751 object. 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 See L<Moose/BUGS> for details on reporting bugs.
 787
 788 =head1 AUTHOR
 789
 790 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 791
 792 =head1 COPYRIGHT AND LICENSE
 793
 794 Copyright 2006-2010 by Infinity Interactive, Inc.
 795
 796 L<http://www.iinteractive.com>
 797
 798 This library is free software; you can redistribute it and/or modify
 799 it under the same terms as Perl itself.
 800
 801 =cut
 802