[gitmo/Moose.git] / lib / Moose / Meta / Class.pm


package Moose::Meta::Class;

use strict;
use warnings;

use Class::MOP;

use Carp         'confess';
use Scalar::Util 'weaken', 'blessed', 'reftype';

our $VERSION = '0.07';

use base 'Class::MOP::Class';

__PACKAGE__->meta->add_attribute('roles' => (
    reader  => 'roles',
    default => sub { [] }
));

sub initialize {
    my $class = shift;
    my $pkg   = shift;
    $class->SUPER::initialize($pkg,
        ':attribute_metaclass' => 'Moose::Meta::Attribute', 
        ':instance_metaclass'  => 'Moose::Meta::Instance', 
        @_);
}  

sub add_role {
    my ($self, $role) = @_;
    (blessed($role) && $role->isa('Moose::Meta::Role'))
        || confess "Roles must be instances of Moose::Meta::Role";
    push @{$self->roles} => $role;
}

sub calculate_all_roles {
    my $self = shift;
    my %seen;
    grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
}

sub does_role {
    my ($self, $role_name) = @_;
    (defined $role_name)
        || confess "You must supply a role name to look for";
    foreach my $class ($self->class_precedence_list) {
        next unless $class->can('meta');        
        foreach my $role (@{$class->meta->roles}) {
            return 1 if $role->does_role($role_name);
        }
    }
    return 0;
}

sub excludes_role {
    my ($self, $role_name) = @_;
    (defined $role_name)
        || confess "You must supply a role name to look for";
    foreach my $class ($self->class_precedence_list) {  
        next unless $class->can('meta');      
        foreach my $role (@{$class->meta->roles}) {
            return 1 if $role->excludes_role($role_name);
        }
    }
    return 0;
}

sub new_object {
    my ($class, %params) = @_;
    my $self = $class->SUPER::new_object(%params);
    foreach my $attr ($class->compute_all_applicable_attributes()) {
        # FIXME:
        # this does not accept undefined
        # values, nor does it accept false 
        # values to be passed into the init-arg
        next unless $params{$attr->init_arg} && $attr->can('has_trigger') && $attr->has_trigger;
        $attr->trigger->($self, $params{$attr->init_arg}, $attr);
    }
    return $self;    
}

sub construct_instance {
    my ($class, %params) = @_;
    my $meta_instance = $class->get_meta_instance;
    # FIXME:
    # the code below is almost certainly incorrect
    # but this is foreign inheritence, so we might
    # have to kludge it in the end. 
    my $instance = $params{'__INSTANCE__'} || $meta_instance->create_instance();
    foreach my $attr ($class->compute_all_applicable_attributes()) { 
        $attr->initialize_instance_slot($meta_instance, $instance, \%params)
    }
    return $instance;
}


# FIXME:
# This is ugly
sub get_method_map {    
    my $self = shift;
    my $map  = $self->{'%:methods'}; 
    
    my $class_name       = $self->name;
    my $method_metaclass = $self->method_metaclass;
    
    foreach my $symbol ($self->list_all_package_symbols('CODE')) {
        
        my $code = $self->get_package_symbol('&' . $symbol);
        
        next if exists  $map->{$symbol} && 
                defined $map->{$symbol} && 
                        $map->{$symbol}->body == $code;        
        
        my $gv = B::svref_2object($code)->GV;
        
        my $pkg = $gv->STASH->NAME;
        if ($pkg->can('meta') && $pkg->meta->isa('Moose::Meta::Role')) {
            #my $role = $pkg->meta->name;
            #next unless $self->does_role($role);
        }
        else {
            next if ($gv->STASH->NAME || '') ne $class_name &&
                    ($gv->NAME        || '') ne '__ANON__';                
        }
   
        $map->{$symbol} = $method_metaclass->wrap($code);
    }
    
    return $map;
}

#sub find_method_by_name {
#    my ($self, $method_name) = @_;
#    (defined $method_name && $method_name)
#        || confess "You must define a method name to find";    
#    # keep a record of what we have seen
#    # here, this will handle all the 
#    # inheritence issues because we are 
#    # using the &class_precedence_list
#    my %seen_class;
#    foreach my $class ($self->class_precedence_list()) {
#        next if $seen_class{$class};
#        $seen_class{$class}++;
#        # fetch the meta-class ...
#        my $meta = $self->initialize($class);
#        return $meta->get_method($method_name) 
#            if $meta->has_method($method_name);
#    }
#}

### ---------------------------------------------

sub add_attribute {
    my $self = shift;
    my $name = shift;
    if (scalar @_ == 1 && ref($_[0]) eq 'HASH') {
        # NOTE:
        # if it is a HASH ref, we de-ref it.        
        # this will usually mean that it is 
        # coming from a role
        $self->SUPER::add_attribute($name => %{$_[0]});
    }
    else {
        # otherwise we just pass the args
        $self->SUPER::add_attribute($name => @_);
    }
}

sub add_override_method_modifier {
    my ($self, $name, $method, $_super_package) = @_;
    (!$self->has_method($name))
        || confess "Cannot add an override method if a local method is already present";
    # need this for roles ...
    $_super_package ||= $self->name;
    my $super = $self->find_next_method_by_name($name);
    (defined $super)
        || confess "You cannot override '$name' because it has no super method";    
    $self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
        my @args = @_;
        no strict   'refs';
        no warnings 'redefine';
        local *{$_super_package . '::super'} = sub { $super->(@args) };
        return $method->(@args);
    }));
}

sub add_augment_method_modifier {
    my ($self, $name, $method) = @_;  
    (!$self->has_method($name))
        || confess "Cannot add an augment method if a local method is already present";    
    my $super = $self->find_next_method_by_name($name);
    (defined $super)
        || confess "You cannot augment '$name' because it has no super method";    
    my $_super_package = $super->package_name;   
    # BUT!,... if this is an overriden method ....     
    if ($super->isa('Moose::Meta::Method::Overriden')) {
        # we need to be sure that we actually 
        # find the next method, which is not 
        # an 'override' method, the reason is
        # that an 'override' method will not 
        # be the one calling inner()
        my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);        
        $_super_package = $real_super->package_name;
    }      
    $self->add_method($name => sub {
        my @args = @_;
        no strict   'refs';
        no warnings 'redefine';
        local *{$_super_package . '::inner'} = sub { $method->(@args) };
        return $super->(@args);
    });    
}

## Private Utility methods ...

sub _find_next_method_by_name_which_is_not_overridden {
    my ($self, $name) = @_;
    foreach my $method ($self->find_all_methods_by_name($name)) {
        return $method->{code} 
            if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
    }
    return undef;
}

sub _fix_metaclass_incompatability {
    my ($self, @superclasses) = @_;
    foreach my $super (@superclasses) {
        # don't bother if it does not have a meta.
        next unless $super->can('meta');
        # if it's meta is a vanilla Moose, 
        # then we can safely ignore it.
        next if blessed($super->meta) eq 'Moose::Meta::Class';
        # but if we have anything else, 
        # we need to check it out ...
        unless (# see if of our metaclass is incompatible
                ($self->isa(blessed($super->meta)) &&
                 # and see if our instance metaclass is incompatible
                 $self->instance_metaclass->isa($super->meta->instance_metaclass)) &&
                # ... and if we are just a vanilla Moose
                $self->isa('Moose::Meta::Class')) {
            # re-initialize the meta ...
            my $super_meta = $super->meta;
            # NOTE:
            # We might want to consider actually 
            # transfering any attributes from the 
            # original meta into this one, but in 
            # general you should not have any there
            # at this point anyway, so it's very 
            # much an obscure edge case anyway
            $self = $super_meta->reinitialize($self->name => (
                ':attribute_metaclass' => $super_meta->attribute_metaclass,                            
                ':method_metaclass'    => $super_meta->method_metaclass,
                ':instance_metaclass'  => $super_meta->instance_metaclass,
            ));
        }
    }
    return $self;    
}

sub _apply_all_roles {
    my ($self, @roles) = @_;
    ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
        || confess "You can only consume roles, $_ is not a Moose role"
            foreach @roles;
    if (scalar @roles == 1) {
        $roles[0]->meta->apply($self);
    }
    else {
        # FIXME
        # we should make a Moose::Meta::Role::Composite
        # which is a smaller version of Moose::Meta::Role
        # which does not use any package stuff
        Moose::Meta::Role->combine(
            map { $_->meta } @roles
        )->apply($self);
    }    
}

sub _process_attribute {
    my ($self, $name, %options) = @_;
    if ($name =~ /^\+(.*)/) {
        my $new_attr = $self->_process_inherited_attribute($1, %options);
        $self->add_attribute($new_attr);
    }
    else {
        if ($options{metaclass}) {
            Moose::_load_all_classes($options{metaclass});
            $self->add_attribute($options{metaclass}->new($name, %options));
        }
        else {
            $self->add_attribute($name, %options);
        }
    }    
}

sub _process_inherited_attribute {
    my ($self, $attr_name, %options) = @_;
    my $inherited_attr = $self->find_attribute_by_name($attr_name);
    (defined $inherited_attr)
        || confess "Could not find an attribute by the name of '$attr_name' to inherit from";
    my $new_attr;
    if ($inherited_attr->isa('Moose::Meta::Attribute')) {
        $new_attr = $inherited_attr->clone_and_inherit_options(%options);
    }
    else {
        # NOTE:
        # kind of a kludge to handle Class::MOP::Attributes
        $new_attr = Moose::Meta::Attribute::clone_and_inherit_options(
            $inherited_attr, %options
        );                        
    }    
    return $new_attr;
}

package Moose::Meta::Method::Overriden;

use strict;
use warnings;

our $VERSION = '0.01';

use base 'Class::MOP::Method';

1;

__END__

=pod

=head1 NAME

Moose::Meta::Class - The Moose metaclass

=head1 DESCRIPTION

This is a subclass of L<Class::MOP::Class> with Moose specific 
extensions.

For the most part, the only time you will ever encounter an 
instance of this class is if you are doing some serious deep 
introspection. To really understand this class, you need to refer 
to the L<Class::MOP::Class> documentation.

=head1 METHODS

=over 4

=item B<initialize>

=item B<new_object>

We override this method to support the C<trigger> attribute option.

=item B<construct_instance>

This provides some Moose specific extensions to this method, you 
almost never call this method directly unless you really know what 
you are doing. 

This method makes sure to handle the moose weak-ref, type-constraint
and type coercion features. 

=item B<get_method_map>

This accommodates Moose::Meta::Role::Method instances, which are 
aliased, instead of added, but still need to be counted as valid 
methods.

=item B<add_override_method_modifier ($name, $method)>

This will create an C<override> method modifier for you, and install 
it in the package.

=item B<add_augment_method_modifier ($name, $method)>

This will create an C<augment> method modifier for you, and install 
it in the package.

=item B<calculate_all_roles>

=item B<roles>

This will return an array of C<Moose::Meta::Role> instances which are 
attached to this class.

=item B<add_role ($role)>

This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it 
to the list of associated roles.

=item B<does_role ($role_name)>

This will test if this class C<does> a given C<$role_name>. It will 
not only check it's local roles, but ask them as well in order to 
cascade down the role hierarchy.

=item B<excludes_role ($role_name)>

This will test if this class C<excludes> a given C<$role_name>. It will 
not only check it's local roles, but ask them as well in order to 
cascade down the role hierarchy.

=item B<add_attribute ($attr_name, %params|$params)>

This method does the same thing as L<Class::MOP::Class::add_attribute>, but adds
support for taking the C<$params> as a HASH ref.

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no 
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut
Commit	Line	Data
c0e30cf5	1
	2	package Moose::Meta::Class;
	3
	4	use strict;
	5	use warnings;
	6
648e79ae	7	use Class::MOP;
648e79ae	8
6ba6d68c	9	use Carp 'confess';
54b1cdf0	10	use Scalar::Util 'weaken', 'blessed', 'reftype';
a15dff8d	11
1341f10c	12	our $VERSION = '0.07';
bc1e29b5	13
c0e30cf5	14	use base 'Class::MOP::Class';
c0e30cf5	15
598340d5	16	__PACKAGE__->meta->add_attribute('roles' => (
ef333f17	17	reader => 'roles',
	18	default => sub { [] }
	19	));
	20
590868a3	21	sub initialize {
	22	my $class = shift;
	23	my $pkg = shift;
	24	$class->SUPER::initialize($pkg,
	25	':attribute_metaclass' => 'Moose::Meta::Attribute',
ddd0ec20	26	':instance_metaclass' => 'Moose::Meta::Instance',
590868a3	27	@_);
1341f10c	28	}
590868a3	29
ef333f17	30	sub add_role {
	31	my ($self, $role) = @_;
	32	(blessed($role) && $role->isa('Moose::Meta::Role'))
	33	\|\| confess "Roles must be instances of Moose::Meta::Role";
	34	push @{$self->roles} => $role;
	35	}
	36
b8aeb4dc	37	sub calculate_all_roles {
	38	my $self = shift;
	39	my %seen;
	40	grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
	41	}
	42
ef333f17	43	sub does_role {
	44	my ($self, $role_name) = @_;
	45	(defined $role_name)
	46	\|\| confess "You must supply a role name to look for";
9c429218	47	foreach my $class ($self->class_precedence_list) {
74f6d830	48	next unless $class->can('meta');
9c429218	49	foreach my $role (@{$class->meta->roles}) {
	50	return 1 if $role->does_role($role_name);
	51	}
ef333f17	52	}
	53	return 0;
	54	}
	55
d79e62fd	56	sub excludes_role {
	57	my ($self, $role_name) = @_;
	58	(defined $role_name)
	59	\|\| confess "You must supply a role name to look for";
74f6d830	60	foreach my $class ($self->class_precedence_list) {
74f6d830	61	next unless $class->can('meta');
9c429218	62	foreach my $role (@{$class->meta->roles}) {
	63	return 1 if $role->excludes_role($role_name);
	64	}
d79e62fd	65	}
	66	return 0;
	67	}
	68
8c9d74e7	69	sub new_object {
	70	my ($class, %params) = @_;
	71	my $self = $class->SUPER::new_object(%params);
	72	foreach my $attr ($class->compute_all_applicable_attributes()) {
715ea0b7	73	# FIXME:
	74	# this does not accept undefined
	75	# values, nor does it accept false
	76	# values to be passed into the init-arg
5faf11bb	77	next unless $params{$attr->init_arg} && $attr->can('has_trigger') && $attr->has_trigger;
5faf11bb	78	$attr->trigger->($self, $params{$attr->init_arg}, $attr);
8c9d74e7	79	}
	80	return $self;
	81	}
	82
a15dff8d	83	sub construct_instance {
a15dff8d	84	my ($class, %params) = @_;
ddd0ec20	85	my $meta_instance = $class->get_meta_instance;
575db57d	86	# FIXME:
	87	# the code below is almost certainly incorrect
	88	# but this is foreign inheritence, so we might
	89	# have to kludge it in the end.
ddd0ec20	90	my $instance = $params{'__INSTANCE__'} \|\| $meta_instance->create_instance();
74f6d830	91	foreach my $attr ($class->compute_all_applicable_attributes()) {
ddd0ec20	92	$attr->initialize_instance_slot($meta_instance, $instance, \%params)
a15dff8d	93	}
	94	return $instance;
	95	}
	96
a7d0cd00	97
093b12c2	98	# FIXME:
	99	# This is ugly
	100	sub get_method_map {
	101	my $self = shift;
	102	my $map = $self->{'%:methods'};
a7d0cd00	103
093b12c2	104	my $class_name = $self->name;
	105	my $method_metaclass = $self->method_metaclass;
	106
	107	foreach my $symbol ($self->list_all_package_symbols('CODE')) {
	108
	109	my $code = $self->get_package_symbol('&' . $symbol);
	110
	111	next if exists $map->{$symbol} &&
	112	defined $map->{$symbol} &&
	113	$map->{$symbol}->body == $code;
	114
	115	my $gv = B::svref_2object($code)->GV;
	116
	117	my $pkg = $gv->STASH->NAME;
	118	if ($pkg->can('meta') && $pkg->meta->isa('Moose::Meta::Role')) {
	119	#my $role = $pkg->meta->name;
	120	#next unless $self->does_role($role);
	121	}
	122	else {
	123	next if ($gv->STASH->NAME \|\| '') ne $class_name &&
	124	($gv->NAME \|\| '') ne '__ANON__';
	125	}
	126
	127	$map->{$symbol} = $method_metaclass->wrap($code);
	128	}
	129
	130	return $map;
a7d0cd00	131	}
a7d0cd00	132
093b12c2	133	#sub find_method_by_name {
	134	# my ($self, $method_name) = @_;
	135	# (defined $method_name && $method_name)
	136	# \|\| confess "You must define a method name to find";
	137	# # keep a record of what we have seen
	138	# # here, this will handle all the
	139	# # inheritence issues because we are
	140	# # using the &class_precedence_list
	141	# my %seen_class;
	142	# foreach my $class ($self->class_precedence_list()) {
	143	# next if $seen_class{$class};
	144	# $seen_class{$class}++;
	145	# # fetch the meta-class ...
	146	# my $meta = $self->initialize($class);
	147	# return $meta->get_method($method_name)
	148	# if $meta->has_method($method_name);
	149	# }
	150	#}
	151
	152	### ---------------------------------------------
	153
a2eec5e7	154	sub add_attribute {
	155	my $self = shift;
	156	my $name = shift;
	157	if (scalar @_ == 1 && ref($_[0]) eq 'HASH') {
	158	# NOTE:
	159	# if it is a HASH ref, we de-ref it.
	160	# this will usually mean that it is
	161	# coming from a role
	162	$self->SUPER::add_attribute($name => %{$_[0]});
	163	}
	164	else {
	165	# otherwise we just pass the args
	166	$self->SUPER::add_attribute($name => @_);
	167	}
	168	}
	169
78cd1d3b	170	sub add_override_method_modifier {
78cd1d3b	171	my ($self, $name, $method, $_super_package) = @_;
d05cd563	172	(!$self->has_method($name))
d05cd563	173	\|\| confess "Cannot add an override method if a local method is already present";
78cd1d3b	174	# need this for roles ...
	175	$_super_package \|\|= $self->name;
	176	my $super = $self->find_next_method_by_name($name);
	177	(defined $super)
	178	\|\| confess "You cannot override '$name' because it has no super method";
093b12c2	179	$self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
78cd1d3b	180	my @args = @_;
	181	no strict 'refs';
	182	no warnings 'redefine';
	183	local *{$_super_package . '::super'} = sub { $super->(@args) };
	184	return $method->(@args);
093b12c2	185	}));
78cd1d3b	186	}
	187
	188	sub add_augment_method_modifier {
05d9eaf6	189	my ($self, $name, $method) = @_;
d05cd563	190	(!$self->has_method($name))
d05cd563	191	\|\| confess "Cannot add an augment method if a local method is already present";
78cd1d3b	192	my $super = $self->find_next_method_by_name($name);
78cd1d3b	193	(defined $super)
05d9eaf6	194	\|\| confess "You cannot augment '$name' because it has no super method";
	195	my $_super_package = $super->package_name;
	196	# BUT!,... if this is an overriden method ....
	197	if ($super->isa('Moose::Meta::Method::Overriden')) {
	198	# we need to be sure that we actually
	199	# find the next method, which is not
	200	# an 'override' method, the reason is
	201	# that an 'override' method will not
	202	# be the one calling inner()
	203	my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
	204	$_super_package = $real_super->package_name;
	205	}
78cd1d3b	206	$self->add_method($name => sub {
	207	my @args = @_;
	208	no strict 'refs';
	209	no warnings 'redefine';
05d9eaf6	210	local *{$_super_package . '::inner'} = sub { $method->(@args) };
78cd1d3b	211	return $super->(@args);
	212	});
	213	}
	214
1341f10c	215	## Private Utility methods ...
1341f10c	216
05d9eaf6	217	sub _find_next_method_by_name_which_is_not_overridden {
05d9eaf6	218	my ($self, $name) = @_;
68efb014	219	foreach my $method ($self->find_all_methods_by_name($name)) {
05d9eaf6	220	return $method->{code}
	221	if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
	222	}
	223	return undef;
	224	}
	225
1341f10c	226	sub _fix_metaclass_incompatability {
	227	my ($self, @superclasses) = @_;
	228	foreach my $super (@superclasses) {
	229	# don't bother if it does not have a meta.
	230	next unless $super->can('meta');
	231	# if it's meta is a vanilla Moose,
	232	# then we can safely ignore it.
	233	next if blessed($super->meta) eq 'Moose::Meta::Class';
	234	# but if we have anything else,
	235	# we need to check it out ...
	236	unless (# see if of our metaclass is incompatible
	237	($self->isa(blessed($super->meta)) &&
	238	# and see if our instance metaclass is incompatible
	239	$self->instance_metaclass->isa($super->meta->instance_metaclass)) &&
	240	# ... and if we are just a vanilla Moose
	241	$self->isa('Moose::Meta::Class')) {
	242	# re-initialize the meta ...
	243	my $super_meta = $super->meta;
	244	# NOTE:
	245	# We might want to consider actually
	246	# transfering any attributes from the
	247	# original meta into this one, but in
	248	# general you should not have any there
	249	# at this point anyway, so it's very
	250	# much an obscure edge case anyway
	251	$self = $super_meta->reinitialize($self->name => (
	252	':attribute_metaclass' => $super_meta->attribute_metaclass,
	253	':method_metaclass' => $super_meta->method_metaclass,
	254	':instance_metaclass' => $super_meta->instance_metaclass,
	255	));
	256	}
	257	}
	258	return $self;
	259	}
	260
	261	sub _apply_all_roles {
	262	my ($self, @roles) = @_;
	263	($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
	264	\|\| confess "You can only consume roles, $_ is not a Moose role"
	265	foreach @roles;
	266	if (scalar @roles == 1) {
	267	$roles[0]->meta->apply($self);
	268	}
	269	else {
68efb014	270	# FIXME
	271	# we should make a Moose::Meta::Role::Composite
	272	# which is a smaller version of Moose::Meta::Role
	273	# which does not use any package stuff
1341f10c	274	Moose::Meta::Role->combine(
	275	map { $_->meta } @roles
	276	)->apply($self);
	277	}
	278	}
	279
	280	sub _process_attribute {
	281	my ($self, $name, %options) = @_;
	282	if ($name =~ /^\+(.*)/) {
	283	my $new_attr = $self->_process_inherited_attribute($1, %options);
	284	$self->add_attribute($new_attr);
	285	}
	286	else {
	287	if ($options{metaclass}) {
	288	Moose::_load_all_classes($options{metaclass});
	289	$self->add_attribute($options{metaclass}->new($name, %options));
	290	}
	291	else {
	292	$self->add_attribute($name, %options);
	293	}
	294	}
	295	}
	296
	297	sub _process_inherited_attribute {
	298	my ($self, $attr_name, %options) = @_;
	299	my $inherited_attr = $self->find_attribute_by_name($attr_name);
	300	(defined $inherited_attr)
	301	\|\| confess "Could not find an attribute by the name of '$attr_name' to inherit from";
	302	my $new_attr;
	303	if ($inherited_attr->isa('Moose::Meta::Attribute')) {
	304	$new_attr = $inherited_attr->clone_and_inherit_options(%options);
	305	}
	306	else {
	307	# NOTE:
	308	# kind of a kludge to handle Class::MOP::Attributes
	309	$new_attr = Moose::Meta::Attribute::clone_and_inherit_options(
	310	$inherited_attr, %options
	311	);
	312	}
	313	return $new_attr;
	314	}
	315
05d9eaf6	316	package Moose::Meta::Method::Overriden;
	317
	318	use strict;
	319	use warnings;
	320
	321	our $VERSION = '0.01';
	322
	323	use base 'Class::MOP::Method';
	324
c0e30cf5	325	1;
	326
	327	__END__
	328
	329	=pod
	330
	331	=head1 NAME
	332
e522431d	333	Moose::Meta::Class - The Moose metaclass
c0e30cf5	334
c0e30cf5	335	=head1 DESCRIPTION
c0e30cf5	336
e522431d	337	This is a subclass of L<Class::MOP::Class> with Moose specific
	338	extensions.
	339
6ba6d68c	340	For the most part, the only time you will ever encounter an
	341	instance of this class is if you are doing some serious deep
	342	introspection. To really understand this class, you need to refer
	343	to the L<Class::MOP::Class> documentation.
	344
c0e30cf5	345	=head1 METHODS
	346
	347	=over 4
	348
590868a3	349	=item B<initialize>
590868a3	350
8c9d74e7	351	=item B<new_object>
8c9d74e7	352
02a0fb52	353	We override this method to support the C<trigger> attribute option.
02a0fb52	354
a15dff8d	355	=item B<construct_instance>
a15dff8d	356
6ba6d68c	357	This provides some Moose specific extensions to this method, you
	358	almost never call this method directly unless you really know what
	359	you are doing.
	360
	361	This method makes sure to handle the moose weak-ref, type-constraint
	362	and type coercion features.
ef1d5f4b	363
093b12c2	364	=item B<get_method_map>
e9ec68d6	365
68efb014	366	This accommodates Moose::Meta::Role::Method instances, which are
e9ec68d6	367	aliased, instead of added, but still need to be counted as valid
	368	methods.
	369
78cd1d3b	370	=item B<add_override_method_modifier ($name, $method)>
78cd1d3b	371
02a0fb52	372	This will create an C<override> method modifier for you, and install
	373	it in the package.
	374
78cd1d3b	375	=item B<add_augment_method_modifier ($name, $method)>
78cd1d3b	376
02a0fb52	377	This will create an C<augment> method modifier for you, and install
	378	it in the package.
	379
2b14ac61	380	=item B<calculate_all_roles>
2b14ac61	381
ef333f17	382	=item B<roles>
ef333f17	383
02a0fb52	384	This will return an array of C<Moose::Meta::Role> instances which are
	385	attached to this class.
	386
ef333f17	387	=item B<add_role ($role)>
ef333f17	388
02a0fb52	389	This takes an instance of C<Moose::Meta::Role> in C<$role>, and adds it
	390	to the list of associated roles.
	391
ef333f17	392	=item B<does_role ($role_name)>
ef333f17	393
02a0fb52	394	This will test if this class C<does> a given C<$role_name>. It will
	395	not only check it's local roles, but ask them as well in order to
	396	cascade down the role hierarchy.
	397
d79e62fd	398	=item B<excludes_role ($role_name)>
	399
	400	This will test if this class C<excludes> a given C<$role_name>. It will
	401	not only check it's local roles, but ask them as well in order to
	402	cascade down the role hierarchy.
	403
9e93dd19	404	=item B<add_attribute ($attr_name, %params\|$params)>
4e848edb	405
9e93dd19	406	This method does the same thing as L<Class::MOP::Class::add_attribute>, but adds
9e93dd19	407	support for taking the C<$params> as a HASH ref.
ac1ef2f9	408
c0e30cf5	409	=back
	410
	411	=head1 BUGS
	412
	413	All complex software has bugs lurking in it, and this module is no
	414	exception. If you find a bug please either email me, or add the bug
	415	to cpan-RT.
	416
c0e30cf5	417	=head1 AUTHOR
	418
	419	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	420
	421	=head1 COPYRIGHT AND LICENSE
	422
	423	Copyright 2006 by Infinity Interactive, Inc.
	424
	425	L<http://www.iinteractive.com>
	426
	427	This library is free software; you can redistribute it and/or modify
	428	it under the same terms as Perl itself.
	429
8a7a9c53	430	=cut
1a563243	431