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 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
 368 # through to _inline_set_value - this should probably be fixed, but i'm not
 369 # quite sure how. -doy
 370 sub _inline_init_attr_from_constructor {
 371     my $self = shift;
 372     my ($attr, $idx) = @_;
 373
 374     my @initial_value = $attr->_inline_set_value(
 375         '$instance',
 376         '$params->{\'' . $attr->init_arg . '\'}',
 377         '$type_constraint_bodies[' . $idx . ']',
 378         '$type_constraints[' . $idx . ']',
 379         'for constructor',
 380     );
 381
 382     push @initial_value, (
 383         '$attrs->[' . $idx . ']->set_initial_value(',
 384             '$instance,',
 385             $attr->_inline_instance_get('$instance'),
 386         ');',
 387     ) if $attr->has_initializer;
 388
 389     return @initial_value;
 390 }
 391
 392 sub _inline_init_attr_from_default {
 393     my $self = shift;
 394     my ($attr, $idx) = @_;
 395
 396     my $default = $self->_inline_default_value($attr, $idx);
 397     return unless $default;
 398
 399     my @initial_value = (
 400         'my $default = ' . $default . ';',
 401         $attr->_inline_set_value(
 402             '$instance',
 403             '$default',
 404             '$type_constraint_bodies[' . $idx . ']',
 405             '$type_constraints[' . $idx . ']',
 406             'for constructor',
 407         ),
 408     );
 409
 410     push @initial_value, (
 411         '$attrs->[' . $idx . ']->set_initial_value(',
 412             '$instance,',
 413             $attr->_inline_instance_get('$instance'),
 414         ');',
 415     ) if $attr->has_initializer;
 416
 417     return @initial_value;
 418 }
 419
 420 sub _inline_extra_init {
 421     my $self = shift;
 422     return (
 423         $self->_inline_triggers,
 424         $self->_inline_BUILDALL,
 425     );
 426 }
 427
 428 sub _inline_triggers {
 429     my $self = shift;
 430     my @trigger_calls;
 431
 432     my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
 433     for my $i (0 .. $#attrs) {
 434         my $attr = $attrs[$i];
 435
 436         next unless $attr->can('has_trigger') && $attr->has_trigger;
 437
 438         my $init_arg = $attr->init_arg;
 439         next unless defined $init_arg;
 440
 441         push @trigger_calls,
 442             'if (exists $params->{\'' . $init_arg . '\'}) {',
 443                 '$attrs->[' . $i . ']->trigger->(',
 444                     '$instance,',
 445                     $attr->_inline_instance_get('$instance') . ',',
 446                 ');',
 447             '}';
 448     }
 449
 450     return @trigger_calls;
 451 }
 452
 453 sub _inline_BUILDALL {
 454     my $self = shift;
 455
 456     my @methods = reverse $self->find_all_methods_by_name('BUILD');
 457     my @BUILD_calls;
 458
 459     foreach my $method (@methods) {
 460         push @BUILD_calls,
 461             '$instance->' . $method->{class} . '::BUILD($params);';
 462     }
 463
 464     return @BUILD_calls;
 465 }
 466
 467 sub superclasses {
 468     my $self = shift;
 469     my $supers = Data::OptList::mkopt(\@_);
 470     foreach my $super (@{ $supers }) {
 471         my ($name, $opts) = @{ $super };
 472         Class::MOP::load_class($name, $opts);
 473         my $meta = Class::MOP::class_of($name);
 474         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 475             if $meta && $meta->isa('Moose::Meta::Role')
 476     }
 477     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 478 }
 479
 480 ### ---------------------------------------------
 481
 482 sub add_attribute {
 483     my $self = shift;
 484     my $attr =
 485         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 486             ? $_[0]
 487             : $self->_process_attribute(@_));
 488     $self->SUPER::add_attribute($attr);
 489     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 490     # 'bare' and doesn't implement this method
 491     if ($attr->can('_check_associated_methods')) {
 492         $attr->_check_associated_methods;
 493     }
 494     return $attr;
 495 }
 496
 497 sub add_override_method_modifier {
 498     my ($self, $name, $method, $_super_package) = @_;
 499
 500     (!$self->has_method($name))
 501         || $self->throw_error("Cannot add an override method if a local method is already present");
 502
 503     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 504         method  => $method,
 505         class   => $self,
 506         package => $_super_package, # need this for roles
 507         name    => $name,
 508     ));
 509 }
 510
 511 sub add_augment_method_modifier {
 512     my ($self, $name, $method) = @_;
 513     (!$self->has_method($name))
 514         || $self->throw_error("Cannot add an augment method if a local method is already present");
 515
 516     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 517         method  => $method,
 518         class   => $self,
 519         name    => $name,
 520     ));
 521 }
 522
 523 ## Private Utility methods ...
 524
 525 sub _find_next_method_by_name_which_is_not_overridden {
 526     my ($self, $name) = @_;
 527     foreach my $method ($self->find_all_methods_by_name($name)) {
 528         return $method->{code}
 529             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 530     }
 531     return undef;
 532 }
 533
 534 ## Metaclass compatibility
 535
 536 sub _base_metaclasses {
 537     my $self = shift;
 538     my %metaclasses = $self->SUPER::_base_metaclasses;
 539     for my $class (keys %metaclasses) {
 540         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 541     }
 542     return (
 543         %metaclasses,
 544         error_class => 'Moose::Error::Default',
 545     );
 546 }
 547
 548 sub _fix_class_metaclass_incompatibility {
 549     my $self = shift;
 550     my ($super_meta) = @_;
 551
 552     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 553
 554     if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
 555         ($self->is_pristine)
 556             || confess "Can't fix metaclass incompatibility for "
 557                      . $self->name
 558                      . " because it is not pristine.";
 559         my $super_meta_name = $super_meta->_real_ref_name;
 560         my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 561         my $new_self = $class_meta_subclass_meta_name->reinitialize(
 562             $self->name,
 563         );
 564
 565         $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
 566     }
 567 }
 568
 569 sub _fix_single_metaclass_incompatibility {
 570     my $self = shift;
 571     my ($metaclass_type, $super_meta) = @_;
 572
 573     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 574
 575     if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
 576         ($self->is_pristine)
 577             || confess "Can't fix metaclass incompatibility for "
 578                      . $self->name
 579                      . " because it is not pristine.";
 580         my $super_meta_name = $super_meta->_real_ref_name;
 581         my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 582         my $new_self = $super_meta->reinitialize(
 583             $self->name,
 584             $metaclass_type => $class_specific_meta_subclass_meta_name,
 585         );
 586
 587         $self->_replace_self( $new_self, $super_meta_name );
 588     }
 589 }
 590
 591 sub _replace_self {
 592     my $self      = shift;
 593     my ( $new_self, $new_class)   = @_;
 594
 595     %$self = %$new_self;
 596     bless $self, $new_class;
 597
 598     # We need to replace the cached metaclass instance or else when it goes
 599     # out of scope Class::MOP::Class destroy's the namespace for the
 600     # metaclass's class, causing much havoc.
 601     my $weaken = Class::MOP::metaclass_is_weak( $self->name );
 602     Class::MOP::store_metaclass_by_name( $self->name, $self );
 603     Class::MOP::weaken_metaclass( $self->name ) if $weaken;
 604 }
 605
 606 sub _process_attribute {
 607     my ( $self, $name, @args ) = @_;
 608
 609     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 610
 611     if (($name || '') =~ /^\+(.*)/) {
 612         return $self->_process_inherited_attribute($1, @args);
 613     }
 614     else {
 615         return $self->_process_new_attribute($name, @args);
 616     }
 617 }
 618
 619 sub _process_new_attribute {
 620     my ( $self, $name, @args ) = @_;
 621
 622     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 623 }
 624
 625 sub _process_inherited_attribute {
 626     my ($self, $attr_name, %options) = @_;
 627     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 628     (defined $inherited_attr)
 629         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 630     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 631         return $inherited_attr->clone_and_inherit_options(%options);
 632     }
 633     else {
 634         # NOTE:
 635         # kind of a kludge to handle Class::MOP::Attributes
 636         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 637     }
 638 }
 639
 640 ## Immutability
 641
 642 sub _immutable_options {
 643     my ( $self, @args ) = @_;
 644
 645     $self->SUPER::_immutable_options(
 646         inline_destructor => 1,
 647
 648         # Moose always does this when an attribute is created
 649         inline_accessors => 0,
 650
 651         @args,
 652     );
 653 }
 654
 655 ## -------------------------------------------------
 656
 657 our $error_level;
 658
 659 sub throw_error {
 660     my ( $self, @args ) = @_;
 661     local $error_level = ($error_level || 0) + 1;
 662     $self->raise_error($self->create_error(@args));
 663 }
 664
 665 sub _inline_throw_error {
 666     my ( $self, $msg, $args ) = @_;
 667     "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
 668 }
 669
 670 sub raise_error {
 671     my ( $self, @args ) = @_;
 672     die @args;
 673 }
 674
 675 sub create_error {
 676     my ( $self, @args ) = @_;
 677
 678     require Carp::Heavy;
 679
 680     local $error_level = ($error_level || 0 ) + 1;
 681
 682     if ( @args % 2 == 1 ) {
 683         unshift @args, "message";
 684     }
 685
 686     my %args = ( metaclass => $self, last_error => $@, @args );
 687
 688     $args{depth} += $error_level;
 689
 690     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 691
 692     Class::MOP::load_class($class);
 693
 694     $class->new(
 695         Carp::caller_info($args{depth}),
 696         %args
 697     );
 698 }
 699
 700 1;
 701
 702 __END__
 703
 704 =pod
 705
 706 =head1 NAME
 707
 708 Moose::Meta::Class - The Moose metaclass
 709
 710 =head1 DESCRIPTION
 711
 712 This class is a subclass of L<Class::MOP::Class> that provides
 713 additional Moose-specific functionality.
 714
 715 To really understand this class, you will need to start with the
 716 L<Class::MOP::Class> documentation. This class can be understood as a
 717 set of additional features on top of the basic feature provided by
 718 that parent class.
 719
 720 =head1 INHERITANCE
 721
 722 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 723
 724 =head1 METHODS
 725
 726 =over 4
 727
 728 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 729
 730 This overrides the parent's method in order to provide its own
 731 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 732 C<method_metaclass> options.
 733
 734 These all default to the appropriate Moose class.
 735
 736 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 737
 738 This overrides the parent's method in order to accept a C<roles>
 739 option. This should be an array reference containing roles
 740 that the class does, each optionally followed by a hashref of options
 741 (C<-excludes> and C<-alias>).
 742
 743   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 744
 745 =item B<< Moose::Meta::Class->create_anon_class >>
 746
 747 This overrides the parent's method to accept a C<roles> option, just
 748 as C<create> does.
 749
 750 It also accepts a C<cache> option. If this is true, then the anonymous
 751 class will be cached based on its superclasses and roles. If an
 752 existing anonymous class in the cache has the same superclasses and
 753 roles, it will be reused.
 754
 755   my $metaclass = Moose::Meta::Class->create_anon_class(
 756       superclasses => ['Foo'],
 757       roles        => [qw/Some Roles Go Here/],
 758       cache        => 1,
 759   );
 760
 761 Each entry in both the C<superclasses> and the C<roles> option can be
 762 followed by a hash reference with arguments. The C<superclasses>
 763 option can be supplied with a L<-version|Class::MOP/Class Loading
 764 Options> option that ensures the loaded superclass satisfies the
 765 required version. The C<role> option also takes the C<-version> as an
 766 argument, but the option hash reference can also contain any other
 767 role relevant values like exclusions or parameterized role arguments.
 768
 769 =item B<< $metaclass->make_immutable(%options) >>
 770
 771 This overrides the parent's method to add a few options. Specifically,
 772 it uses the Moose-specific constructor and destructor classes, and
 773 enables inlining the destructor.
 774
 775 Since Moose always inlines attributes, it sets the C<inline_accessors> option
 776 to false.
 777
 778 =item B<< $metaclass->new_object(%params) >>
 779
 780 This overrides the parent's method in order to add support for
 781 attribute triggers.
 782
 783 =item B<< $metaclass->superclasses(@superclasses) >>
 784
 785 This is the accessor allowing you to read or change the parents of
 786 the class.
 787
 788 Each superclass can be followed by a hash reference containing a
 789 L<-version|Class::MOP/Class Loading Options> value. If the version
 790 requirement is not satisfied an error will be thrown.
 791
 792 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 793
 794 This adds an C<override> method modifier to the package.
 795
 796 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 797
 798 This adds an C<augment> method modifier to the package.
 799
 800 =item B<< $metaclass->calculate_all_roles >>
 801
 802 This will return a unique array of C<Moose::Meta::Role> instances
 803 which are attached to this class.
 804
 805 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 806
 807 This will return a unique array of C<Moose::Meta::Role> instances
 808 which are attached to this class, and each of this class's ancestors.
 809
 810 =item B<< $metaclass->add_role($role) >>
 811
 812 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 813 list of roles. This I<does not> actually apply the role to the class.
 814
 815 =item B<< $metaclass->role_applications >>
 816
 817 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 818 objects, which contain the arguments to role application.
 819
 820 =item B<< $metaclass->add_role_application($application) >>
 821
 822 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 823 adds it to the class's list of role applications. This I<does not>
 824 actually apply any role to the class; it is only for tracking role
 825 applications.
 826
 827 =item B<< $metaclass->does_role($role) >>
 828
 829 This returns a boolean indicating whether or not the class does the specified
 830 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 831 object. This tests both the class and its parents.
 832
 833 =item B<< $metaclass->excludes_role($role_name) >>
 834
 835 A class excludes a role if it has already composed a role which
 836 excludes the named role. This tests both the class and its parents.
 837
 838 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 839
 840 This overrides the parent's method in order to allow the parameters to
 841 be provided as a hash reference.
 842
 843 =item B<< $metaclass->constructor_class($class_name) >>
 844
 845 =item B<< $metaclass->destructor_class($class_name) >>
 846
 847 These are the names of classes used when making a class immutable. These
 848 default to L<Moose::Meta::Method::Constructor> and
 849 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 850 read-write, so you can use them to change the class name.
 851
 852 =item B<< $metaclass->error_class($class_name) >>
 853
 854 The name of the class used to throw errors. This defaults to
 855 L<Moose::Error::Default>, which generates an error with a stacktrace
 856 just like C<Carp::confess>.
 857
 858 =item B<< $metaclass->throw_error($message, %extra) >>
 859
 860 Throws the error created by C<create_error> using C<raise_error>
 861
 862 =back
 863
 864 =head1 BUGS
 865
 866 See L<Moose/BUGS> for details on reporting bugs.
 867
 868 =head1 AUTHOR
 869
 870 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 871
 872 =head1 COPYRIGHT AND LICENSE
 873
 874 Copyright 2006-2010 by Infinity Interactive, Inc.
 875
 876 L<http://www.iinteractive.com>
 877
 878 This library is free software; you can redistribute it and/or modify
 879 it under the same terms as Perl itself.
 880
 881 =cut
 882