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 'blessed';
  14
  15 use Moose::Meta::Method::Overridden;
  16 use Moose::Meta::Method::Augmented;
  17 use Moose::Error::Default;
  18 use Moose::Meta::Class::Immutable::Trait;
  19 use Moose::Meta::Method::Constructor;
  20 use Moose::Meta::Method::Destructor;
  21 use Moose::Meta::Method::Meta;
  22 use Moose::Util;
  23 use Class::MOP::MiniTrait;
  24
  25 use base 'Class::MOP::Class';
  26
  27 Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
  28
  29 __PACKAGE__->meta->add_attribute('roles' => (
  30     reader  => 'roles',
  31     default => sub { [] }
  32 ));
  33
  34 __PACKAGE__->meta->add_attribute('role_applications' => (
  35     reader  => '_get_role_applications',
  36     default => sub { [] }
  37 ));
  38
  39 __PACKAGE__->meta->add_attribute(
  40     Class::MOP::Attribute->new('immutable_trait' => (
  41         accessor => "immutable_trait",
  42         default  => 'Moose::Meta::Class::Immutable::Trait',
  43     ))
  44 );
  45
  46 __PACKAGE__->meta->add_attribute('constructor_class' => (
  47     accessor => 'constructor_class',
  48     default  => 'Moose::Meta::Method::Constructor',
  49 ));
  50
  51 __PACKAGE__->meta->add_attribute('destructor_class' => (
  52     accessor => 'destructor_class',
  53     default  => 'Moose::Meta::Method::Destructor',
  54 ));
  55
  56 __PACKAGE__->meta->add_attribute('error_class' => (
  57     accessor => 'error_class',
  58     default  => 'Moose::Error::Default',
  59 ));
  60
  61 sub initialize {
  62     my $class = shift;
  63     my @args = @_;
  64     unshift @args, 'package' if @args % 2;
  65     my %opts = @args;
  66     my $package = delete $opts{package};
  67     return Class::MOP::get_metaclass_by_name($package)
  68         || $class->SUPER::initialize($package,
  69                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  70                 'method_metaclass'    => 'Moose::Meta::Method',
  71                 'instance_metaclass'  => 'Moose::Meta::Instance',
  72                 %opts,
  73             );
  74 }
  75
  76 sub create {
  77     my $class = shift;
  78     my @args = @_;
  79
  80     unshift @args, 'package' if @args % 2 == 1;
  81     my %options = @args;
  82
  83     (ref $options{roles} eq 'ARRAY')
  84         || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  85             if exists $options{roles};
  86
  87     my $package = delete $options{package};
  88     my $roles   = delete $options{roles};
  89
  90     my $new_meta = $class->SUPER::create($package, %options);
  91
  92     if ($roles) {
  93         Moose::Util::apply_all_roles( $new_meta, @$roles );
  94     }
  95
  96     return $new_meta;
  97 }
  98
  99 sub _meta_method_class { 'Moose::Meta::Method::Meta' }
 100
 101 sub _anon_package_prefix { 'Moose::Meta::Class::__ANON__::SERIAL::' }
 102
 103 sub _anon_cache_key {
 104     my $class = shift;
 105     my %options = @_;
 106
 107     my $superclass_key = join('|',
 108         map { $_->[0] } @{ Data::OptList::mkopt($options{superclasses} || []) }
 109     );
 110
 111     my $roles = Data::OptList::mkopt(($options{roles} || []), {
 112         moniker  => 'role',
 113         val_test => sub { ref($_[0]) eq 'HASH' },
 114     });
 115
 116     my @role_keys;
 117     for my $role_spec (@$roles) {
 118         my ($role, $params) = @$role_spec;
 119         $params = { %$params } if $params;
 120
 121         my $key = blessed($role) ? $role->name : $role;
 122
 123         if ($params && %$params) {
 124             my $alias    = delete $params->{'-alias'}
 125                         || delete $params->{'alias'}
 126                         || {};
 127             my $excludes = delete $params->{'-excludes'}
 128                         || delete $params->{'excludes'}
 129                         || [];
 130             $excludes = [$excludes] unless ref($excludes) eq 'ARRAY';
 131
 132             if (%$params) {
 133                 warn "Roles with parameters cannot be cached. Consider "
 134                    . "applying the parameters before calling "
 135                    . "create_anon_class, or using 'weaken => 0' instead";
 136                 return;
 137             }
 138
 139             my $alias_key = join('%',
 140                 map { $_ => $alias->{$_} } sort keys %$alias
 141             );
 142             my $excludes_key = join('%',
 143                 sort @$excludes
 144             );
 145             $key .= '<' . join('+', 'a', $alias_key, 'e', $excludes_key) . '>';
 146         }
 147
 148         push @role_keys, $key;
 149     }
 150
 151     my $role_key = join('|', sort @role_keys);
 152
 153     # Makes something like Super::Class|Super::Class::2=Role|Role::1
 154     return join('=', $superclass_key, $role_key);
 155 }
 156
 157 sub reinitialize {
 158     my $self = shift;
 159     my $pkg  = shift;
 160
 161     my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
 162
 163     my %existing_classes;
 164     if ($meta) {
 165         %existing_classes = map { $_ => $meta->$_() } qw(
 166             attribute_metaclass
 167             method_metaclass
 168             wrapped_method_metaclass
 169             instance_metaclass
 170             constructor_class
 171             destructor_class
 172             error_class
 173         );
 174     }
 175
 176     return $self->SUPER::reinitialize(
 177         $pkg,
 178         %existing_classes,
 179         @_,
 180     );
 181 }
 182
 183 sub add_role {
 184     my ($self, $role) = @_;
 185     (blessed($role) && $role->isa('Moose::Meta::Role'))
 186         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 187     push @{$self->roles} => $role;
 188 }
 189
 190 sub role_applications {
 191     my ($self) = @_;
 192
 193     return @{$self->_get_role_applications};
 194 }
 195
 196 sub add_role_application {
 197     my ($self, $application) = @_;
 198     (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
 199         || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
 200     push @{$self->_get_role_applications} => $application;
 201 }
 202
 203 sub calculate_all_roles {
 204     my $self = shift;
 205     my %seen;
 206     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 207 }
 208
 209 sub calculate_all_roles_with_inheritance {
 210     my $self = shift;
 211     my %seen;
 212     grep { !$seen{$_->name}++ }
 213          map { Class::MOP::class_of($_)->can('calculate_all_roles')
 214                    ? Class::MOP::class_of($_)->calculate_all_roles
 215                    : () }
 216              $self->linearized_isa;
 217 }
 218
 219 sub does_role {
 220     my ($self, $role_name) = @_;
 221
 222     (defined $role_name)
 223         || $self->throw_error("You must supply a role name to look for");
 224
 225     foreach my $class ($self->class_precedence_list) {
 226         my $meta = Class::MOP::class_of($class);
 227         # when a Moose metaclass is itself extended with a role,
 228         # this check needs to be done since some items in the
 229         # class_precedence_list might in fact be Class::MOP
 230         # based still.
 231         next unless $meta && $meta->can('roles');
 232         foreach my $role (@{$meta->roles}) {
 233             return 1 if $role->does_role($role_name);
 234         }
 235     }
 236     return 0;
 237 }
 238
 239 sub excludes_role {
 240     my ($self, $role_name) = @_;
 241
 242     (defined $role_name)
 243         || $self->throw_error("You must supply a role name to look for");
 244
 245     foreach my $class ($self->class_precedence_list) {
 246         my $meta = Class::MOP::class_of($class);
 247         # when a Moose metaclass is itself extended with a role,
 248         # this check needs to be done since some items in the
 249         # class_precedence_list might in fact be Class::MOP
 250         # based still.
 251         next unless $meta && $meta->can('roles');
 252         foreach my $role (@{$meta->roles}) {
 253             return 1 if $role->excludes_role($role_name);
 254         }
 255     }
 256     return 0;
 257 }
 258
 259 sub new_object {
 260     my $self   = shift;
 261     my $params = @_ == 1 ? $_[0] : {@_};
 262     my $object = $self->SUPER::new_object($params);
 263
 264     foreach my $attr ( $self->get_all_attributes() ) {
 265
 266         next unless $attr->can('has_trigger') && $attr->has_trigger;
 267
 268         my $init_arg = $attr->init_arg;
 269
 270         next unless defined $init_arg;
 271
 272         next unless exists $params->{$init_arg};
 273
 274         $attr->trigger->(
 275             $object,
 276             (
 277                   $attr->should_coerce
 278                 ? $attr->get_read_method_ref->($object)
 279                 : $params->{$init_arg}
 280             ),
 281         );
 282     }
 283
 284     $object->BUILDALL($params) if $object->can('BUILDALL');
 285
 286     return $object;
 287 }
 288
 289 sub _generate_fallback_constructor {
 290     my $self = shift;
 291     my ($class) = @_;
 292     return $class . '->Moose::Object::new(@_)'
 293 }
 294
 295 sub _inline_params {
 296     my $self = shift;
 297     my ($params, $class) = @_;
 298     return (
 299         'my ' . $params . ' = ',
 300         $self->_inline_BUILDARGS($class, '@_'),
 301         ';',
 302     );
 303 }
 304
 305 sub _inline_BUILDARGS {
 306     my $self = shift;
 307     my ($class, $args) = @_;
 308
 309     my $buildargs = $self->find_method_by_name("BUILDARGS");
 310
 311     if ($args eq '@_'
 312      && (!$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS)) {
 313         return (
 314             'do {',
 315                 'my $params;',
 316                 'if (scalar @_ == 1) {',
 317                     'if (!defined($_[0]) || ref($_[0]) ne \'HASH\') {',
 318                         $self->_inline_throw_error(
 319                             '"Single parameters to new() must be a HASH ref"',
 320                             'data => $_[0]',
 321                         ) . ';',
 322                     '}',
 323                     '$params = { %{ $_[0] } };',
 324                 '}',
 325                 'elsif (@_ % 2) {',
 326                     'Carp::carp(',
 327                         '"The new() method for ' . $class . ' expects a '
 328                       . 'hash reference or a key/value list. You passed an '
 329                       . 'odd number of arguments"',
 330                     ');',
 331                     '$params = {@_, undef};',
 332                 '}',
 333                 'else {',
 334                     '$params = {@_};',
 335                 '}',
 336                 '$params;',
 337             '}',
 338         );
 339     }
 340     else {
 341         return $class . '->BUILDARGS(' . $args . ')';
 342     }
 343 }
 344
 345 sub _inline_slot_initializer {
 346     my $self  = shift;
 347     my ($attr, $idx) = @_;
 348
 349     return (
 350         '## ' . $attr->name,
 351         $self->_inline_check_required_attr($attr),
 352         $self->SUPER::_inline_slot_initializer(@_),
 353     );
 354 }
 355
 356 sub _inline_check_required_attr {
 357     my $self = shift;
 358     my ($attr) = @_;
 359
 360     return unless defined $attr->init_arg;
 361     return unless $attr->can('is_required') && $attr->is_required;
 362     return if $attr->has_default || $attr->has_builder;
 363
 364     return (
 365         'if (!exists $params->{\'' . $attr->init_arg . '\'}) {',
 366             $self->_inline_throw_error(
 367                 '"Attribute (' . quotemeta($attr->name) . ') is required"'
 368             ) . ';',
 369         '}',
 370     );
 371 }
 372
 373 # XXX: these two are duplicated from cmop, because we have to pass the tc stuff
 374 # through to _inline_set_value - this should probably be fixed, but i'm not
 375 # quite sure how. -doy
 376 sub _inline_init_attr_from_constructor {
 377     my $self = shift;
 378     my ($attr, $idx) = @_;
 379
 380     my @initial_value = $attr->_inline_set_value(
 381         '$instance',
 382         '$params->{\'' . $attr->init_arg . '\'}',
 383         '$type_constraint_bodies[' . $idx . ']',
 384         '$type_coercions[' . $idx . ']',
 385         '$type_constraints[' . $idx . ']',
 386         'for constructor',
 387     );
 388
 389     push @initial_value, (
 390         '$attrs->[' . $idx . ']->set_initial_value(',
 391             '$instance,',
 392             $attr->_inline_instance_get('$instance'),
 393         ');',
 394     ) if $attr->has_initializer;
 395
 396     return @initial_value;
 397 }
 398
 399 sub _inline_init_attr_from_default {
 400     my $self = shift;
 401     my ($attr, $idx) = @_;
 402
 403     return if $attr->can('is_lazy') && $attr->is_lazy;
 404     my $default = $self->_inline_default_value($attr, $idx);
 405     return unless $default;
 406
 407     my @initial_value = (
 408         'my $default = ' . $default . ';',
 409         $attr->_inline_set_value(
 410             '$instance',
 411             '$default',
 412             '$type_constraint_bodies[' . $idx . ']',
 413             '$type_coercions[' . $idx . ']',
 414             '$type_constraints[' . $idx . ']',
 415             'for constructor',
 416         ),
 417     );
 418
 419     push @initial_value, (
 420         '$attrs->[' . $idx . ']->set_initial_value(',
 421             '$instance,',
 422             $attr->_inline_instance_get('$instance'),
 423         ');',
 424     ) if $attr->has_initializer;
 425
 426     return @initial_value;
 427 }
 428
 429 sub _inline_extra_init {
 430     my $self = shift;
 431     return (
 432         $self->_inline_triggers,
 433         $self->_inline_BUILDALL,
 434     );
 435 }
 436
 437 sub _inline_triggers {
 438     my $self = shift;
 439     my @trigger_calls;
 440
 441     my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
 442     for my $i (0 .. $#attrs) {
 443         my $attr = $attrs[$i];
 444
 445         next unless $attr->can('has_trigger') && $attr->has_trigger;
 446
 447         my $init_arg = $attr->init_arg;
 448         next unless defined $init_arg;
 449
 450         push @trigger_calls,
 451             'if (exists $params->{\'' . $init_arg . '\'}) {',
 452                 '$triggers->[' . $i . ']->(',
 453                     '$instance,',
 454                     $attr->_inline_instance_get('$instance') . ',',
 455                 ');',
 456             '}';
 457     }
 458
 459     return @trigger_calls;
 460 }
 461
 462 sub _inline_BUILDALL {
 463     my $self = shift;
 464
 465     my @methods = reverse $self->find_all_methods_by_name('BUILD');
 466     my @BUILD_calls;
 467
 468     foreach my $method (@methods) {
 469         push @BUILD_calls,
 470             '$instance->' . $method->{class} . '::BUILD($params);';
 471     }
 472
 473     return @BUILD_calls;
 474 }
 475
 476 sub superclasses {
 477     my $self = shift;
 478     my $supers = Data::OptList::mkopt(\@_);
 479     foreach my $super (@{ $supers }) {
 480         my ($name, $opts) = @{ $super };
 481         Class::MOP::load_class($name, $opts);
 482         my $meta = Class::MOP::class_of($name);
 483         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 484             if $meta && $meta->isa('Moose::Meta::Role')
 485     }
 486     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 487 }
 488
 489 ### ---------------------------------------------
 490
 491 sub add_attribute {
 492     my $self = shift;
 493     my $attr =
 494         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 495             ? $_[0]
 496             : $self->_process_attribute(@_));
 497     $self->SUPER::add_attribute($attr);
 498     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 499     # 'bare' and doesn't implement this method
 500     if ($attr->can('_check_associated_methods')) {
 501         $attr->_check_associated_methods;
 502     }
 503     return $attr;
 504 }
 505
 506 sub add_override_method_modifier {
 507     my ($self, $name, $method, $_super_package) = @_;
 508
 509     (!$self->has_method($name))
 510         || $self->throw_error("Cannot add an override method if a local method is already present");
 511
 512     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 513         method  => $method,
 514         class   => $self,
 515         package => $_super_package, # need this for roles
 516         name    => $name,
 517     ));
 518 }
 519
 520 sub add_augment_method_modifier {
 521     my ($self, $name, $method) = @_;
 522     (!$self->has_method($name))
 523         || $self->throw_error("Cannot add an augment method if a local method is already present");
 524
 525     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 526         method  => $method,
 527         class   => $self,
 528         name    => $name,
 529     ));
 530 }
 531
 532 ## Private Utility methods ...
 533
 534 sub _find_next_method_by_name_which_is_not_overridden {
 535     my ($self, $name) = @_;
 536     foreach my $method ($self->find_all_methods_by_name($name)) {
 537         return $method->{code}
 538             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 539     }
 540     return undef;
 541 }
 542
 543 ## Metaclass compatibility
 544
 545 sub _base_metaclasses {
 546     my $self = shift;
 547     my %metaclasses = $self->SUPER::_base_metaclasses;
 548     for my $class (keys %metaclasses) {
 549         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 550     }
 551     return (
 552         %metaclasses,
 553         error_class => 'Moose::Error::Default',
 554     );
 555 }
 556
 557 sub _fix_class_metaclass_incompatibility {
 558     my $self = shift;
 559     my ($super_meta) = @_;
 560
 561     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 562
 563     if ($self->_class_metaclass_can_be_made_compatible($super_meta)) {
 564         ($self->is_pristine)
 565             || confess "Can't fix metaclass incompatibility for "
 566                      . $self->name
 567                      . " because it is not pristine.";
 568         my $super_meta_name = $super_meta->_real_ref_name;
 569         my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 570         my $new_self = $class_meta_subclass_meta_name->reinitialize(
 571             $self->name,
 572         );
 573
 574         $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
 575     }
 576 }
 577
 578 sub _fix_single_metaclass_incompatibility {
 579     my $self = shift;
 580     my ($metaclass_type, $super_meta) = @_;
 581
 582     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 583
 584     if ($self->_single_metaclass_can_be_made_compatible($super_meta, $metaclass_type)) {
 585         ($self->is_pristine)
 586             || confess "Can't fix metaclass incompatibility for "
 587                      . $self->name
 588                      . " because it is not pristine.";
 589         my $super_meta_name = $super_meta->_real_ref_name;
 590         my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 591         my $new_self = $super_meta->reinitialize(
 592             $self->name,
 593             $metaclass_type => $class_specific_meta_subclass_meta_name,
 594         );
 595
 596         $self->_replace_self( $new_self, $super_meta_name );
 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     my $weaken = Class::MOP::metaclass_is_weak( $self->name );
 611     Class::MOP::store_metaclass_by_name( $self->name, $self );
 612     Class::MOP::weaken_metaclass( $self->name ) if $weaken;
 613 }
 614
 615 sub _process_attribute {
 616     my ( $self, $name, @args ) = @_;
 617
 618     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 619
 620     if (($name || '') =~ /^\+(.*)/) {
 621         return $self->_process_inherited_attribute($1, @args);
 622     }
 623     else {
 624         return $self->_process_new_attribute($name, @args);
 625     }
 626 }
 627
 628 sub _process_new_attribute {
 629     my ( $self, $name, @args ) = @_;
 630
 631     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 632 }
 633
 634 sub _process_inherited_attribute {
 635     my ($self, $attr_name, %options) = @_;
 636     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 637     (defined $inherited_attr)
 638         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 639     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 640         return $inherited_attr->clone_and_inherit_options(%options);
 641     }
 642     else {
 643         # NOTE:
 644         # kind of a kludge to handle Class::MOP::Attributes
 645         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 646     }
 647 }
 648
 649 # reinitialization support
 650
 651 sub _restore_metaobjects_from {
 652     my $self = shift;
 653     my ($old_meta) = @_;
 654
 655     $self->SUPER::_restore_metaobjects_from($old_meta);
 656
 657     for my $role ( @{ $old_meta->roles } ) {
 658         $self->add_role($role);
 659     }
 660
 661     for my $application ( @{ $old_meta->_get_role_applications } ) {
 662         $application->class($self);
 663         $self->add_role_application ($application);
 664     }
 665 }
 666
 667 ## Immutability
 668
 669 sub _immutable_options {
 670     my ( $self, @args ) = @_;
 671
 672     $self->SUPER::_immutable_options(
 673         inline_destructor => 1,
 674
 675         # Moose always does this when an attribute is created
 676         inline_accessors => 0,
 677
 678         @args,
 679     );
 680 }
 681
 682 ## -------------------------------------------------
 683
 684 our $error_level;
 685
 686 sub throw_error {
 687     my ( $self, @args ) = @_;
 688     local $error_level = ($error_level || 0) + 1;
 689     $self->raise_error($self->create_error(@args));
 690 }
 691
 692 sub _inline_throw_error {
 693     my ( $self, @args ) = @_;
 694     $self->_inline_raise_error($self->_inline_create_error(@args));
 695 }
 696
 697 sub raise_error {
 698     my ( $self, @args ) = @_;
 699     die @args;
 700 }
 701
 702 sub _inline_raise_error {
 703     my ( $self, $message ) = @_;
 704
 705     return (
 706         'die ' . $message . ';',
 707     );
 708 }
 709
 710 sub create_error {
 711     my ( $self, @args ) = @_;
 712
 713     require Carp::Heavy;
 714
 715     local $error_level = ($error_level || 0 ) + 1;
 716
 717     if ( @args % 2 == 1 ) {
 718         unshift @args, "message";
 719     }
 720
 721     my %args = ( metaclass => $self, last_error => $@, @args );
 722
 723     $args{depth} += $error_level;
 724
 725     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 726
 727     Class::MOP::load_class($class);
 728
 729     $class->new(
 730         Carp::caller_info($args{depth}),
 731         %args
 732     );
 733 }
 734
 735 sub _inline_create_error {
 736     my ( $self, $msg, $args ) = @_;
 737     # XXX ignore $args for now, nothing currently uses it anyway
 738
 739     require Carp::Heavy;
 740
 741     my %args = (
 742         metaclass  => $self,
 743         last_error => $@,
 744         message    => $msg,
 745     );
 746
 747     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 748
 749     Class::MOP::load_class($class);
 750
 751     # don't check inheritance here - the intention is that the class needs
 752     # to provide a non-inherited inlining method, because falling back to
 753     # the default inlining method is most likely going to be wrong
 754     # yes, this is a huge hack, but so is the entire error system, so.
 755     return '$meta->create_error(' . $msg . ', ' . $args . ');'
 756         unless $class->meta->has_method('_inline_new');
 757
 758     $class->_inline_new(
 759         # XXX ignore this for now too
 760         # Carp::caller_info($args{depth}),
 761         %args
 762     );
 763 }
 764
 765 1;
 766
 767 # ABSTRACT: The Moose metaclass
 768
 769 __END__
 770
 771 =pod
 772
 773 =head1 DESCRIPTION
 774
 775 This class is a subclass of L<Class::MOP::Class> that provides
 776 additional Moose-specific functionality.
 777
 778 To really understand this class, you will need to start with the
 779 L<Class::MOP::Class> documentation. This class can be understood as a
 780 set of additional features on top of the basic feature provided by
 781 that parent class.
 782
 783 =head1 INHERITANCE
 784
 785 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 786
 787 =head1 METHODS
 788
 789 =over 4
 790
 791 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 792
 793 This overrides the parent's method in order to provide its own
 794 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 795 C<method_metaclass> options.
 796
 797 These all default to the appropriate Moose class.
 798
 799 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 800
 801 This overrides the parent's method in order to accept a C<roles>
 802 option. This should be an array reference containing roles
 803 that the class does, each optionally followed by a hashref of options
 804 (C<-excludes> and C<-alias>).
 805
 806   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 807
 808 =item B<< Moose::Meta::Class->create_anon_class >>
 809
 810 This overrides the parent's method to accept a C<roles> option, just
 811 as C<create> does.
 812
 813 It also accepts a C<cache> option. If this is true, then the anonymous
 814 class will be cached based on its superclasses and roles. If an
 815 existing anonymous class in the cache has the same superclasses and
 816 roles, it will be reused.
 817
 818   my $metaclass = Moose::Meta::Class->create_anon_class(
 819       superclasses => ['Foo'],
 820       roles        => [qw/Some Roles Go Here/],
 821       cache        => 1,
 822   );
 823
 824 Each entry in both the C<superclasses> and the C<roles> option can be
 825 followed by a hash reference with arguments. The C<superclasses>
 826 option can be supplied with a L<-version|Class::MOP/Class Loading
 827 Options> option that ensures the loaded superclass satisfies the
 828 required version. The C<role> option also takes the C<-version> as an
 829 argument, but the option hash reference can also contain any other
 830 role relevant values like exclusions or parameterized role arguments.
 831
 832 =item B<< $metaclass->make_immutable(%options) >>
 833
 834 This overrides the parent's method to add a few options. Specifically,
 835 it uses the Moose-specific constructor and destructor classes, and
 836 enables inlining the destructor.
 837
 838 Since Moose always inlines attributes, it sets the C<inline_accessors> option
 839 to false.
 840
 841 =item B<< $metaclass->new_object(%params) >>
 842
 843 This overrides the parent's method in order to add support for
 844 attribute triggers.
 845
 846 =item B<< $metaclass->superclasses(@superclasses) >>
 847
 848 This is the accessor allowing you to read or change the parents of
 849 the class.
 850
 851 Each superclass can be followed by a hash reference containing a
 852 L<-version|Class::MOP/Class Loading Options> value. If the version
 853 requirement is not satisfied an error will be thrown.
 854
 855 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 856
 857 This adds an C<override> method modifier to the package.
 858
 859 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 860
 861 This adds an C<augment> method modifier to the package.
 862
 863 =item B<< $metaclass->calculate_all_roles >>
 864
 865 This will return a unique array of C<Moose::Meta::Role> instances
 866 which are attached to this class.
 867
 868 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 869
 870 This will return a unique array of C<Moose::Meta::Role> instances
 871 which are attached to this class, and each of this class's ancestors.
 872
 873 =item B<< $metaclass->add_role($role) >>
 874
 875 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 876 list of roles. This I<does not> actually apply the role to the class.
 877
 878 =item B<< $metaclass->role_applications >>
 879
 880 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 881 objects, which contain the arguments to role application.
 882
 883 =item B<< $metaclass->add_role_application($application) >>
 884
 885 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 886 adds it to the class's list of role applications. This I<does not>
 887 actually apply any role to the class; it is only for tracking role
 888 applications.
 889
 890 =item B<< $metaclass->does_role($role) >>
 891
 892 This returns a boolean indicating whether or not the class does the specified
 893 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 894 object. This tests both the class and its parents.
 895
 896 =item B<< $metaclass->excludes_role($role_name) >>
 897
 898 A class excludes a role if it has already composed a role which
 899 excludes the named role. This tests both the class and its parents.
 900
 901 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 902
 903 This overrides the parent's method in order to allow the parameters to
 904 be provided as a hash reference.
 905
 906 =item B<< $metaclass->constructor_class($class_name) >>
 907
 908 =item B<< $metaclass->destructor_class($class_name) >>
 909
 910 These are the names of classes used when making a class immutable. These
 911 default to L<Moose::Meta::Method::Constructor> and
 912 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 913 read-write, so you can use them to change the class name.
 914
 915 =item B<< $metaclass->error_class($class_name) >>
 916
 917 The name of the class used to throw errors. This defaults to
 918 L<Moose::Error::Default>, which generates an error with a stacktrace
 919 just like C<Carp::confess>.
 920
 921 =item B<< $metaclass->throw_error($message, %extra) >>
 922
 923 Throws the error created by C<create_error> using C<raise_error>
 924
 925 =back
 926
 927 =head1 BUGS
 928
 929 See L<Moose/BUGS> for details on reporting bugs.
 930
 931 =cut
 932