From: Stevan Little Date: Thu, 9 Feb 2006 22:41:03 +0000 (+0000) Subject: 0.06 release X-Git-Tag: 0_06^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=550d56db72e2f36b7fb88e6f9aa9d7f3d3fef53b;p=gitmo%2FClass-MOP.git 0.06 release --- diff --git a/Changes b/Changes index 16667c2..9169ea1 100644 --- a/Changes +++ b/Changes @@ -1,8 +1,8 @@ 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 @@ -25,12 +25,16 @@ Revision history for Perl extension 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 diff --git a/MANIFEST b/MANIFEST index cd54af8..2dd0654 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,15 +1,15 @@ 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 @@ -20,12 +20,16 @@ t/002_class_precedence_list.t 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 diff --git a/TODO b/TODO deleted file mode 100644 index 81b803b..0000000 --- a/TODO +++ /dev/null @@ -1,96 +0,0 @@ ---------------------------------------------------------------------- -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. - - - - - diff --git a/examples/InstanceCountingClass.pod b/examples/InstanceCountingClass.pod index 5730517..da80038 100644 --- a/examples/InstanceCountingClass.pod +++ b/examples/InstanceCountingClass.pod @@ -9,17 +9,15 @@ our $VERSION = '0.02'; 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; diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index c30f250..e508e59 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -260,6 +260,41 @@ B drain at all upon your code's performance. In fact, by itself 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 and C) and +two metaclasses (C and C) 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. If you +are interested in why this is an issue see the paper +I linked to in the +L section of this document. + =head1 PROTOCOLS The protocol is divided into 3 main sub-protocols: @@ -316,6 +351,29 @@ email me and let me know, I would love to hear about them. =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 + +=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 + +=back + =head2 Prior Art =over 4 @@ -338,30 +396,8 @@ As I have said above, this module is a class-builder-builder, so it is not the same thing as modules like L and L. 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, 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 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. This module does not make such restictions. - -Now, all this said, L is much more featureful than B -would ever try to be. But B has some features which L -could not easily implement. It would be very possible to completely re-implement -L using B and bring some of these features to -L 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, although it's philosophy and the MOP it +creates are very different from this modules. =head1 BUGS diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 068bbad..ff6516e 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -49,12 +49,14 @@ sub meta { Class::MOP::Class->initialize($_[0]) } || 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 { @@ -62,8 +64,30 @@ sub meta { Class::MOP::Class->initialize($_[0]) } # 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)) . ")"; + } } } @@ -556,6 +580,14 @@ to use C once all the bootstrapping is done. This method is used internally by C and should never be called from outside of that method really. +=item B + +This method is called as the very last thing in the +C 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 section in L. + =back =head2 Object instance construction and cloning diff --git a/lib/metaclass.pm b/lib/metaclass.pm index 917459f..39fea4b 100644 --- a/lib/metaclass.pm +++ b/lib/metaclass.pm @@ -31,50 +31,6 @@ sub import { }); } -=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__ @@ -87,8 +43,17 @@ metaclass - a pragma for installing using Class::MOP metaclasses =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', @@ -97,7 +62,8 @@ metaclass - a pragma for installing using Class::MOP metaclasses =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 method to your class as well. =head1 AUTHOR diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 1d68927..dea1f47 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 113; +use Test::More tests => 115; use Test::Exception; BEGIN { @@ -21,6 +21,7 @@ my @methods = qw( new_object clone_object construct_instance construct_class_instance clone_instance + check_metaclass_compatability name version diff --git a/t/040_metaclass.t b/t/040_metaclass.t new file mode 100644 index 0000000..b8f4918 --- /dev/null +++ b/t/040_metaclass.t @@ -0,0 +1,61 @@ +#!/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'); + diff --git a/t/041_metaclass_incompatability.t b/t/041_metaclass_incompatability.t new file mode 100644 index 0000000..ad33963 --- /dev/null +++ b/t/041_metaclass_incompatability.t @@ -0,0 +1,70 @@ +#!/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 $@; + +