lib/Moose/Meta/Class.pm

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