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 ();
  10 use List::Util qw( first );
  11 use List::MoreUtils qw( any all );
  12 use Scalar::Util 'weaken', 'blessed';
  13
  14 our $VERSION   = '0.57';
  15 $VERSION = eval $VERSION;
  16 our $AUTHORITY = 'cpan:STEVAN';
  17
  18 use Moose::Meta::Method::Overriden;
  19 use Moose::Meta::Method::Augmented;
  20
  21 use base 'Class::MOP::Class';
  22
  23 __PACKAGE__->meta->add_attribute('roles' => (
  24     reader  => 'roles',
  25     default => sub { [] }
  26 ));
  27
  28 __PACKAGE__->meta->add_attribute('constructor_class' => (
  29     accessor => 'constructor_class',
  30     default  => sub { 'Moose::Meta::Method::Constructor' }
  31 ));
  32
  33 __PACKAGE__->meta->add_attribute('destructor_class' => (
  34     accessor => 'destructor_class',
  35     default  => sub { 'Moose::Meta::Method::Destructor' }
  36 ));
  37
  38 __PACKAGE__->meta->add_attribute('error_builder' => (
  39     reader  => 'error_builder',
  40     default => 'confess',
  41 ));
  42
  43 __PACKAGE__->meta->add_attribute('error_class' => (
  44     reader  => 'error_class',
  45 ));
  46
  47
  48 sub initialize {
  49     my $class = shift;
  50     my $pkg   = shift;
  51     return Class::MOP::get_metaclass_by_name($pkg)
  52         || $class->SUPER::initialize($pkg,
  53                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  54                 'method_metaclass'    => 'Moose::Meta::Method',
  55                 'instance_metaclass'  => 'Moose::Meta::Instance',
  56                 @_
  57             );
  58 }
  59
  60 sub create {
  61     my ($self, $package_name, %options) = @_;
  62
  63     (ref $options{roles} eq 'ARRAY')
  64         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  65             if exists $options{roles};
  66
  67     my $super = delete $options{superclasses};
  68
  69     my $class = $self->SUPER::create($package_name, %options);
  70
  71     if ( my @super = @{ $super || [] } ) {
  72         $class->_fix_metaclass_incompatibility(@super);
  73         $class->superclasses(@super);
  74     }
  75
  76     if (exists $options{roles}) {
  77         Moose::Util::apply_all_roles($class, @{$options{roles}});
  78     }
  79
  80     return $class;
  81 }
  82
  83 my %ANON_CLASSES;
  84
  85 sub create_anon_class {
  86     my ($self, %options) = @_;
  87
  88     my $cache_ok = delete $options{cache};
  89
  90     # something like Super::Class|Super::Class::2=Role|Role::1
  91     my $cache_key = join '=' => (
  92         join('|', sort @{$options{superclasses} || []}),
  93         join('|', sort @{$options{roles}        || []}),
  94     );
  95
  96     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
  97         return $ANON_CLASSES{$cache_key};
  98     }
  99
 100     my $new_class = $self->SUPER::create_anon_class(%options);
 101
 102     $ANON_CLASSES{$cache_key} = $new_class
 103         if $cache_ok;
 104
 105     return $new_class;
 106 }
 107
 108 sub add_role {
 109     my ($self, $role) = @_;
 110     (blessed($role) && $role->isa('Moose::Meta::Role'))
 111         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 112     push @{$self->roles} => $role;
 113 }
 114
 115 sub calculate_all_roles {
 116     my $self = shift;
 117     my %seen;
 118     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 119 }
 120
 121 sub does_role {
 122     my ($self, $role_name) = @_;
 123     (defined $role_name)
 124         || $self->throw_error("You must supply a role name to look for");
 125     foreach my $class ($self->class_precedence_list) {
 126         next unless $class->can('meta') && $class->meta->can('roles');
 127         foreach my $role (@{$class->meta->roles}) {
 128             return 1 if $role->does_role($role_name);
 129         }
 130     }
 131     return 0;
 132 }
 133
 134 sub excludes_role {
 135     my ($self, $role_name) = @_;
 136     (defined $role_name)
 137         || $self->throw_error("You must supply a role name to look for");
 138     foreach my $class ($self->class_precedence_list) {
 139         next unless $class->can('meta');
 140         # NOTE:
 141         # in the pretty rare instance when a Moose metaclass
 142         # is itself extended with a role, this check needs to
 143         # be done since some items in the class_precedence_list
 144         # might in fact be Class::MOP based still.
 145         next unless $class->meta->can('roles');
 146         foreach my $role (@{$class->meta->roles}) {
 147             return 1 if $role->excludes_role($role_name);
 148         }
 149     }
 150     return 0;
 151 }
 152
 153 sub new_object {
 154     my $class = shift;
 155     my $params = @_ == 1 ? $_[0] : {@_};
 156     my $self = $class->SUPER::new_object($params);
 157     foreach my $attr ($class->compute_all_applicable_attributes()) {
 158         # if we have a trigger, then ...
 159         if ($attr->can('has_trigger') && $attr->has_trigger) {
 160             # make sure we have an init-arg ...
 161             if (defined(my $init_arg = $attr->init_arg)) {
 162                 # now make sure an init-arg was passes ...
 163                 if (exists $params->{$init_arg}) {
 164                     # and if get here, fire the trigger
 165                     $attr->trigger->(
 166                         $self,
 167                         # check if there is a coercion
 168                         ($attr->should_coerce
 169                             # and if so, we need to grab the
 170                             # value that is actually been stored
 171                             ? $attr->get_read_method_ref->($self)
 172                             # otherwise, just get the value from
 173                             # the constructor params
 174                             : $params->{$init_arg}),
 175                         $attr
 176                     );
 177                 }
 178             }
 179         }
 180     }
 181     return $self;
 182 }
 183
 184 sub construct_instance {
 185     my $class = shift;
 186     my $params = @_ == 1 ? $_[0] : {@_};
 187     my $meta_instance = $class->get_meta_instance;
 188     # FIXME:
 189     # the code below is almost certainly incorrect
 190     # but this is foreign inheritence, so we might
 191     # have to kludge it in the end.
 192     my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance();
 193     foreach my $attr ($class->compute_all_applicable_attributes()) {
 194         $attr->initialize_instance_slot($meta_instance, $instance, $params);
 195     }
 196     return $instance;
 197 }
 198
 199 # FIXME:
 200 # This is ugly
 201 sub get_method_map {
 202     my $self = shift;
 203
 204     my $current = Class::MOP::check_package_cache_flag($self->name);
 205
 206     if (defined $self->{'_package_cache_flag'} && $self->{'_package_cache_flag'} == $current) {
 207         return $self->{'methods'};
 208     }
 209
 210     $self->{_package_cache_flag} = $current;
 211
 212     my $map  = $self->{'methods'};
 213
 214     my $class_name       = $self->name;
 215     my $method_metaclass = $self->method_metaclass;
 216
 217     my %all_code = $self->get_all_package_symbols('CODE');
 218
 219     foreach my $symbol (keys %all_code) {
 220         my $code = $all_code{$symbol};
 221
 222         next if exists  $map->{$symbol} &&
 223                 defined $map->{$symbol} &&
 224                         $map->{$symbol}->body == $code;
 225
 226         my ($pkg, $name) = Class::MOP::get_code_info($code);
 227
 228         if ($pkg->can('meta')
 229             # NOTE:
 230             # we don't know what ->meta we are calling
 231             # here, so we need to be careful cause it
 232             # just might blow up at us, or just complain
 233             # loudly (in the case of Curses.pm) so we
 234             # just be a little overly cautious here.
 235             # - SL
 236             && eval { no warnings; blessed($pkg->meta) }
 237             && $pkg->meta->isa('Moose::Meta::Role')) {
 238             #my $role = $pkg->meta->name;
 239             #next unless $self->does_role($role);
 240         }
 241         else {
 242
 243             # NOTE:
 244             # in 5.10 constant.pm the constants show up
 245             # as being in the right package, but in pre-5.10
 246             # they show up as constant::__ANON__ so we
 247             # make an exception here to be sure that things
 248             # work as expected in both.
 249             # - SL
 250             unless ($pkg eq 'constant' && $name eq '__ANON__') {
 251                 next if ($pkg  || '') ne $class_name ||
 252                         (($name || '') ne '__ANON__' && ($pkg  || '') ne $class_name);
 253             }
 254
 255         }
 256
 257         $map->{$symbol} = $method_metaclass->wrap(
 258             $code,
 259             package_name => $class_name,
 260             name         => $symbol
 261         );
 262     }
 263
 264     return $map;
 265 }
 266
 267 ### ---------------------------------------------
 268
 269 sub add_attribute {
 270     my $self = shift;
 271     $self->SUPER::add_attribute(
 272         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 273             ? $_[0]
 274             : $self->_process_attribute(@_))
 275     );
 276 }
 277
 278 sub add_override_method_modifier {
 279     my ($self, $name, $method, $_super_package) = @_;
 280
 281     (!$self->has_method($name))
 282         || $self->throw_error("Cannot add an override method if a local method is already present");
 283
 284     $self->add_method($name => Moose::Meta::Method::Overriden->new(
 285         method  => $method,
 286         class   => $self,
 287         package => $_super_package, # need this for roles
 288         name    => $name,
 289     ));
 290 }
 291
 292 sub add_augment_method_modifier {
 293     my ($self, $name, $method) = @_;
 294     (!$self->has_method($name))
 295         || $self->throw_error("Cannot add an augment method if a local method is already present");
 296
 297     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 298         method  => $method,
 299         class   => $self,
 300         name    => $name,
 301     ));
 302 }
 303
 304 ## Private Utility methods ...
 305
 306 sub _find_next_method_by_name_which_is_not_overridden {
 307     my ($self, $name) = @_;
 308     foreach my $method ($self->find_all_methods_by_name($name)) {
 309         return $method->{code}
 310             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
 311     }
 312     return undef;
 313 }
 314
 315 sub _fix_metaclass_incompatibility {
 316     my ($self, @superclasses) = @_;
 317
 318     foreach my $super (@superclasses) {
 319         next if $self->_superclass_meta_is_compatible($super);
 320
 321         unless ( $self->is_pristine ) {
 322             $self->throw_error(
 323                       "Cannot attempt to reinitialize metaclass for "
 324                     . $self->name
 325                     . ", it isn't pristine" );
 326         }
 327
 328         $self->_reconcile_with_superclass_meta($super);
 329     }
 330 }
 331
 332 sub _superclass_meta_is_compatible {
 333     my ($self, $super) = @_;
 334
 335     my $super_meta = Class::MOP::Class->initialize($super)
 336         or return 1;
 337
 338     next unless $super_meta->isa("Class::MOP::Class");
 339
 340     my $super_meta_name
 341         = $super_meta->is_immutable
 342         ? $super_meta->get_mutable_metaclass_name
 343         : ref($super_meta);
 344
 345     return 1
 346         if $self->isa($super_meta_name)
 347             and
 348            $self->instance_metaclass->isa( $super_meta->instance_metaclass );
 349 }
 350
 351 # I don't want to have to type this >1 time
 352 my @MetaClassTypes =
 353     qw( attribute_metaclass method_metaclass instance_metaclass constructor_class destructor_class );
 354
 355 sub _reconcile_with_superclass_meta {
 356     my ($self, $super) = @_;
 357
 358     my $super_meta = $super->meta;
 359
 360     my $super_meta_name
 361         = $super_meta->is_immutable
 362         ? $super_meta->get_mutable_metaclass_name
 363         : ref($super_meta);
 364
 365     my $self_metaclass = ref $self;
 366
 367     # If neither of these is true we have a more serious
 368     # incompatibility that we just cannot fix (yet?).
 369     if ( $super_meta_name->isa( ref $self )
 370         && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) {
 371         $self->_reinitialize_with($super_meta);
 372     }
 373     elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) {
 374         $self->_reconcile_role_differences($super_meta);
 375     }
 376 }
 377
 378 sub _reinitialize_with {
 379     my ( $self, $new_meta ) = @_;
 380
 381     my $new_self = $new_meta->reinitialize(
 382         $self->name,
 383         attribute_metaclass => $new_meta->attribute_metaclass,
 384         method_metaclass    => $new_meta->method_metaclass,
 385         instance_metaclass  => $new_meta->instance_metaclass,
 386     );
 387
 388     $new_self->$_( $new_meta->$_ ) for qw( constructor_class destructor_class );
 389
 390     %$self = %$new_self;
 391
 392     bless $self, ref $new_self;
 393
 394     Class::MOP::store_metaclass_by_name( $self->name, $self );
 395 }
 396
 397 # In the more complex case, we share a common ancestor with our
 398 # superclass's metaclass, but each metaclass (ours and the parent's)
 399 # has a different set of roles applied. We reconcile this by first
 400 # reinitializing into the parent class, and _then_ applying our own
 401 # roles.
 402 sub _all_metaclasses_differ_by_roles_only {
 403     my ($self, $super_meta) = @_;
 404
 405     for my $pair (
 406         [ ref $self, ref $super_meta ],
 407         map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes
 408         ) {
 409
 410         next if $pair->[0] eq $pair->[1];
 411
 412         my $self_meta_meta  = Class::MOP::Class->initialize( $pair->[0] );
 413         my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] );
 414
 415         my $common_ancestor
 416             = _find_common_ancestor( $self_meta_meta, $super_meta_meta );
 417
 418         return unless $common_ancestor;
 419
 420         return
 421             unless _is_role_only_subclass_of(
 422             $self_meta_meta,
 423             $common_ancestor,
 424             )
 425             && _is_role_only_subclass_of(
 426             $super_meta_meta,
 427             $common_ancestor,
 428             );
 429     }
 430
 431     return 1;
 432 }
 433
 434 # This, and some other functions, could be called as methods, but
 435 # they're not for two reasons. One, we just end up ignoring the first
 436 # argument, because we can't call these directly on one of the real
 437 # arguments, because one of them could be a Class::MOP::Class object
 438 # and not a Moose::Meta::Class. Second, only a completely insane
 439 # person would attempt to subclass this stuff!
 440 sub _find_common_ancestor {
 441     my ($meta1, $meta2) = @_;
 442
 443     # FIXME? This doesn't account for multiple inheritance (not sure
 444     # if it needs to though). For example, is somewhere in $meta1's
 445     # history it inherits from both ClassA and ClassB, and $meta
 446     # inherits from ClassB & ClassA, does it matter? And what crazy
 447     # fool would do that anyway?
 448
 449     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 450
 451     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 452 }
 453
 454 sub _is_role_only_subclass_of {
 455     my ($meta, $ancestor) = @_;
 456
 457     return 1 if $meta->name eq $ancestor;
 458
 459     my @roles = _all_roles_until( $meta, $ancestor );
 460
 461     my %role_packages = map { $_->name => 1 } @roles;
 462
 463     my $ancestor_meta = Class::MOP::Class->initialize($ancestor);
 464
 465     my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa;
 466
 467     for my $method ( $meta->get_all_methods() ) {
 468         next if $method->name eq 'meta';
 469         next if $method->can('associated_attribute');
 470
 471         next
 472             if $role_packages{ $method->original_package_name }
 473                 || $shared_ancestors{ $method->original_package_name };
 474
 475         return 0;
 476     }
 477
 478     # FIXME - this really isn't right. Just because an attribute is
 479     # defined in a role doesn't mean it isn't _also_ defined in the
 480     # subclass.
 481     for my $attr ( $meta->get_all_attributes ) {
 482         next if $shared_ancestors{ $attr->associated_class->name };
 483
 484         next if any { $_->has_attribute( $attr->name ) } @roles;
 485
 486         return 0;
 487     }
 488
 489     return 1;
 490 }
 491
 492 sub _all_roles {
 493     my $meta = shift;
 494
 495     return _all_roles_until($meta);
 496 }
 497
 498 sub _all_roles_until {
 499     my ($meta, $stop_at_class) = @_;
 500
 501     return unless $meta->can('calculate_all_roles');
 502
 503     my @roles = $meta->calculate_all_roles;
 504
 505     for my $class ( $meta->linearized_isa ) {
 506         last if $stop_at_class && $stop_at_class eq $class;
 507
 508         my $meta = Class::MOP::Class->initialize($class);
 509         last unless $meta->can('calculate_all_roles');
 510
 511         push @roles, $meta->calculate_all_roles;
 512     }
 513
 514     return @roles;
 515 }
 516
 517 sub _reconcile_role_differences {
 518     my ($self, $super_meta) = @_;
 519
 520     my $self_meta = $self->meta;
 521
 522     my %roles;
 523
 524     if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
 525         $roles{metaclass_roles} = \@roles;
 526     }
 527
 528     for my $thing (@MetaClassTypes) {
 529         my $name = $self->$thing();
 530
 531         my $thing_meta = Class::MOP::Class->initialize($name);
 532
 533         my @roles = map { $_->name } _all_roles($thing_meta)
 534             or next;
 535
 536         $roles{ $thing . '_roles' } = \@roles;
 537     }
 538
 539     $self = $self->_reinitialize_with($super_meta);
 540
 541     Moose::Util::MetaRole::apply_metaclass_roles(
 542         for_class => $self->name,
 543         %roles,
 544     );
 545
 546     return $self;
 547 }
 548
 549 # NOTE:
 550 # this was crap anyway, see
 551 # Moose::Util::apply_all_roles
 552 # instead
 553 sub _apply_all_roles {
 554     Carp::croak 'DEPRECATED: use Moose::Util::apply_all_roles($meta, @roles) instead'
 555 }
 556
 557 sub _process_attribute {
 558     my ( $self, $name, @args ) = @_;
 559
 560     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 561
 562     if ($name =~ /^\+(.*)/) {
 563         return $self->_process_inherited_attribute($1, @args);
 564     }
 565     else {
 566         return $self->_process_new_attribute($name, @args);
 567     }
 568 }
 569
 570 sub _process_new_attribute {
 571     my ( $self, $name, @args ) = @_;
 572
 573     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 574 }
 575
 576 sub _process_inherited_attribute {
 577     my ($self, $attr_name, %options) = @_;
 578     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 579     (defined $inherited_attr)
 580         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from", data => $attr_name);
 581     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 582         return $inherited_attr->clone_and_inherit_options(%options);
 583     }
 584     else {
 585         # NOTE:
 586         # kind of a kludge to handle Class::MOP::Attributes
 587         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 588     }
 589 }
 590
 591 ## -------------------------------------------------
 592
 593 use Moose::Meta::Method::Constructor;
 594 use Moose::Meta::Method::Destructor;
 595
 596 # This could be done by using SUPER and altering ->options
 597 # I am keeping it this way to make it more explicit.
 598 sub create_immutable_transformer {
 599     my $self = shift;
 600     my $class = Class::MOP::Immutable->new($self, {
 601        read_only   => [qw/superclasses/],
 602        cannot_call => [qw/
 603            add_method
 604            alias_method
 605            remove_method
 606            add_attribute
 607            remove_attribute
 608            remove_package_symbol
 609            add_role
 610        /],
 611        memoize     => {
 612            class_precedence_list             => 'ARRAY',
 613            linearized_isa                    => 'ARRAY', # FIXME perl 5.10 memoizes this on its own, no need?
 614            get_all_methods                   => 'ARRAY',
 615            #get_all_attributes               => 'ARRAY', # it's an alias, no need, but maybe in the future
 616            compute_all_applicable_attributes => 'ARRAY',
 617            get_meta_instance                 => 'SCALAR',
 618            get_method_map                    => 'SCALAR',
 619            calculate_all_roles               => 'ARRAY',
 620        },
 621        # NOTE:
 622        # this is ugly, but so are typeglobs,
 623        # so whattayahgonnadoboutit
 624        # - SL
 625        wrapped => {
 626            add_package_symbol => sub {
 627                my $original = shift;
 628                $self->throw_error("Cannot add package symbols to an immutable metaclass")
 629                    unless (caller(2))[3] eq 'Class::MOP::Package::get_package_symbol';
 630                goto $original->body;
 631            },
 632        },
 633     });
 634     return $class;
 635 }
 636
 637 sub make_immutable {
 638     my $self = shift;
 639     $self->SUPER::make_immutable
 640       (
 641        constructor_class => $self->constructor_class,
 642        destructor_class  => $self->destructor_class,
 643        inline_destructor => 1,
 644        # NOTE:
 645        # no need to do this,
 646        # Moose always does it
 647        inline_accessors  => 0,
 648        @_,
 649       );
 650 }
 651
 652 #{ package Moose::Meta::Class::ErrorRoutines; %Carp::Internal?
 653
 654 our $level;
 655
 656 sub throw_error {
 657     my ( $self, @args ) = @_;
 658     local $level = 1;
 659     $self->raise_error($self->create_error(@args));
 660 }
 661
 662 sub raise_error {
 663     my ( $self, @args ) = @_;
 664     die @args;
 665 }
 666
 667 sub create_error {
 668     my ( $self, @args ) = @_;
 669
 670     if ( @args % 2 == 1 ) {
 671         unshift @args, "message";
 672     }
 673
 674     my %args = ( meta => $self, error => $@, @args );
 675
 676     local $level = $level + 1;
 677
 678     if ( my $class = $args{class} || ( ref $self && $self->error_class ) ) {
 679         return $self->create_error_object( %args, class => $class );
 680     } else {
 681         my $builder = $args{builder} || ( ref($self) ? $self->error_builder : "confess" );
 682
 683         my $builder_method = ( ( ref($builder) && ref($builder) eq 'CODE' )
 684             ? $builder
 685             : ( $self->can("create_error_$builder") || "create_error_confess" ));
 686
 687         return $self->$builder_method(%args);
 688     }
 689 }
 690
 691 sub create_error_object {
 692     my ( $self, %args ) = @_;
 693
 694     my $class = delete $args{class};
 695
 696     $class->new(
 697         %args,
 698         depth => ( ($args{depth} || 1) + ( $level + 1 ) ),
 699     );
 700 }
 701
 702 sub create_error_croak {
 703     my ( $self, @args ) = @_;
 704     $self->_create_error_carpmess( @args );
 705 }
 706
 707 sub create_error_confess {
 708     my ( $self, @args ) = @_;
 709     $self->_create_error_carpmess( @args, longmess => 1 );
 710 }
 711
 712 sub _create_error_carpmess {
 713     my ( $self, %args ) = @_;
 714
 715     my $carp_level = $level + 1 + ( $args{depth} || 1 );
 716
 717     local $Carp::CarpLevel = $carp_level; # $Carp::CarpLevel + $carp_level ?
 718     local $Carp::MaxArgNums = 20;         # default is 8, usually we use named args which gets messier though
 719
 720     my @args = exists $args{message} ? $args{message} : ();
 721
 722     if ( $args{longmess} ) {
 723         return Carp::longmess(@args);
 724     } else {
 725         return Carp::shortmess(@args);
 726     }
 727 }
 728
 729 1;
 730
 731 __END__
 732
 733 =pod
 734
 735 =head1 NAME
 736
 737 Moose::Meta::Class - The Moose metaclass
 738
 739 =head1 DESCRIPTION
 740
 741 This is a subclass of L<Class::MOP::Class> with Moose specific
 742 extensions.
 743
 744 For the most part, the only time you will ever encounter an
 745 instance of this class is if you are doing some serious deep
 746 introspection. To really understand this class, you need to refer
 747 to the L<Class::MOP::Class> documentation.
 748
 749 =head1 METHODS
 750
 751 =over 4
 752
 753 =item B<initialize>
 754
 755 =item B<create>
 756
 757 Overrides original to accept a list of roles to apply to
 758 the created class.
 759
 760    my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 761
 762 =item B<create_anon_class>
 763
 764 Overrides original to support roles and caching.
 765
 766    my $metaclass = Moose::Meta::Class->create_anon_class(
 767        superclasses => ['Foo'],
 768        roles        => [qw/Some Roles Go Here/],
 769        cache        => 1,
 770    );
 771
 772 =item B<make_immutable>
 773
 774 Override original to add default options for inlining destructor
 775 and altering the Constructor metaclass.
 776
 777 =item B<create_immutable_transformer>
 778
 779 Override original to lock C<add_role> and memoize C<calculate_all_roles>
 780
 781 =item B<new_object>
 782
 783 We override this method to support the C<trigger> attribute option.
 784
 785 =item B<construct_instance>
 786
 787 This provides some Moose specific extensions to this method, you
 788 almost never call this method directly unless you really know what
 789 you are doing.
 790
 791 This method makes sure to handle the moose weak-ref, type-constraint
 792 and type coercion features.
 793
 794 =item B<get_method_map>
 795
 796 This accommodates Moose::Meta::Role::Method instances, which are
 797 aliased, instead of added, but still need to be counted as valid
 798 methods.
 799
 800 =item B<add_override_method_modifier ($name, $method)>
 801
 802 This will create an C<override> method modifier for you, and install
 803 it in the package.
 804
 805 =item B<add_augment_method_modifier ($name, $method)>
 806
 807 This will create an C<augment> method modifier for you, and install
 808 it in the package.
 809
 810 =item B<calculate_all_roles>
 811
 812 =item B<roles>
 813
 814 This will return an array of C<Moose::Meta::Role> instances which are
 815 attached to this class.
 816
 817 =item B<add_role ($role)>
 818
 819 This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
 820 to the list of associated roles.
 821
 822 =item B<does_role ($role_name)>
 823
 824 This will test if this class C<does> a given C<$role_name>. It will
 825 not only check it's local roles, but ask them as well in order to
 826 cascade down the role hierarchy.
 827
 828 =item B<excludes_role ($role_name)>
 829
 830 This will test if this class C<excludes> a given C<$role_name>. It will
 831 not only check it's local roles, but ask them as well in order to
 832 cascade down the role hierarchy.
 833
 834 =item B<add_attribute ($attr_name, %params|$params)>
 835
 836 This method does the same thing as L<Class::MOP::Class::add_attribute>, but adds
 837 support for taking the C<$params> as a HASH ref.
 838
 839 =item B<constructor_class ($class_name)>
 840
 841 =item B<destructor_class ($class_name)>
 842
 843 These are the names of classes used when making a class
 844 immutable. These default to L<Moose::Meta::Method::Constructor> and
 845 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 846 read-write, so you can use them to change the class name.
 847
 848 =item B<throw_error $message, %extra>
 849
 850 Throws the error created by C<create_error> using C<raise_error>
 851
 852 =item B<create_error $message, %extra>
 853
 854 Creates an error message or object.
 855
 856 The default behavior is C<create_error_confess>.
 857
 858 If C<error_class> is set uses C<create_error_object>. Otherwise uses
 859 C<error_builder> (a code reference or variant name), and calls the appropriate
 860 C<create_error_$builder> method.
 861
 862 =item B<error_builder $builder_name>
 863
 864 Get or set the error builder. Defaults to C<confess>.
 865
 866 =item B<error_class $class_name>
 867
 868 Get or set the error class. Has no default.
 869
 870 =item B<create_error_confess %args>
 871
 872 Creates an error using L<Carp/longmess>
 873
 874 =item B<create_error_croak %args>
 875
 876 Creates an error using L<Carp/shortmess>
 877
 878 =item B<create_error_object %args>
 879
 880 Calls C<new> on the C<class> parameter in C<%args>. Usable with C<error_class>
 881 to support custom error objects for your meta class.
 882
 883 =item B<raise_error $error>
 884
 885 Dies with an error object or string.
 886
 887 =back
 888
 889 =head1 BUGS
 890
 891 All complex software has bugs lurking in it, and this module is no
 892 exception. If you find a bug please either email me, or add the bug
 893 to cpan-RT.
 894
 895 =head1 AUTHOR
 896
 897 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 898
 899 =head1 COPYRIGHT AND LICENSE
 900
 901 Copyright 2006-2008 by Infinity Interactive, Inc.
 902
 903 L<http://www.iinteractive.com>
 904
 905 This library is free software; you can redistribute it and/or modify
 906 it under the same terms as Perl itself.
 907
 908 =cut
 909