use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.90';
+our $VERSION = '0.93';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
|| $class->_construct_class_instance(package => $package_name, @_);
}
-sub construct_class_instance {
- Carp::cluck('The construct_class_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_construct_class_instance(@_);
-}
-
# NOTE: (meta-circularity)
# this is a special form of _construct_instance
# (see below), which is used to construct class
# get the name of the class appropriately
$class = (ref($class)
? ($class->is_immutable
- ? $class->get_mutable_metaclass_name()
+ ? $class->_get_mutable_metaclass_name()
: ref($class))
: $class);
# should not actually have a value associated
# with the slot.
'namespace' => \undef,
+ 'methods' => {},
# inherited from Class::MOP::Module
'version' => \undef,
# defined in Class::MOP::Class
'superclasses' => \undef,
- 'methods' => {},
'attributes' => {},
'attribute_metaclass' =>
( $options->{'attribute_metaclass'} || 'Class::MOP::Attribute' ),
$self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
}
-
-sub check_metaclass_compatibility {
- Carp::cluck('The check_metaclass_compatibility method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_check_metaclass_compatibility(@_);
-}
-
sub _check_metaclass_compatibility {
my $self = shift;
# get the name of the class appropriately
my $super_meta_type
= $super_meta->is_immutable
- ? $super_meta->get_mutable_metaclass_name()
+ ? $super_meta->_get_mutable_metaclass_name()
: ref($super_meta);
($self->isa($super_meta_type))
return $class->_construct_instance(@_);
}
-sub construct_instance {
- Carp::cluck('The construct_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_construct_instance(@_);
-}
-
sub _construct_instance {
my $class = shift;
my $params = @_ == 1 ? $_[0] : {@_};
$self->{'_meta_instance'} ||= $self->_create_meta_instance();
}
-sub create_meta_instance {
- Carp::cluck('The create_meta_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_create_meta_instance(@_);
-}
-
sub _create_meta_instance {
my $self = shift;
$class->_clone_instance($instance, @_);
}
-sub clone_instance {
- Carp::cluck('The clone_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_clone_instance(@_);
-}
-
sub _clone_instance {
my ($class, $instance, %params) = @_;
(blessed($instance))
# to, and so don't need the fully qualified name.
}
-sub alias_method {
- Carp::cluck("The alias_method method is deprecated. Use add_method instead.\n");
-
- shift->add_method(@_);
-}
-
sub find_method_by_name {
my ($self, $method_name) = @_;
(defined $method_name && $method_name)
sub get_all_methods {
my $self = shift;
- my %methods = map { %{ $self->initialize($_)->get_method_map } } reverse $self->linearized_isa;
- return values %methods;
-}
-sub compute_all_applicable_methods {
- Carp::cluck('The compute_all_applicable_methods method is deprecated.'
- . " Use get_all_methods instead.\n");
-
- return map {
- {
- name => $_->name,
- class => $_->package_name,
- code => $_, # sigh, overloading
- },
- } shift->get_all_methods(@_);
+ my %methods;
+ for my $class ( reverse $self->linearized_isa ) {
+ my $meta = $self->initialize($class);
+
+ $methods{$_} = $meta->get_method($_)
+ for $meta->get_method_list;
+ }
+
+ return values %methods;
}
sub get_all_method_names {
sub has_attribute {
my ($self, $attribute_name) = @_;
- (defined $attribute_name && $attribute_name)
+ (defined $attribute_name)
|| confess "You must define an attribute name";
exists $self->get_attribute_map->{$attribute_name};
}
sub get_attribute {
my ($self, $attribute_name) = @_;
- (defined $attribute_name && $attribute_name)
+ (defined $attribute_name)
|| confess "You must define an attribute name";
return $self->get_attribute_map->{$attribute_name}
# NOTE:
sub remove_attribute {
my ($self, $attribute_name) = @_;
- (defined $attribute_name && $attribute_name)
+ (defined $attribute_name)
|| confess "You must define an attribute name";
my $removed_attribute = $self->get_attribute_map->{$attribute_name};
return unless defined $removed_attribute;
return values %attrs;
}
-sub compute_all_applicable_attributes {
- Carp::cluck('The compute_all_applicable_attributes method has been deprecated.'
- . " Use get_all_attributes instead.\n");
-
- shift->get_all_attributes(@_);
-}
-
sub find_attribute_by_name {
my ($self, $attr_name) = @_;
foreach my $class ($self->linearized_isa) {
return if $self->get_attribute_list;
# or any non-declared methods
- if ( my @methods = values %{ $self->get_method_map } ) {
- my $metaclass = $self->method_metaclass;
- foreach my $method ( @methods ) {
- return if $method->isa("Class::MOP::Method::Generated");
- # FIXME do we need to enforce this too? return unless $method->isa($metaclass);
- }
+ for my $method ( map { $self->get_method($_) } $self->get_method_list ) {
+ return if $method->isa("Class::MOP::Method::Generated");
+ # FIXME do we need to enforce this too? return unless $method->isa( $self->method_metaclass );
}
return 1;
sub is_mutable { 1 }
sub is_immutable { 0 }
+sub immutable_options { %{ $_[0]{__immutable}{options} || {} } }
+
sub _immutable_options {
my ( $self, @args ) = @_;
# example of where this matters).
my $meta_name
= $meta->is_immutable
- ? $meta->get_mutable_metaclass_name
+ ? $meta->_get_mutable_metaclass_name
: ref $meta;
my $immutable_meta = $meta_name->create(
sub _rebless_as_mutable {
my $self = shift;
- bless $self, $self->get_mutable_metaclass_name;
+ bless $self, $self->_get_mutable_metaclass_name;
return $self;
}
=item B<< $metaclass->attribute_metaclass >>
Returns the class name of the attribute metaclass for this class. By
-default, this is L<Class::MOP::Attribute>. for more information on
+default, this is L<Class::MOP::Attribute>.
=back
methods, and also allows us to optimize some methods on the metaclass
object itself.
-After immutabilization, the metaclass object will cache most
-informational methods such as C<get_method_map> and
-C<get_all_attributes>. Methods which would alter the class, such as
-C<add_attribute>, C<add_method>, and so on will throw an error on an
-immutable metaclass object.
+After immutabilization, the metaclass object will cache most informational
+methods that returns information about methods or attributes.. Methods which
+would alter the class, such as C<add_attribute>, C<add_method>, and so on will
+throw an error on an immutable metaclass object.
The immutabilization system in L<Moose> takes much greater advantage
of the inlining features than Class::MOP itself does.
=back
+=item B<< $metaclass->immutable_options >>
+
+Returns a hash of the options used when making the class immutable, including
+both defaults and anything supplied by the user in the call to C<<
+$metaclass->make_immutable >>. This is useful if you need to temporarily make
+a class mutable and then restore immutability as it was before.
+
=item B<< $metaclass->make_mutable >>
Calling this method reverse the immutabilization transformation.
projects / gitmo/Class-MOP.git / blobdiff