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