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.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 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, is 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     # loop over all methods that are a part of the current class
 405     # (not inherited)
 406     for my $method (map { $meta->get_method($_) } $meta->get_method_list) {
 407         # always ignore meta
 408         next if $method->name eq 'meta';
 409         # we'll deal with attributes below
 410         next if $method->isa('Class::MOP::Method::Accessor');
 411         # if the method comes from a role we consumed, ignore it
 412         next if $meta->can('does_role')
 413              && $meta->does_role($method->original_package_name);
 414
 415         return 0;
 416     }
 417
 418     # loop over all attributes that are a part of the current class
 419     # (not inherited)
 420     # FIXME - this really isn't right. Just because an attribute is
 421     # defined in a role doesn't mean it isn't _also_ defined in the
 422     # subclass.
 423     for my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
 424         next if any { $_->has_attribute($attr->name) }
 425                     $meta->calculate_all_roles_with_inheritance;
 426
 427         return 0;
 428     }
 429
 430     return 1;
 431 }
 432
 433 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
 434     my $self = shift;
 435     my ($super_meta) = @_;
 436
 437     my $super_meta_name = $super_meta->is_immutable
 438                               ? $super_meta->_get_mutable_metaclass_name
 439                               : blessed($super_meta);
 440     my $common_base_name = $self->_find_common_base(blessed($self), $super_meta_name);
 441     # if they're not both moose metaclasses, and the cmop fixing couldn't
 442     # do anything, there's nothing more we can do
 443     return unless defined($common_base_name);
 444     return unless $common_base_name->isa('Moose::Meta::Class');
 445
 446     my @super_meta_name_ancestor_names = $self->_get_ancestors_until($super_meta_name, $common_base_name);
 447     my @class_meta_name_ancestor_names = $self->_get_ancestors_until(blessed($self), $common_base_name);
 448     # we're only dealing with roles here
 449     return unless all { $self->_is_role_only_subclass($_) }
 450                       (@super_meta_name_ancestor_names,
 451                        @class_meta_name_ancestor_names);
 452
 453     return 1;
 454 }
 455
 456 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
 457     my $self = shift;
 458     my ($metaclass_type, $super_meta) = @_;
 459
 460     my $class_specific_meta_name = $self->$metaclass_type;
 461     return unless $super_meta->can($metaclass_type);
 462     my $super_specific_meta_name = $super_meta->$metaclass_type;
 463     my %metaclasses = $self->_base_metaclasses;
 464
 465     my $common_base_name = $self->_find_common_base($class_specific_meta_name, $super_specific_meta_name);
 466     # if they're not both moose metaclasses, and the cmop fixing couldn't
 467     # do anything, there's nothing more we can do
 468     return unless defined($common_base_name);
 469     return unless $common_base_name->isa($metaclasses{$metaclass_type});
 470
 471     my @super_specific_meta_name_ancestor_names = $self->_get_ancestors_until($super_specific_meta_name, $common_base_name);
 472     my @class_specific_meta_name_ancestor_names = $self->_get_ancestors_until($class_specific_meta_name, $common_base_name);
 473     # we're only dealing with roles here
 474     return unless all { $self->_is_role_only_subclass($_) }
 475                       (@super_specific_meta_name_ancestor_names,
 476                        @class_specific_meta_name_ancestor_names);
 477
 478     return 1;
 479 }
 480
 481 sub _role_differences {
 482     my $self = shift;
 483     my ($class_meta_name, $super_meta_name) = @_;
 484     my @super_role_metas = $super_meta_name->meta->can('calculate_all_roles_with_inheritance')
 485                          ? $super_meta_name->meta->calculate_all_roles_with_inheritance
 486                          : ();
 487     my @role_metas       = $class_meta_name->meta->can('calculate_all_roles_with_inheritance')
 488                          ? $class_meta_name->meta->calculate_all_roles_with_inheritance
 489                          : ();
 490     my @differences;
 491     for my $role_meta (@role_metas) {
 492         push @differences, $role_meta
 493             unless any { $_->name eq $role_meta->name } @super_role_metas;
 494     }
 495     return @differences;
 496 }
 497
 498 sub _reconcile_roles_for_metaclass {
 499     my $self = shift;
 500     my ($class_meta_name, $super_meta_name) = @_;
 501
 502     my @role_differences = $self->_role_differences(
 503         $class_meta_name, $super_meta_name,
 504     );
 505     return Moose::Meta::Class->create_anon_class(
 506         superclasses => [$super_meta_name],
 507         roles        => \@role_differences,
 508         cache        => 1,
 509     );
 510 }
 511
 512 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
 513     my $self = shift;
 514     my ($super_meta) = @_;
 515
 516     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
 517
 518     my %base_metaclass = $self->_base_metaclasses;
 519     for my $metaclass_type (keys %base_metaclass) {
 520         next unless defined $self->$metaclass_type;
 521         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
 522     }
 523
 524     return;
 525 }
 526
 527 sub _can_fix_metaclass_incompatibility {
 528     my $self = shift;
 529     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
 530     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
 531 }
 532
 533 sub _fix_class_metaclass_incompatibility {
 534     my $self = shift;
 535     my ($super_meta) = @_;
 536
 537     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 538
 539     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 540         ($self->is_pristine)
 541             || confess "Can't fix metaclass incompatibility for "
 542                      . $self->name
 543                      . " because it is not pristine.";
 544         my $super_meta_name = $super_meta->is_immutable
 545                                   ? $super_meta->_get_mutable_metaclass_name
 546                                   : blessed($super_meta);
 547         my $class_meta_subclass_meta = $self->_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 548         my $new_self = $class_meta_subclass_meta->name->reinitialize(
 549             $self->name,
 550         );
 551         %$self = %$new_self;
 552         bless $self, $class_meta_subclass_meta->name;
 553         # We need to replace the cached metaclass instance or else when it
 554         # goes out of scope Class::MOP::Class destroy's the namespace for
 555         # the metaclass's class, causing much havoc.
 556         Class::MOP::store_metaclass_by_name( $self->name, $self );
 557         Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 558     }
 559 }
 560
 561 sub _fix_single_metaclass_incompatibility {
 562     my $self = shift;
 563     my ($metaclass_type, $super_meta) = @_;
 564
 565     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 566
 567     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 568         ($self->is_pristine)
 569             || confess "Can't fix metaclass incompatibility for "
 570                      . $self->name
 571                      . " because it is not pristine.";
 572         my %metaclasses = $self->_base_metaclasses;
 573         my $class_specific_meta_subclass_meta = $self->_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 574         my $new_self = $super_meta->reinitialize(
 575             $self->name,
 576             $metaclass_type => $class_specific_meta_subclass_meta->name,
 577         );
 578         %$self = %$new_self;
 579         bless $self, blessed($super_meta);
 580         # We need to replace the cached metaclass instance or else when it
 581         # goes out of scope Class::MOP::Class destroy's the namespace for
 582         # the metaclass's class, causing much havoc.
 583         Class::MOP::store_metaclass_by_name( $self->name, $self );
 584         Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 585     }
 586 }
 587
 588 sub _process_attribute {
 589     my ( $self, $name, @args ) = @_;
 590
 591     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 592
 593     if (($name || '') =~ /^\+(.*)/) {
 594         return $self->_process_inherited_attribute($1, @args);
 595     }
 596     else {
 597         return $self->_process_new_attribute($name, @args);
 598     }
 599 }
 600
 601 sub _process_new_attribute {
 602     my ( $self, $name, @args ) = @_;
 603
 604     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 605 }
 606
 607 sub _process_inherited_attribute {
 608     my ($self, $attr_name, %options) = @_;
 609     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 610     (defined $inherited_attr)
 611         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 612     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 613         return $inherited_attr->clone_and_inherit_options(%options);
 614     }
 615     else {
 616         # NOTE:
 617         # kind of a kludge to handle Class::MOP::Attributes
 618         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 619     }
 620 }
 621
 622 ## -------------------------------------------------
 623
 624 our $error_level;
 625
 626 sub throw_error {
 627     my ( $self, @args ) = @_;
 628     local $error_level = ($error_level || 0) + 1;
 629     $self->raise_error($self->create_error(@args));
 630 }
 631
 632 sub raise_error {
 633     my ( $self, @args ) = @_;
 634     die @args;
 635 }
 636
 637 sub create_error {
 638     my ( $self, @args ) = @_;
 639
 640     require Carp::Heavy;
 641
 642     local $error_level = ($error_level || 0 ) + 1;
 643
 644     if ( @args % 2 == 1 ) {
 645         unshift @args, "message";
 646     }
 647
 648     my %args = ( metaclass => $self, last_error => $@, @args );
 649
 650     $args{depth} += $error_level;
 651
 652     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 653
 654     Class::MOP::load_class($class);
 655
 656     $class->new(
 657         Carp::caller_info($args{depth}),
 658         %args
 659     );
 660 }
 661
 662 1;
 663
 664 __END__
 665
 666 =pod
 667
 668 =head1 NAME
 669
 670 Moose::Meta::Class - The Moose metaclass
 671
 672 =head1 DESCRIPTION
 673
 674 This class is a subclass of L<Class::MOP::Class> that provides
 675 additional Moose-specific functionality.
 676
 677 To really understand this class, you will need to start with the
 678 L<Class::MOP::Class> documentation. This class can be understood as a
 679 set of additional features on top of the basic feature provided by
 680 that parent class.
 681
 682 =head1 INHERITANCE
 683
 684 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 685
 686 =head1 METHODS
 687
 688 =over 4
 689
 690 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 691
 692 This overrides the parent's method in order to provide its own
 693 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 694 C<method_metaclass> options.
 695
 696 These all default to the appropriate Moose class.
 697
 698 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 699
 700 This overrides the parent's method in order to accept a C<roles>
 701 option. This should be an array reference containing roles
 702 that the class does, each optionally followed by a hashref of options
 703 (C<-excludes> and C<-alias>).
 704
 705   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 706
 707 =item B<< Moose::Meta::Class->create_anon_class >>
 708
 709 This overrides the parent's method to accept a C<roles> option, just
 710 as C<create> does.
 711
 712 It also accepts a C<cache> option. If this is true, then the anonymous
 713 class will be cached based on its superclasses and roles. If an
 714 existing anonymous class in the cache has the same superclasses and
 715 roles, it will be reused.
 716
 717   my $metaclass = Moose::Meta::Class->create_anon_class(
 718       superclasses => ['Foo'],
 719       roles        => [qw/Some Roles Go Here/],
 720       cache        => 1,
 721   );
 722
 723 Each entry in both the C<superclasses> and the C<roles> option can be
 724 followed by a hash reference with arguments. The C<superclasses>
 725 option can be supplied with a L<-version|Class::MOP/Class Loading
 726 Options> option that ensures the loaded superclass satisfies the
 727 required version. The C<role> option also takes the C<-version> as an
 728 argument, but the option hash reference can also contain any other
 729 role relevant values like exclusions or parameterized role arguments.
 730
 731 =item B<< $metaclass->make_immutable(%options) >>
 732
 733 This overrides the parent's method to add a few options. Specifically,
 734 it uses the Moose-specific constructor and destructor classes, and
 735 enables inlining the destructor.
 736
 737 Also, since Moose always inlines attributes, it sets the
 738 C<inline_accessors> option to false.
 739
 740 =item B<< $metaclass->new_object(%params) >>
 741
 742 This overrides the parent's method in order to add support for
 743 attribute triggers.
 744
 745 =item B<< $metaclass->superclasses(@superclasses) >>
 746
 747 This is the accessor allowing you to read or change the parents of
 748 the class.
 749
 750 Each superclass can be followed by a hash reference containing a
 751 L<-version|Class::MOP/Class Loading Options> value. If the version
 752 requirement is not satisfied an error will be thrown.
 753
 754 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 755
 756 This adds an C<override> method modifier to the package.
 757
 758 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 759
 760 This adds an C<augment> method modifier to the package.
 761
 762 =item B<< $metaclass->calculate_all_roles >>
 763
 764 This will return a unique array of C<Moose::Meta::Role> instances
 765 which are attached to this class.
 766
 767 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 768
 769 This will return a unique array of C<Moose::Meta::Role> instances
 770 which are attached to this class, and each of this class's ancestors.
 771
 772 =item B<< $metaclass->add_role($role) >>
 773
 774 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 775 list of roles. This I<does not> actually apply the role to the class.
 776
 777 =item B<< $metaclass->role_applications >>
 778
 779 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 780 objects, which contain the arguments to role application.
 781
 782 =item B<< $metaclass->add_role_application($application) >>
 783
 784 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 785 adds it to the class's list of role applications. This I<does not>
 786 actually apply any role to the class; it is only for tracking role
 787 applications.
 788
 789 =item B<< $metaclass->does_role($role) >>
 790
 791 This returns a boolean indicating whether or not the class does the specified
 792 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 793 object. This tests both the class and its parents.
 794
 795 =item B<< $metaclass->excludes_role($role_name) >>
 796
 797 A class excludes a role if it has already composed a role which
 798 excludes the named role. This tests both the class and its parents.
 799
 800 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 801
 802 This overrides the parent's method in order to allow the parameters to
 803 be provided as a hash reference.
 804
 805 =item B<< $metaclass->constructor_class($class_name) >>
 806
 807 =item B<< $metaclass->destructor_class($class_name) >>
 808
 809 These are the names of classes used when making a class
 810 immutable. These default to L<Moose::Meta::Method::Constructor> and
 811 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 812 read-write, so you can use them to change the class name.
 813
 814 =item B<< $metaclass->error_class($class_name) >>
 815
 816 The name of the class used to throw errors. This defaults to
 817 L<Moose::Error::Default>, which generates an error with a stacktrace
 818 just like C<Carp::confess>.
 819
 820 =item B<< $metaclass->throw_error($message, %extra) >>
 821
 822 Throws the error created by C<create_error> using C<raise_error>
 823
 824 =back
 825
 826 =head1 BUGS
 827
 828 See L<Moose/BUGS> for details on reporting bugs.
 829
 830 =head1 AUTHOR
 831
 832 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 833
 834 =head1 COPYRIGHT AND LICENSE
 835
 836 Copyright 2006-2010 by Infinity Interactive, Inc.
 837
 838 L<http://www.iinteractive.com>
 839
 840 This library is free software; you can redistribute it and/or modify
 841 it under the same terms as Perl itself.
 842
 843 =cut
 844