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