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.06';
  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 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 superclasses {
 284     my $self = shift;
 285     my $supers = Data::OptList::mkopt(\@_);
 286     foreach my $super (@{ $supers }) {
 287         my ($name, $opts) = @{ $super };
 288         Class::MOP::load_class($name, $opts);
 289         my $meta = Class::MOP::class_of($name);
 290         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 291             if $meta && $meta->isa('Moose::Meta::Role')
 292     }
 293     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 294 }
 295
 296 ### ---------------------------------------------
 297
 298 sub add_attribute {
 299     my $self = shift;
 300     my $attr =
 301         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 302             ? $_[0]
 303             : $self->_process_attribute(@_));
 304     $self->SUPER::add_attribute($attr);
 305     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 306     # 'bare' and doesn't implement this method
 307     if ($attr->can('_check_associated_methods')) {
 308         $attr->_check_associated_methods;
 309     }
 310     return $attr;
 311 }
 312
 313 sub add_override_method_modifier {
 314     my ($self, $name, $method, $_super_package) = @_;
 315
 316     (!$self->has_method($name))
 317         || $self->throw_error("Cannot add an override method if a local method is already present");
 318
 319     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 320         method  => $method,
 321         class   => $self,
 322         package => $_super_package, # need this for roles
 323         name    => $name,
 324     ));
 325 }
 326
 327 sub add_augment_method_modifier {
 328     my ($self, $name, $method) = @_;
 329     (!$self->has_method($name))
 330         || $self->throw_error("Cannot add an augment method if a local method is already present");
 331
 332     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 333         method  => $method,
 334         class   => $self,
 335         name    => $name,
 336     ));
 337 }
 338
 339 ## Private Utility methods ...
 340
 341 sub _find_next_method_by_name_which_is_not_overridden {
 342     my ($self, $name) = @_;
 343     foreach my $method ($self->find_all_methods_by_name($name)) {
 344         return $method->{code}
 345             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 346     }
 347     return undef;
 348 }
 349
 350 ## Metaclass compatibility
 351
 352 sub _base_metaclasses {
 353     my $self = shift;
 354     my %metaclasses = $self->SUPER::_base_metaclasses;
 355     for my $class (keys %metaclasses) {
 356         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 357     }
 358     return (
 359         %metaclasses,
 360         error_class => 'Moose::Error::Default',
 361     );
 362 }
 363
 364 sub _find_common_base {
 365     my $self = shift;
 366     my ($meta1, $meta2) = map { Class::MOP::class_of($_) } @_;
 367     return unless defined $meta1 && defined $meta2;
 368
 369     # FIXME? This doesn't account for multiple inheritance (not sure
 370     # if it needs to though). For example, if somewhere in $meta1's
 371     # history it inherits from both ClassA and ClassB, and $meta2
 372     # inherits from ClassB & ClassA, does it matter? And what crazy
 373     # fool would do that anyway?
 374
 375     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 376
 377     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 378 }
 379
 380 sub _get_ancestors_until {
 381     my $self = shift;
 382     my ($start_name, $until_name) = @_;
 383
 384     my @ancestor_names;
 385     for my $ancestor_name (Class::MOP::class_of($start_name)->linearized_isa) {
 386         last if $ancestor_name eq $until_name;
 387         push @ancestor_names, $ancestor_name;
 388     }
 389     return @ancestor_names;
 390 }
 391
 392 sub _is_role_only_subclass {
 393     my $self = shift;
 394     my ($meta_name) = @_;
 395     my $meta = Class::MOP::Class->initialize($meta_name);
 396     my @parent_names = $meta->superclasses;
 397
 398     # XXX: don't feel like messing with multiple inheritance here... what would
 399     # that even do?
 400     return unless @parent_names == 1;
 401     my ($parent_name) = @parent_names;
 402     my $parent_meta = Class::MOP::Class->initialize($parent_name);
 403
 404     my @roles = $meta->can('calculate_all_roles_with_inheritance')
 405                     ? $meta->calculate_all_roles_with_inheritance
 406                     : ();
 407
 408     # loop over all methods that are a part of the current class
 409     # (not inherited)
 410     for my $method (map { $meta->get_method($_) } $meta->get_method_list) {
 411         # always ignore meta
 412         next if $method->name eq 'meta';
 413         # we'll deal with attributes below
 414         next if $method->can('associated_attribute');
 415         # if the method comes from a role we consumed, ignore it
 416         next if $meta->can('does_role')
 417              && $meta->does_role($method->original_package_name);
 418         # FIXME - this really isn't right. Just because a modifier is
 419         # defined in a role doesn't mean it isn't _also_ defined in the
 420         # subclass.
 421         next if $method->isa('Class::MOP::Method::Wrapped')
 422              && (
 423                  (!scalar($method->around_modifiers)
 424                || any { $_->has_around_method_modifiers($method->name) } @roles)
 425               && (!scalar($method->before_modifiers)
 426                || any { $_->has_before_method_modifiers($method->name) } @roles)
 427               && (!scalar($method->after_modifiers)
 428                || any { $_->has_after_method_modifiers($method->name) } @roles)
 429                 );
 430
 431         return 0;
 432     }
 433
 434     # loop over all attributes that are a part of the current class
 435     # (not inherited)
 436     # FIXME - this really isn't right. Just because an attribute is
 437     # defined in a role doesn't mean it isn't _also_ defined in the
 438     # subclass.
 439     for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
 440         next if any { $_->has_attribute($attr->name) } @roles;
 441
 442         return 0;
 443     }
 444
 445     return 1;
 446 }
 447
 448 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
 449     my $self = shift;
 450     my ($super_meta) = @_;
 451
 452     my $super_meta_name = $super_meta->_real_ref_name;
 453
 454     return $self->_classes_differ_by_roles_only(
 455         blessed($self),
 456         $super_meta_name,
 457         'Moose::Meta::Class',
 458     );
 459 }
 460
 461 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
 462     my $self = shift;
 463     my ($metaclass_type, $super_meta) = @_;
 464
 465     my $class_specific_meta_name = $self->$metaclass_type;
 466     return unless $super_meta->can($metaclass_type);
 467     my $super_specific_meta_name = $super_meta->$metaclass_type;
 468     my %metaclasses = $self->_base_metaclasses;
 469
 470     return $self->_classes_differ_by_roles_only(
 471         $class_specific_meta_name,
 472         $super_specific_meta_name,
 473         $metaclasses{$metaclass_type},
 474     );
 475 }
 476
 477 sub _classes_differ_by_roles_only {
 478     my $self = shift;
 479     my ( $self_meta_name, $super_meta_name, $expected_ancestor ) = @_;
 480
 481     my $common_base_name
 482         = $self->_find_common_base( $self_meta_name, $super_meta_name );
 483
 484     # If they're not both moose metaclasses, and the cmop fixing couldn't do
 485     # anything, there's nothing more we can do. The $expected_ancestor should
 486     # always be a Moose metaclass name like Moose::Meta::Class or
 487     # Moose::Meta::Attribute.
 488     return unless defined $common_base_name;
 489     return unless $common_base_name->isa($expected_ancestor);
 490
 491     my @super_meta_name_ancestor_names
 492         = $self->_get_ancestors_until( $super_meta_name, $common_base_name );
 493     my @class_meta_name_ancestor_names
 494         = $self->_get_ancestors_until( $self_meta_name, $common_base_name );
 495
 496     return
 497         unless all { $self->_is_role_only_subclass($_) }
 498         @super_meta_name_ancestor_names,
 499         @class_meta_name_ancestor_names;
 500
 501     return 1;
 502 }
 503
 504 sub _role_differences {
 505     my $self = shift;
 506     my ($class_meta_name, $super_meta_name) = @_;
 507     my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance')
 508                          ? $super_meta_name->meta->calculate_all_roles_with_inheritance
 509                          : ();
 510     my @role_metas       = $class_meta_name->meta->can('calculate_all_roles_with_inheritance')
 511                          ? $class_meta_name->meta->calculate_all_roles_with_inheritance
 512                          : ();
 513     my @differences;
 514     for my $role_meta (@role_metas) {
 515         push @differences, $role_meta
 516             unless any { $_->name eq $role_meta->name } @super_role_metas;
 517     }
 518     return @differences;
 519 }
 520
 521 sub _reconcile_roles_for_metaclass {
 522     my $self = shift;
 523     my ($class_meta_name, $super_meta_name) = @_;
 524
 525     my @role_differences = $self->_role_differences(
 526         $class_meta_name, $super_meta_name,
 527     );
 528     return Moose::Meta::Class->create_anon_class(
 529         superclasses => [$super_meta_name],
 530         roles        => \@role_differences,
 531         cache        => 1,
 532     );
 533 }
 534
 535 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
 536     my $self = shift;
 537     my ($super_meta) = @_;
 538
 539     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
 540
 541     my %base_metaclass = $self->_base_metaclasses;
 542     for my $metaclass_type (keys %base_metaclass) {
 543         next unless defined $self->$metaclass_type;
 544         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
 545     }
 546
 547     return;
 548 }
 549
 550 sub _can_fix_metaclass_incompatibility {
 551     my $self = shift;
 552     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
 553     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
 554 }
 555
 556 sub _fix_class_metaclass_incompatibility {
 557     my $self = shift;
 558     my ($super_meta) = @_;
 559
 560     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 561
 562     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 563         ($self->is_pristine)
 564             || confess "Can't fix metaclass incompatibility for "
 565                      . $self->name
 566                      . " because it is not pristine.";
 567         my $super_meta_name = $super_meta->_real_ref_name;
 568         my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 569         my $new_self = $class_meta_subclass_meta->name->reinitialize(
 570             $self->name,
 571         );
 572
 573         $self->_replace_self( $new_self, $class_meta_subclass_meta->name );
 574     }
 575 }
 576
 577 sub _fix_single_metaclass_incompatibility {
 578     my $self = shift;
 579     my ($metaclass_type, $super_meta) = @_;
 580
 581     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 582
 583     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 584         ($self->is_pristine)
 585             || confess "Can't fix metaclass incompatibility for "
 586                      . $self->name
 587                      . " because it is not pristine.";
 588         my $super_meta_name = $super_meta->_real_ref_name;
 589         my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 590         my $new_self = $super_meta->reinitialize(
 591             $self->name,
 592             $metaclass_type => $class_specific_meta_subclass_meta->name,
 593         );
 594
 595         $self->_replace_self( $new_self, $super_meta_name );
 596     }
 597 }
 598
 599
 600 sub _replace_self {
 601     my $self      = shift;
 602     my ( $new_self, $new_class)   = @_;
 603
 604     %$self = %$new_self;
 605     bless $self, $new_class;
 606
 607     # We need to replace the cached metaclass instance or else when it goes
 608     # out of scope Class::MOP::Class destroy's the namespace for the
 609     # metaclass's class, causing much havoc.
 610     Class::MOP::store_metaclass_by_name( $self->name, $self );
 611     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 612 }
 613
 614 sub _process_attribute {
 615     my ( $self, $name, @args ) = @_;
 616
 617     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 618
 619     if (($name || '') =~ /^\+(.*)/) {
 620         return $self->_process_inherited_attribute($1, @args);
 621     }
 622     else {
 623         return $self->_process_new_attribute($name, @args);
 624     }
 625 }
 626
 627 sub _process_new_attribute {
 628     my ( $self, $name, @args ) = @_;
 629
 630     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 631 }
 632
 633 sub _process_inherited_attribute {
 634     my ($self, $attr_name, %options) = @_;
 635     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 636     (defined $inherited_attr)
 637         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 638     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 639         return $inherited_attr->clone_and_inherit_options(%options);
 640     }
 641     else {
 642         # NOTE:
 643         # kind of a kludge to handle Class::MOP::Attributes
 644         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 645     }
 646 }
 647
 648 ## -------------------------------------------------
 649
 650 our $error_level;
 651
 652 sub throw_error {
 653     my ( $self, @args ) = @_;
 654     local $error_level = ($error_level || 0) + 1;
 655     $self->raise_error($self->create_error(@args));
 656 }
 657
 658 sub raise_error {
 659     my ( $self, @args ) = @_;
 660     die @args;
 661 }
 662
 663 sub create_error {
 664     my ( $self, @args ) = @_;
 665
 666     require Carp::Heavy;
 667
 668     local $error_level = ($error_level || 0 ) + 1;
 669
 670     if ( @args % 2 == 1 ) {
 671         unshift @args, "message";
 672     }
 673
 674     my %args = ( metaclass => $self, last_error => $@, @args );
 675
 676     $args{depth} += $error_level;
 677
 678     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 679
 680     Class::MOP::load_class($class);
 681
 682     $class->new(
 683         Carp::caller_info($args{depth}),
 684         %args
 685     );
 686 }
 687
 688 1;
 689
 690 __END__
 691
 692 =pod
 693
 694 =head1 NAME
 695
 696 Moose::Meta::Class - The Moose metaclass
 697
 698 =head1 DESCRIPTION
 699
 700 This class is a subclass of L<Class::MOP::Class> that provides
 701 additional Moose-specific functionality.
 702
 703 To really understand this class, you will need to start with the
 704 L<Class::MOP::Class> documentation. This class can be understood as a
 705 set of additional features on top of the basic feature provided by
 706 that parent class.
 707
 708 =head1 INHERITANCE
 709
 710 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 711
 712 =head1 METHODS
 713
 714 =over 4
 715
 716 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 717
 718 This overrides the parent's method in order to provide its own
 719 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 720 C<method_metaclass> options.
 721
 722 These all default to the appropriate Moose class.
 723
 724 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 725
 726 This overrides the parent's method in order to accept a C<roles>
 727 option. This should be an array reference containing roles
 728 that the class does, each optionally followed by a hashref of options
 729 (C<-excludes> and C<-alias>).
 730
 731   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 732
 733 =item B<< Moose::Meta::Class->create_anon_class >>
 734
 735 This overrides the parent's method to accept a C<roles> option, just
 736 as C<create> does.
 737
 738 It also accepts a C<cache> option. If this is true, then the anonymous
 739 class will be cached based on its superclasses and roles. If an
 740 existing anonymous class in the cache has the same superclasses and
 741 roles, it will be reused.
 742
 743   my $metaclass = Moose::Meta::Class->create_anon_class(
 744       superclasses => ['Foo'],
 745       roles        => [qw/Some Roles Go Here/],
 746       cache        => 1,
 747   );
 748
 749 Each entry in both the C<superclasses> and the C<roles> option can be
 750 followed by a hash reference with arguments. The C<superclasses>
 751 option can be supplied with a L<-version|Class::MOP/Class Loading
 752 Options> option that ensures the loaded superclass satisfies the
 753 required version. The C<role> option also takes the C<-version> as an
 754 argument, but the option hash reference can also contain any other
 755 role relevant values like exclusions or parameterized role arguments.
 756
 757 =item B<< $metaclass->make_immutable(%options) >>
 758
 759 This overrides the parent's method to add a few options. Specifically,
 760 it uses the Moose-specific constructor and destructor classes, and
 761 enables inlining the destructor.
 762
 763 Also, since Moose always inlines attributes, it sets the
 764 C<inline_accessors> option to false.
 765
 766 =item B<< $metaclass->new_object(%params) >>
 767
 768 This overrides the parent's method in order to add support for
 769 attribute triggers.
 770
 771 =item B<< $metaclass->superclasses(@superclasses) >>
 772
 773 This is the accessor allowing you to read or change the parents of
 774 the class.
 775
 776 Each superclass can be followed by a hash reference containing a
 777 L<-version|Class::MOP/Class Loading Options> value. If the version
 778 requirement is not satisfied an error will be thrown.
 779
 780 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 781
 782 This adds an C<override> method modifier to the package.
 783
 784 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 785
 786 This adds an C<augment> method modifier to the package.
 787
 788 =item B<< $metaclass->calculate_all_roles >>
 789
 790 This will return a unique array of C<Moose::Meta::Role> instances
 791 which are attached to this class.
 792
 793 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 794
 795 This will return a unique array of C<Moose::Meta::Role> instances
 796 which are attached to this class, and each of this class's ancestors.
 797
 798 =item B<< $metaclass->add_role($role) >>
 799
 800 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 801 list of roles. This I<does not> actually apply the role to the class.
 802
 803 =item B<< $metaclass->role_applications >>
 804
 805 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 806 objects, which contain the arguments to role application.
 807
 808 =item B<< $metaclass->add_role_application($application) >>
 809
 810 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 811 adds it to the class's list of role applications. This I<does not>
 812 actually apply any role to the class; it is only for tracking role
 813 applications.
 814
 815 =item B<< $metaclass->does_role($role) >>
 816
 817 This returns a boolean indicating whether or not the class does the specified
 818 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 819 object. This tests both the class and its parents.
 820
 821 =item B<< $metaclass->excludes_role($role_name) >>
 822
 823 A class excludes a role if it has already composed a role which
 824 excludes the named role. This tests both the class and its parents.
 825
 826 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 827
 828 This overrides the parent's method in order to allow the parameters to
 829 be provided as a hash reference.
 830
 831 =item B<< $metaclass->constructor_class($class_name) >>
 832
 833 =item B<< $metaclass->destructor_class($class_name) >>
 834
 835 These are the names of classes used when making a class
 836 immutable. These default to L<Moose::Meta::Method::Constructor> and
 837 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 838 read-write, so you can use them to change the class name.
 839
 840 =item B<< $metaclass->error_class($class_name) >>
 841
 842 The name of the class used to throw errors. This defaults to
 843 L<Moose::Error::Default>, which generates an error with a stacktrace
 844 just like C<Carp::confess>.
 845
 846 =item B<< $metaclass->throw_error($message, %extra) >>
 847
 848 Throws the error created by C<create_error> using C<raise_error>
 849
 850 =back
 851
 852 =head1 BUGS
 853
 854 See L<Moose/BUGS> for details on reporting bugs.
 855
 856 =head1 AUTHOR
 857
 858 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 859
 860 =head1 COPYRIGHT AND LICENSE
 861
 862 Copyright 2006-2010 by Infinity Interactive, Inc.
 863
 864 L<http://www.iinteractive.com>
 865
 866 This library is free software; you can redistribute it and/or modify
 867 it under the same terms as Perl itself.
 868
 869 =cut
 870