use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78';
+our $VERSION = '0.79';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# now create the metaclass
my $meta;
if ($class eq 'Class::MOP::Class') {
- no strict 'refs';
- $meta = $class->_new($options)
+ $meta = $class->_new($options);
}
else {
# NOTE:
: ref($super_meta);
($self->isa($super_meta_type))
- || confess $self->name . "->meta => (" . (ref($self)) . ")" .
- " is not compatible with the " .
- $superclass_name . "->meta => (" . ($super_meta_type) . ")";
+ || confess "Class::MOP::class_of(" . $self->name . ") => ("
+ . (ref($self)) . ")" . " is not compatible with the " .
+ "Class::MOP::class_of(".$superclass_name . ") => ("
+ . ($super_meta_type) . ")";
# NOTE:
# we also need to check that instance metaclasses
# are compatibile in the same the class.
($self->instance_metaclass->isa($super_meta->instance_metaclass))
- || confess $self->name . "->meta->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
+ || confess "Class::MOP::class_of(" . $self->name . ")->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
" is not compatible with the " .
- $superclass_name . "->meta->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
+ "Class::MOP::class_of(" . $superclass_name . ")->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
}
}
sub rebless_instance {
my ($self, $instance, %params) = @_;
- my $old_metaclass;
- if ($instance->can('meta')) {
- ($instance->meta->isa('Class::MOP::Class'))
- || confess 'Cannot rebless instance if ->meta is not an instance of Class::MOP::Class';
- $old_metaclass = $instance->meta;
- }
- else {
- $old_metaclass = $self->initialize(ref($instance));
- }
+ my $old_metaclass = Class::MOP::class_of($instance);
- my $meta_instance = $self->get_meta_instance();
+ my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance);
+ $self->name->isa($old_class)
+ || confess "You may rebless only into a subclass of ($old_class), of which (". $self->name .") isn't.";
- $self->name->isa($old_metaclass->name)
- || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't.";
+ $old_metaclass->rebless_instance_away($instance, $self, %params)
+ if $old_metaclass;
+
+ my $meta_instance = $self->get_meta_instance();
# rebless!
# we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
$instance;
}
+sub rebless_instance_away {
+ # this intentionally does nothing, it is just a hook
+}
+
# Inheritance
sub superclasses {
sub is_mutable { 1 }
sub is_immutable { 0 }
-# NOTE:
-# Why I changed this (groditi)
-# - One Metaclass may have many Classes through many Metaclass instances
-# - One Metaclass should only have one Immutable Transformer instance
-# - Each Class may have different Immutabilizing options
-# - Therefore each Metaclass instance may have different Immutabilizing options
-# - We need to store one Immutable Transformer instance per Metaclass
-# - We need to store one set of Immutable Transformer options per Class
-# - Upon make_mutable we may delete the Immutabilizing options
-# - We could clean the immutable Transformer instance when there is no more
-# immutable Classes of that type, but we can also keep it in case
-# another class with this same Metaclass becomes immutable. It is a case
-# of trading of storing an instance to avoid unnecessary instantiations of
-# Immutable Transformers. You may view this as a memory leak, however
-# Because we have few Metaclasses, in practice it seems acceptable
-# - To allow Immutable Transformers instances to be cleaned up we could weaken
-# the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
+sub immutable_transformer { $_[0]->{immutable_transformer} }
+sub _set_immutable_transformer { $_[0]->{immutable_transformer} = $_[1] }
-{
-
- my %IMMUTABLE_TRANSFORMERS;
- my %IMMUTABLE_OPTIONS;
-
- sub get_immutable_options {
- my $self = shift;
- return if $self->is_mutable;
- confess "unable to find immutabilizing options"
- unless exists $IMMUTABLE_OPTIONS{$self->name};
- my %options = %{$IMMUTABLE_OPTIONS{$self->name}};
- delete $options{IMMUTABLE_TRANSFORMER};
- return \%options;
- }
-
- sub get_immutable_transformer {
- my $self = shift;
- if( $self->is_mutable ){
- return $IMMUTABLE_TRANSFORMERS{$self->name} ||= $self->create_immutable_transformer;
- }
- confess "unable to find transformer for immutable class"
- unless exists $IMMUTABLE_OPTIONS{$self->name};
- return $IMMUTABLE_OPTIONS{$self->name}->{IMMUTABLE_TRANSFORMER};
- }
-
- sub make_immutable {
- my $self = shift;
- my %options = @_;
+sub make_immutable {
+ my $self = shift;
- my $transformer = $self->get_immutable_transformer;
- $transformer->make_metaclass_immutable($self, \%options);
- $IMMUTABLE_OPTIONS{$self->name} =
- { %options, IMMUTABLE_TRANSFORMER => $transformer };
+ return if $self->is_immutable;
- if( exists $options{debug} && $options{debug} ){
- print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
- print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
- }
+ my $transformer = $self->immutable_transformer
+ || $self->_make_immutable_transformer(@_);
- 1;
- }
+ $self->_set_immutable_transformer($transformer);
- sub make_mutable{
- my $self = shift;
- return if $self->is_mutable;
- my $options = delete $IMMUTABLE_OPTIONS{$self->name};
- confess "unable to find immutabilizing options" unless ref $options;
- my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
- $transformer->make_metaclass_mutable($self, $options);
- 1;
- }
+ $transformer->make_metaclass_immutable;
}
-sub create_immutable_transformer {
- my $self = shift;
- my $class = Class::MOP::Immutable->new($self, {
+{
+ my %Default_Immutable_Options = (
read_only => [qw/superclasses/],
- cannot_call => [qw/
- add_method
- alias_method
- remove_method
- add_attribute
- remove_attribute
- remove_package_symbol
- /],
- memoize => {
- class_precedence_list => 'ARRAY',
- linearized_isa => 'ARRAY', # FIXME perl 5.10 memoizes this on its own, no need?
- get_all_methods => 'ARRAY',
- get_all_method_names => 'ARRAY',
- #get_all_attributes => 'ARRAY', # it's an alias, no need, but maybe in the future
- compute_all_applicable_attributes => 'ARRAY',
- get_meta_instance => 'SCALAR',
- get_method_map => 'SCALAR',
+ cannot_call => [
+ qw(
+ add_method
+ alias_method
+ remove_method
+ add_attribute
+ remove_attribute
+ remove_package_symbol
+ )
+ ],
+ memoize => {
+ class_precedence_list => 'ARRAY',
+ # FIXME perl 5.10 memoizes this on its own, no need?
+ linearized_isa => 'ARRAY',
+ get_all_methods => 'ARRAY',
+ get_all_method_names => 'ARRAY',
+ compute_all_applicable_attributes => 'ARRAY',
+ get_meta_instance => 'SCALAR',
+ get_method_map => 'SCALAR',
},
+
# NOTE:
- # this is ugly, but so are typeglobs,
+ # this is ugly, but so are typeglobs,
# so whattayahgonnadoboutit
# - SL
- wrapped => {
+ wrapped => {
add_package_symbol => sub {
my $original = shift;
- confess "Cannot add package symbols to an immutable metaclass"
- unless (caller(2))[3] eq 'Class::MOP::Package::get_package_symbol';
+ confess "Cannot add package symbols to an immutable metaclass"
+ unless ( caller(2) )[3] eq
+ 'Class::MOP::Package::get_package_symbol';
# This is a workaround for a bug in 5.8.1 which thinks that
# goto $original->body
goto $body;
},
},
- });
- return $class;
+ );
+
+ sub _default_immutable_transformer_options {
+ return %Default_Immutable_Options;
+ }
+}
+
+sub _make_immutable_transformer {
+ my $self = shift;
+
+ Class::MOP::Immutable->new(
+ $self,
+ $self->_default_immutable_transformer_options,
+ @_
+ );
+}
+
+sub make_mutable {
+ my $self = shift;
+
+ return if $self->is_mutable;
+
+ $self->immutable_transformer->make_metaclass_mutable;
}
1;
=head1 DESCRIPTION
-This is the largest and most complex part of the Class::MOP
-meta-object protocol. It controls the introspection and manipulation
-of Perl 5 classes, and it can create them as wlel. The best way to
-understand what this module can do, is to read the documentation for
-each of its methods.
+The Class Protocol is the largest and most complex part of the
+Class::MOP meta-object protocol. It controls the introspection and
+manipulation of Perl 5 classes, and it can create them as well. The
+best way to understand what this module can do, is to read the
+documentation for each of its methods.
=head1 INHERITANCE
This method clones an existing object instance. Any parameters you
provide are will override existing attribute values in the object.
-This is a convience method for cloning an object instance, then
+This is a convenience method for cloning an object instance, then
blessing it into the appropriate package.
You could implement a clone method in your class, using this method:
attributes. Any existing attributes that are already set will be
overwritten.
+Before reblessing the instance, this method will call
+C<rebless_instance_away> on the instance's current metaclass. This method
+will be passed the instance, the new metaclass, and any parameters
+specified to C<rebless_instance>. By default, C<rebless_instance_away>
+does nothing; it is merely a hook.
+
=item B<< $metaclass->new_object(%params) >>
This method is used to create a new object of the metaclass's
Returns the class name of the instance metaclass, see
L<Class::MOP::Instance> for more information on the instance
-metaclasses.
+metaclass.
=item B<< $metaclass->get_meta_instance >>
Remove the named method from the class. This method returns the
L<Class::MOP::Method> object for the method.
+=item B<< $metaclass->method_metaclass >>
+
+Returns the class name of the method metaclass, see
+L<Class::MOP::Method> for more information on the method metaclass.
+
+=item B<< $metaclass->wrapped_method_metaclass >>
+
+Returns the class name of the wrapped method metaclass, see
+L<Class::MOP::Method::Wrapped> for more information on the wrapped
+method metaclass.
+
=back
=head2 Attribute introspection and creation
longer call methods which alter the class, such as adding or removing
methods or attributes.
-Making a class immutable lets us optimize the class by inlning some
+Making a class immutable lets us optimize the class by inlining some
methods, and also allows us to optimize some methods on the metaclass
object itself.
Calling this method reverse the immutabilization transformation.
-=item B<< $metaclass->get_immutable_transformer >>
+=item B<< $metaclass->immutable_transformer >>
If the class has been made immutable previously, this returns the
L<Class::MOP::Immutable> object that was created to do the
Method modifiers work by wrapping the original method and then
replacing it in the class's symbol table. The wrappers will handle
-calling all the modifiers in the appropariate orders and preserving
-the calling context for the original method.
+calling all the modifiers in the appropriate order and preserving the
+calling context for the original method.
The return values of C<before> and C<after> modifiers are
ignored. This is because their purpose is B<not> to filter the input
=back
+=head2 Introspection
+
+=over 4
+
+=item B<< Class::MOP::Class->meta >>
+
+This will return a L<Class::MOP::Class> instance for this class.
+
+It should also be noted that L<Class::MOP> will actually bootstrap
+this module by installing a number of attribute meta-objects into its
+metaclass.
+
+=back
+
=head1 AUTHORS
Stevan Little E<lt>stevan@iinteractive.comE<gt>