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