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