Revision history for Perl extension Class-MOP.
-0.06
+0.06 Thurs Feb. 9, 2006
* metaclass
- - adding new metaclass pragma to make assiging the
+ - adding new metaclass pragma to make setting up the
metaclass a little more straightforward
* Class::MOP
- added &clone_instance method which does a deep clone
of the instance structure created by &construct_instance
- added docs & tests for this
+ - added Clone as a dependency
- added &new_object and &clone_object convience methods to
return blessed new or cloned instances
- they handle Class::MOP::Class singletons correctly too
- added docs & tests for this
- cleaned up the &constuct_class_instance so that it behaves
more like &construct_instance (and managed the singletons too)
+ - added the &check_metaclass_compatibility method to make sure
+ that metaclasses are upward and downward compatible.
+ - added tests and docs for this
* examples/
- adjusting code to use the &Class::MOP::Class::meta
Build.PL
Changes
-Makefile.PL
MANIFEST
+MANIFEST.SKIP
README
-META.yml
examples/AttributesWithHistory.pod
examples/ClassEncapsulatedAttributes.pod
examples/InsideOutClass.pod
examples/InstanceCountingClass.pod
examples/LazyClass.pod
examples/Perl6Attribute.pod
+lib/metaclass.pm
lib/Class/MOP.pm
lib/Class/MOP/Attribute.pm
lib/Class/MOP/Class.pm
t/003_methods.t
t/004_advanced_methods.t
t/005_attributes.t
+t/006_new_and_clone_metaclasses.t
t/010_self_introspection.t
t/011_create_class.t
t/012_package_variables.t
t/013_add_attribute_alternate.t
+t/014_attribute_introspection.t
t/020_attribute.t
t/030_method.t
+t/040_metaclass.t
+t/041_metaclass_incompatability.t
t/100_BinaryTree_test.t
t/101_InstanceCountingClass_test.t
t/102_InsideOutClass_test.t
+++ /dev/null
----------------------------------------------------------------------
-TODO
----------------------------------------------------------------------
-
-- have the init_arg be automagically filled in if it is not present
-
-(DONE)
-
-This will simplify some code, and really is not very expensive anyway
-
-- clean up bootstrapping to include the accessors, etc for attributes
-
-(DONE)
-
-Having all this meta-info is useful actually, so why not add it, and
-let the methods get overwritten if they need to be, its a small price
-to pay for what we get from it.
-
-- clean up all ->initialize($_[0]) handling
-
-(DONE)
-
-We should always be sure that $_[0] is a package name, and not
-a blessed intstance.
-
-- make &compute_all_applicable_attributes not return a HASH
-
-(DONE)
-
-All the info in the HASH is discoverable through the meta-object.
-
-- General Purpose &clone_instance method
-
-(PARTIALLY DONE) - need to implement the deep cloning & tests
-
-It can be a method of the metaclass, like construct_instance is,
-actually it should be called clone_instance, and it should
-be thought of as a low-level cloning function, so it should not
-do any blessing or anything of the sort. That is left for the
-class to implement, as is the construct_instance.
-
-- General Purpose &new_object and &clone_object method
-
-(PARTIALLY DONE) - needs more tests
-
-I seem to be writing a new method each time, but since we dont
-have a Object class to always inherit from, this is needed.
-However, there is nothing to say that I cannot do something like:
-
- Foo->meta->new_object(%params)
-
-and ...
-
- $foo->meta->clone_object($foo, %params)
-
-Give it some more thought, but I think it is the best way to
-approach this.
-
-- Role/Trait/Scalar-style mixin mechanism
-
-This is fairly simple with the MOP, but the trick comes with
-any SUPER:: calls. This will be a very tricky problem I think.
-
-* see Class::Trait::Base, and maybe use anon-classes for this.
-* review the Scalar model for mix-ins
-* I like the Class does Role, Role isa Class from Perl 6 idea.
-
-- metaclass.pm
-
-Should handle metaclass incompatibility issue, and do it through
-class mixin composition.
-
-- Prototype-style example
-
-Make a C::MOP::Class subclass which has an AUTOLOAD method, the
-method will DWIM depending up on the value it is passed.
-
- Foo->prototype->say_hello(sub { print "Hello" });
-
-This will turn into this:
-
- Foo->prototype->add_method('say_hello' => sub { print "Hello" });
-
-I am not sure how we should handle non-method arguments, mostly
-because those would be static prototype variables, which would
-translate to class package variables.
-
-- Make a Class::MOP::Package
-
-Class::MOP::Class would be a subclass of this, but I am not sure
-this is worth the time.
-
-
-
-
-
use base 'Class::MOP::Class';
-__PACKAGE__->meta->add_attribute(
- Class::MOP::Attribute->new('$:count' => (
- reader => 'get_count',
- default => 0
- ))
-);
+InstanceCountingClass->meta->add_attribute('$:count' => (
+ reader => 'get_count',
+ default => 0
+));
sub construct_instance {
my ($class, %params) = @_;
$class->{'$:count'}++;
- return $class->SUPER::construct_instance();
+ return $class->SUPER::construct_instance(%params);
}
1;
it does nothing to affect your existing code. So you only pay for
what you actually use.
+=head2 About Metaclass compatibility
+
+This module makes sure that all metaclasses created are both upwards
+and downwards compatible. The topic of metaclass compatibility is
+highly esoteric and is something only encountered when doing deep and
+involved metaclass hacking. There are two basic kinds of metaclass
+incompatibility; upwards and downwards.
+
+Upwards metaclass compatibility means that the metaclass of a
+given class is either the same as (or a subclass of) all of the
+class's ancestors.
+
+Downward metaclass compatibility means that the metaclasses of a
+given class's anscestors are all either the same as (or a subclass
+of) that metaclass.
+
+Here is a diagram showing a set of two classes (C<A> and C<B>) and
+two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
+metaclass compatibility both upwards and downwards.
+
+ +---------+ +---------+
+ | Meta::A |<----| Meta::B | <....... (instance of )
+ +---------+ +---------+ <------- (inherits from)
+ ^ ^
+ : :
+ +---------+ +---------+
+ | A |<----| B |
+ +---------+ +---------+
+
+As I said this is a highly esoteric topic and one you will only run
+into if you do a lot of subclassing of B<Class::MOP::Class>. If you
+are interested in why this is an issue see the paper
+I<Uniform and safe metaclass composition> linked to in the
+L<SEE ALSO> section of this document.
+
=head1 PROTOCOLS
The protocol is divided into 3 main sub-protocols:
=back
+=head2 Papers
+
+=over 4
+
+=item Uniform and safe metaclass composition
+
+An excellent paper by the people who brought us the original Traits paper.
+This paper is on how Traits can be used to do safe metaclass composition,
+and offers an excellent introduction section which delves into the topic of
+metaclass compatibility.
+
+L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
+
+=item Safe Metaclass Programming
+
+This paper seems to precede the above paper, and propose a mix-in based
+approach as opposed to the Traits based approach. Both papers have similar
+information on the metaclass compatibility problem space.
+
+L<http://citeseer.ist.psu.edu/37617.html>
+
+=back
+
=head2 Prior Art
=over 4
not the same thing as modules like L<Class::Accessor> and
L<Class::MethodMaker>. That being said there are very few modules on CPAN
with similar goals to this module. The one I have found which is most
-like this module is L<Class::Meta>, although it's philosophy is very
-different from this module.
-
-To start with, it provides wrappers around common Perl data types, and even
-extends those types with more specific subtypes. This module does not
-go into that area at all.
-
-L<Class::Meta> also seems to create it's own custom meta-object protocol,
-which is both more restrictive and more featureful than the vanilla
-Perl 5 one. This module attempts to model the existing Perl 5 MOP as it is.
-
-It's introspection capabilities also seem to be heavily rooted in this
-custom MOP, so that you can only introspect classes which are already
-created with L<Class::Meta>. This module does not make such restictions.
-
-Now, all this said, L<Class::Meta> is much more featureful than B<Class::MOP>
-would ever try to be. But B<Class::MOP> has some features which L<Class::Meta>
-could not easily implement. It would be very possible to completely re-implement
-L<Class::Meta> using B<Class::MOP> and bring some of these features to
-L<Class::Meta> though.
-
-But in the end, this module's admitedly ambitious goals have no direct equal
-on CPAN since surely no one has been crazy enough to try something as silly
-as this ;) until now.
+like this module is L<Class::Meta>, although it's philosophy and the MOP it
+creates are very different from this modules.
=head1 BUGS
|| confess "You must pass a package name";
return $METAS{$package_name} if exists $METAS{$package_name};
$class = blessed($class) || $class;
+ # now create the metaclass
+ my $meta;
if ($class =~ /^Class::MOP::/) {
- $METAS{$package_name} = bless {
+ $meta = bless {
'$:package' => $package_name,
'%:attributes' => {},
- '$:attribute_metaclass' => 'Class::MOP::Attribute',
- '$:method_metaclass' => 'Class::MOP::Method',
+ '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
+ '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
} => $class;
}
else {
# it is safe to use meta here because
# class will always be a subclass of
# Class::MOP::Class, which defines meta
- $METAS{$package_name} = bless $class->meta->construct_instance(%options) => $class
+ $meta = bless $class->meta->construct_instance(%options) => $class
}
+ # and check the metaclass compatibility
+ $meta->check_metaclass_compatability();
+ $METAS{$package_name} = $meta;
+ }
+
+ sub check_metaclass_compatability {
+ my $self = shift;
+
+ # this is always okay ...
+ return if blessed($self) eq 'Class::MOP::Class';
+
+ my @class_list = $self->class_precedence_list;
+ shift @class_list; # shift off $self->name
+
+ foreach my $class_name (@class_list) {
+ next unless $METAS{$class_name};
+ my $meta = $METAS{$class_name};
+ ($self->isa(blessed($meta)))
+ || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
+ " is not compatible with the " .
+ $class_name . "->meta => (" . (blessed($meta)) . ")";
+ }
}
}
method is used internally by C<initialize> and should never be called
from outside of that method really.
+=item B<check_metaclass_compatability>
+
+This method is called as the very last thing in the
+C<construct_class_instance> method. This will check that the
+metaclass you are creating is compatible with the metaclasses of all
+your ancestors. For more inforamtion about metaclass compatibility
+see the C<About Metaclass compatibility> section in L<Class::MOP>.
+
=back
=head2 Object instance construction and cloning
});
}
-=pod
-
-NOTES
-
-Okay, the metaclass constraint issue is a bit of a PITA.
-
-Especially in the context of MI, where we end up with an
-explosion of metaclasses.
-
-SOOOO
-
-Instead of auto-composing metaclasses using inheritance
-(which is problematic at best, and totally wrong at worst,
-especially in the light of methods of Class::MOP::Class
-which are overridden by subclasses (try to figure out how
-LazyClass and InsideOutClass could be composed, it is not
-even possible)) we use a trait model.
-
-It will be similar to Class::Trait, except that there is
-no such thing as a trait, a class isa trait and a trait
-isa class, more like Scala really.
-
-This way we get several benefits:
-
-1) Classes can be composed like traits, and it Just Works.
-
-2) Metaclasses can be composed this way too :)
-
-3) When solving the metaclass constraint, we create an
- anon-metaclass, and compose the parent's metaclasses
- into it. This allows for conflict checking trait-style
- which should inform us of any issues right away.
-
-Misc. Details:
-
-Class metaclasses must be composed, but so must any
-associated Attribute and Method metaclasses. However, this
-is not always relevant since I should be able to create a
-class which has lazy attributes, and then create a subclass
-of that class whose attributes are not lazy.
-
-
-=cut
-
1;
__END__
=head1 SYNOPSIS
+ package MyClass;
+
+ # use Class::MOP::Class
+ use metaclass;
+
+ # ... or use a custom metaclass
use metaclass 'MyMetaClass';
+ # ... or use a custom metaclass
+ # and custom attribute and method
+ # metaclasses
use metaclass 'MyMetaClass' => (
':attribute_metaclass' => 'MyAttributeMetaClass',
':method_metaclass' => 'MyMethodMetaClass',
=head1 DESCRIPTION
This is a pragma to make it easier to use a specific metaclass
-and it's
+and a set of custom attribute and method metaclasses. It also
+installs a C<meta> method to your class as well.
=head1 AUTHOR
use strict;
use warnings;
-use Test::More tests => 113;
+use Test::More tests => 115;
use Test::Exception;
BEGIN {
new_object clone_object
construct_instance construct_class_instance clone_instance
+ check_metaclass_compatability
name version
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN {
+ use_ok('metaclass');
+}
+
+{
+ package FooMeta;
+ use base 'Class::MOP::Class';
+
+ package Foo;
+ use metaclass 'FooMeta';
+}
+
+can_ok('Foo', 'meta');
+isa_ok(Foo->meta, 'FooMeta');
+isa_ok(Foo->meta, 'Class::MOP::Class');
+
+{
+ package BarMeta;
+ use base 'Class::MOP::Class';
+
+ package BarMeta::Attribute;
+ use base 'Class::MOP::Attribute';
+
+ package BarMeta::Method;
+ use base 'Class::MOP::Method';
+
+ package Bar;
+ use metaclass 'BarMeta' => (
+ ':attribute_metaclass' => 'BarMeta::Attribute',
+ ':method_metaclass' => 'BarMeta::Method',
+ );
+}
+
+can_ok('Bar', 'meta');
+isa_ok(Bar->meta, 'BarMeta');
+isa_ok(Bar->meta, 'Class::MOP::Class');
+
+is(Bar->meta->attribute_metaclass, 'BarMeta::Attribute', '... got the right attribute metaobject');
+is(Bar->meta->method_metaclass, 'BarMeta::Method', '... got the right method metaobject');
+
+{
+ package Baz;
+ use metaclass;
+}
+
+can_ok('Baz', 'meta');
+isa_ok(Baz->meta, 'Class::MOP::Class');
+
+eval {
+ package Boom;
+ metaclass->import('Foo');
+};
+ok($@, '... metaclasses must be subclass of Class::MOP::Class');
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN {
+ use_ok('metaclass');
+}
+
+# meta classes
+{
+ package Foo::Meta;
+ use base 'Class::MOP::Class';
+
+ package Bar::Meta;
+ use base 'Class::MOP::Class';
+
+ package FooBar::Meta;
+ use base 'Foo::Meta', 'Bar::Meta';
+}
+
+$@ = undef;
+eval {
+ package Foo;
+ metaclass->import('Foo::Meta');
+};
+ok(!$@, '... Foo.meta => Foo::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+ package Bar;
+ metaclass->import('Bar::Meta');
+};
+ok(!$@, '... Bar.meta => Bar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+ package Foo::Foo;
+ use base 'Foo';
+ metaclass->import('Bar::Meta');
+};
+ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+ package Bar::Bar;
+ use base 'Bar';
+ metaclass->import('Foo::Meta');
+};
+ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@;
+
+$@ = undef;
+eval {
+ package FooBar;
+ use base 'Foo';
+ metaclass->import('FooBar::Meta');
+};
+ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@;
+
+$@ = undef;
+eval {
+ package FooBar2;
+ use base 'Bar';
+ metaclass->import('FooBar::Meta');
+};
+ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@;
+
+
projects / gitmo/Class-MOP.git / commitdiff