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