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