use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.67';
+our $VERSION = '0.76';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my (%options) = @args;
my $package_name = $options{package};
- (defined $package_name && $package_name)
- || confess "You must pass a package name";
-
(ref $options{superclasses} eq 'ARRAY')
|| confess "You must pass an ARRAY ref of superclasses"
if exists $options{superclasses};
if exists $options{attributes};
(ref $options{methods} eq 'HASH')
- || confess "You must pass an HASH ref of methods"
+ || confess "You must pass a HASH ref of methods"
if exists $options{methods};
- my $code = "package $package_name;";
- $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
- if exists $options{version};
- $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
- if exists $options{authority};
-
- eval $code;
- confess "creation of $package_name failed : $@" if $@;
+ $class->SUPER::create(%options);
my (%initialize_options) = @args;
delete @initialize_options{qw(
sub method_metaclass { $_[0]->{'method_metaclass'} }
sub instance_metaclass { $_[0]->{'instance_metaclass'} }
-# FIXME:
-# this is a prime canidate for conversion to XS
sub get_method_map {
my $self = shift;
-
- my $current = Class::MOP::check_package_cache_flag($self->name);
+
+ my $class_name = $self->name;
+
+ my $current = Class::MOP::check_package_cache_flag($class_name);
if (defined $self->{'_package_cache_flag'} && $self->{'_package_cache_flag'} == $current) {
return $self->{'methods'} ||= {};
$self->{_package_cache_flag} = $current;
- my $map = $self->{'methods'} ||= {};
+ my $map = $self->{'methods'} ||= {};
- my $class_name = $self->name;
my $method_metaclass = $self->method_metaclass;
- my %all_code = $self->get_all_package_symbols('CODE');
+ my $all_code = $self->get_all_package_symbols('CODE');
- foreach my $symbol (keys %all_code) {
- my $code = $all_code{$symbol};
+ foreach my $symbol (keys %{ $all_code }) {
+ my $code = $all_code->{$symbol};
next if exists $map->{$symbol} &&
defined $map->{$symbol} &&
$method->attach_to_class($self);
- $self->get_method_map->{$method_name} = $method;
+ # This used to call get_method_map, which meant we would build all
+ # the method objects for the class just because we added one
+ # method. This is hackier, but quicker too.
+ $self->{methods}{$method_name} = $method;
my $full_method_name = ($self->name . '::' . $method_name);
$self->add_package_symbol(
{ sigil => '&', type => 'CODE', name => $method_name },
Class::MOP::subname($full_method_name => $body)
);
-
- $self->update_package_cache_flag; # still valid, since we just added the method to the map, and if it was invalid before that then get_method_map updated it
}
{
(defined $method_name && $method_name)
|| confess "You must define a method name";
- exists $self->get_method_map->{$method_name};
+ exists $self->{methods}{$method_name} || exists $self->get_method_map->{$method_name};
}
sub get_method {
(defined $method_name && $method_name)
|| confess "You must define a method name";
- # NOTE:
- # I don't really need this here, because
- # if the method_map is missing a key it
- # will just return undef for me now
- # return unless $self->has_method($method_name);
-
- return $self->get_method_map->{$method_name};
+ return $self->{methods}{$method_name} || $self->get_method_map->{$method_name};
}
sub remove_method {
sub get_immutable_transformer {
my $self = shift;
if( $self->is_mutable ){
- my $class = ref $self || $self;
- return $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
+ return $IMMUTABLE_TRANSFORMERS{$self->name} ||= $self->create_immutable_transformer;
}
confess "unable to find transformer for immutable class"
unless exists $IMMUTABLE_OPTIONS{$self->name};
best way to understand what this module can do, is to read the
documentation for each of it's methods.
+=head1 INHERITANCE
+
+B<Class::MOP::Class> is a subclass of L<Class::MOP::Module>
+
=head1 METHODS
=head2 Self Introspection
C<bless>-ing into your package of choice. It works in conjunction
with the Attribute protocol to collect all applicable attributes.
-This will construct and instance using a HASH ref as storage
+This will construct an instance using a HASH ref as storage
(currently only HASH references are supported). This will collect all
the applicable attributes and layout out the fields in the HASH ref,
it will then initialize them using either use the corresponding key
=item B<get_method_map>
-Returns a HASH ref of name to CODE reference mapping for this class.
+Returns a HASH ref of name to L<Class::MOP::Method> instance mapping
+for this class.
=item B<method_metaclass>
Wrap a code ref (C<$attrs{body>) with C<method_metaclass>.
-=item B<add_method ($method_name, $method, %attrs)>
+=item B<add_method ($method_name, $method)>
This will take a C<$method_name> and CODE reference or meta method
objectand install it into the class's package.
=item B<find_method_by_name ($method_name)>
-This will return a CODE reference of the specified C<$method_name>,
-or return undef if that method does not exist.
+This will return a L<Class::MOP::Method> instance for the specified
+C<$method_name>, or return undef if that method does not exist.
Unlike C<get_method> this will also look in the superclasses.
=item B<remove_method ($method_name)>
This will attempt to remove a given C<$method_name> from the class.
-It will return the CODE reference that it has removed, and will
-attempt to use B<Sub::Name> to clear the methods associated name.
+It will return the L<Class::MOP::Method> instance that it has removed,
+and will attempt to use B<Sub::Name> to clear the methods associated
+name.
=item B<get_method_list>
around 2
around 1
primary
- after 1
- after 2
+ around 1
+ around 2
+ after 1
+ after 2
To see examples of using method modifiers, see the following examples
included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
projects / gitmo/Class-MOP.git / blobdiff