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     my @roles = $meta->can('calculate_all_roles_with_inheritance')
 470                     ? $meta->calculate_all_roles_with_inheritance
 471                     : ();
 472
 473     # loop over all methods that are a part of the current class
 474     # (not inherited)
 475     for my $method ( $meta->_get_local_methods ) {
 476         # always ignore meta
 477         next if $method->name eq 'meta';
 478         # we'll deal with attributes below
 479         next if $method->can('associated_attribute');
 480         # if the method comes from a role we consumed, ignore it
 481         next if $meta->can('does_role')
 482              && $meta->does_role($method->original_package_name);
 483         # FIXME - this really isn't right. Just because a modifier is
 484         # defined in a role doesn't mean it isn't _also_ defined in the
 485         # subclass.
 486         next if $method->isa('Class::MOP::Method::Wrapped')
 487              && (
 488                  (!scalar($method->around_modifiers)
 489                || any { $_->has_around_method_modifiers($method->name) } @roles)
 490               && (!scalar($method->before_modifiers)
 491                || any { $_->has_before_method_modifiers($method->name) } @roles)
 492               && (!scalar($method->after_modifiers)
 493                || any { $_->has_after_method_modifiers($method->name) } @roles)
 494                 );
 495
 496         return 0;
 497     }
 498
 499     # loop over all attributes that are a part of the current class
 500     # (not inherited)
 501     # FIXME - this really isn't right. Just because an attribute is
 502     # defined in a role doesn't mean it isn't _also_ defined in the
 503     # subclass.
 504     for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
 505         next if any { $_->has_attribute($attr->name) } @roles;
 506
 507         return 0;
 508     }
 509
 510     return 1;
 511 }
 512
 513 sub _fix_class_metaclass_incompatibility {
 514     my $self = shift;
 515     my ($super_meta) = @_;
 516
 517     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 518
 519     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 520         ($self->is_pristine)
 521             || confess "Can't fix metaclass incompatibility for "
 522                      . $self->name
 523                      . " because it is not pristine.";
 524         my $super_meta_name = $super_meta->_real_ref_name;
 525         my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 526         my $new_self = $class_meta_subclass_meta_name->reinitialize(
 527             $self->name,
 528         );
 529
 530         $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
 531     }
 532 }
 533
 534 sub _fix_single_metaclass_incompatibility {
 535     my $self = shift;
 536     my ($metaclass_type, $super_meta) = @_;
 537
 538     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 539
 540     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 541         ($self->is_pristine)
 542             || confess "Can't fix metaclass incompatibility for "
 543                      . $self->name
 544                      . " because it is not pristine.";
 545         my $super_meta_name = $super_meta->_real_ref_name;
 546         my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 547         my $new_self = $super_meta->reinitialize(
 548             $self->name,
 549             $metaclass_type => $class_specific_meta_subclass_meta_name,
 550         );
 551
 552         $self->_replace_self( $new_self, $super_meta_name );
 553     }
 554 }
 555
 556 sub _replace_self {
 557     my $self      = shift;
 558     my ( $new_self, $new_class)   = @_;
 559
 560     %$self = %$new_self;
 561     bless $self, $new_class;
 562
 563     # We need to replace the cached metaclass instance or else when it goes
 564     # out of scope Class::MOP::Class destroy's the namespace for the
 565     # metaclass's class, causing much havoc.
 566     Class::MOP::store_metaclass_by_name( $self->name, $self );
 567     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 568 }
 569
 570 sub _get_compatible_single_metaclass {
 571     my $self = shift;
 572
 573     return $self->SUPER::_get_compatible_single_metaclass(@_)
 574         || $self->_get_compatible_single_metaclass_by_role_reconciliation(@_);
 575 }
 576
 577 sub _get_compatible_single_metaclass_by_role_reconciliation {
 578     my $self = shift;
 579     my ($single_meta_name) = @_;
 580
 581     my $current_single_meta_name = $self->_get_associated_single_metaclass($single_meta_name);
 582
 583     return Moose::Util::_reconcile_roles_for_metaclass($single_meta_name, $current_single_meta_name);
 584 }
 585
 586 sub _process_attribute {
 587     my ( $self, $name, @args ) = @_;
 588
 589     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 590
 591     if (($name || '') =~ /^\+(.*)/) {
 592         return $self->_process_inherited_attribute($1, @args);
 593     }
 594     else {
 595         return $self->_process_new_attribute($name, @args);
 596     }
 597 }
 598
 599 sub _process_new_attribute {
 600     my ( $self, $name, @args ) = @_;
 601
 602     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 603 }
 604
 605 sub _process_inherited_attribute {
 606     my ($self, $attr_name, %options) = @_;
 607     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 608     (defined $inherited_attr)
 609         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 610     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 611         return $inherited_attr->clone_and_inherit_options(%options);
 612     }
 613     else {
 614         # NOTE:
 615         # kind of a kludge to handle Class::MOP::Attributes
 616         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 617     }
 618 }
 619
 620 ## Immutability
 621
 622 sub _immutable_options {
 623     my ( $self, @args ) = @_;
 624
 625     $self->SUPER::_immutable_options(
 626         inline_destructor => 1,
 627
 628         # Moose always does this when an attribute is created
 629         inline_accessors => 0,
 630
 631         @args,
 632     );
 633 }
 634
 635 ## -------------------------------------------------
 636
 637 our $error_level;
 638
 639 sub throw_error {
 640     my ( $self, @args ) = @_;
 641     local $error_level = ($error_level || 0) + 1;
 642     $self->raise_error($self->create_error(@args));
 643 }
 644
 645 sub raise_error {
 646     my ( $self, @args ) = @_;
 647     die @args;
 648 }
 649
 650 sub create_error {
 651     my ( $self, @args ) = @_;
 652
 653     require Carp::Heavy;
 654
 655     local $error_level = ($error_level || 0 ) + 1;
 656
 657     if ( @args % 2 == 1 ) {
 658         unshift @args, "message";
 659     }
 660
 661     my %args = ( metaclass => $self, last_error => $@, @args );
 662
 663     $args{depth} += $error_level;
 664
 665     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 666
 667     Class::MOP::load_class($class);
 668
 669     $class->new(
 670         Carp::caller_info($args{depth}),
 671         %args
 672     );
 673 }
 674
 675 1;
 676
 677 __END__
 678
 679 =pod
 680
 681 =head1 NAME
 682
 683 Moose::Meta::Class - The Moose metaclass
 684
 685 =head1 DESCRIPTION
 686
 687 This class is a subclass of L<Class::MOP::Class> that provides
 688 additional Moose-specific functionality.
 689
 690 To really understand this class, you will need to start with the
 691 L<Class::MOP::Class> documentation. This class can be understood as a
 692 set of additional features on top of the basic feature provided by
 693 that parent class.
 694
 695 =head1 INHERITANCE
 696
 697 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 698
 699 =head1 METHODS
 700
 701 =over 4
 702
 703 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 704
 705 This overrides the parent's method in order to provide its own
 706 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 707 C<method_metaclass> options.
 708
 709 These all default to the appropriate Moose class.
 710
 711 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 712
 713 This overrides the parent's method in order to accept a C<roles>
 714 option. This should be an array reference containing roles
 715 that the class does, each optionally followed by a hashref of options
 716 (C<-excludes> and C<-alias>).
 717
 718   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 719
 720 =item B<< Moose::Meta::Class->create_anon_class >>
 721
 722 This overrides the parent's method to accept a C<roles> option, just
 723 as C<create> does.
 724
 725 It also accepts a C<cache> option. If this is true, then the anonymous
 726 class will be cached based on its superclasses and roles. If an
 727 existing anonymous class in the cache has the same superclasses and
 728 roles, it will be reused.
 729
 730   my $metaclass = Moose::Meta::Class->create_anon_class(
 731       superclasses => ['Foo'],
 732       roles        => [qw/Some Roles Go Here/],
 733       cache        => 1,
 734   );
 735
 736 Each entry in both the C<superclasses> and the C<roles> option can be
 737 followed by a hash reference with arguments. The C<superclasses>
 738 option can be supplied with a L<-version|Class::MOP/Class Loading
 739 Options> option that ensures the loaded superclass satisfies the
 740 required version. The C<role> option also takes the C<-version> as an
 741 argument, but the option hash reference can also contain any other
 742 role relevant values like exclusions or parameterized role arguments.
 743
 744 =item B<< $metaclass->make_immutable(%options) >>
 745
 746 This overrides the parent's method to add a few options. Specifically,
 747 it uses the Moose-specific constructor and destructor classes, and
 748 enables inlining the destructor.
 749
 750 Since Moose always inlines attributes, it sets the C<inline_accessors> option
 751 to false.
 752
 753 =item B<< $metaclass->new_object(%params) >>
 754
 755 This overrides the parent's method in order to add support for
 756 attribute triggers.
 757
 758 =item B<< $metaclass->superclasses(@superclasses) >>
 759
 760 This is the accessor allowing you to read or change the parents of
 761 the class.
 762
 763 Each superclass can be followed by a hash reference containing a
 764 L<-version|Class::MOP/Class Loading Options> value. If the version
 765 requirement is not satisfied an error will be thrown.
 766
 767 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 768
 769 This adds an C<override> method modifier to the package.
 770
 771 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 772
 773 This adds an C<augment> method modifier to the package.
 774
 775 =item B<< $metaclass->calculate_all_roles >>
 776
 777 This will return a unique array of C<Moose::Meta::Role> instances
 778 which are attached to this class.
 779
 780 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 781
 782 This will return a unique array of C<Moose::Meta::Role> instances
 783 which are attached to this class, and each of this class's ancestors.
 784
 785 =item B<< $metaclass->add_role($role) >>
 786
 787 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 788 list of roles. This I<does not> actually apply the role to the class.
 789
 790 =item B<< $metaclass->role_applications >>
 791
 792 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 793 objects, which contain the arguments to role application.
 794
 795 =item B<< $metaclass->add_role_application($application) >>
 796
 797 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 798 adds it to the class's list of role applications. This I<does not>
 799 actually apply any role to the class; it is only for tracking role
 800 applications.
 801
 802 =item B<< $metaclass->does_role($role) >>
 803
 804 This returns a boolean indicating whether or not the class does the specified
 805 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 806 object. This tests both the class and its parents.
 807
 808 =item B<< $metaclass->excludes_role($role_name) >>
 809
 810 A class excludes a role if it has already composed a role which
 811 excludes the named role. This tests both the class and its parents.
 812
 813 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 814
 815 This overrides the parent's method in order to allow the parameters to
 816 be provided as a hash reference.
 817
 818 =item B<< $metaclass->constructor_class($class_name) >>
 819
 820 =item B<< $metaclass->destructor_class($class_name) >>
 821
 822 These are the names of classes used when making a class immutable. These
 823 default to L<Moose::Meta::Method::Constructor> and
 824 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 825 read-write, so you can use them to change the class name.
 826
 827 =item B<< $metaclass->error_class($class_name) >>
 828
 829 The name of the class used to throw errors. This defaults to
 830 L<Moose::Error::Default>, which generates an error with a stacktrace
 831 just like C<Carp::confess>.
 832
 833 =item B<< $metaclass->throw_error($message, %extra) >>
 834
 835 Throws the error created by C<create_error> using C<raise_error>
 836
 837 =back
 838
 839 =head1 BUGS
 840
 841 See L<Moose/BUGS> for details on reporting bugs.
 842
 843 =head1 AUTHOR
 844
 845 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 846
 847 =head1 COPYRIGHT AND LICENSE
 848
 849 Copyright 2006-2010 by Infinity Interactive, Inc.
 850
 851 L<http://www.iinteractive.com>
 852
 853 This library is free software; you can redistribute it and/or modify
 854 it under the same terms as Perl itself.
 855
 856 =cut
 857