From: Stevan Little Date: Thu, 16 Mar 2006 18:23:18 +0000 (+0000) Subject: stuff X-Git-Tag: 0_05~100 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=505c6face48125839b721b281dea1634fefdf927;hp=e522431d8d7dfeffe645a28a045fa85fae03c8f0;p=gitmo%2FMoose.git stuff --- diff --git a/lib/Moose.pm b/lib/Moose.pm index dcec72a..df54342 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -11,11 +11,15 @@ use Carp 'confess'; use Sub::Name 'subname'; use Moose::Meta::Class; +use Moose::Meta::SafeMixin; use Moose::Meta::Attribute; use Moose::Object; use Moose::Util::TypeConstraints ':no_export'; +# bootstrap the mixin module +Moose::Meta::SafeMixin::mixin(Moose::Meta::Class->meta, 'Moose::Meta::SafeMixin'); + sub import { shift; my $pkg = caller(); @@ -47,6 +51,9 @@ sub import { # handle superclasses $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) }); + # handle mixins + $meta->alias_method('with' => subname 'Moose::with' => sub { $meta->mixin($_[0]) }); + # handle attributes $meta->alias_method('has' => subname 'Moose::has' => sub { my ($name, %options) = @_; @@ -152,8 +159,8 @@ object system. Moose is built on top of L, which is a metaclass system for Perl 5. This means that Moose not only makes building normal -Perl 5 objects better, but is also provides brings with it the power -of metaclass programming. +Perl 5 objects better, but it also provides the power of metaclass +programming. =head2 What does Moose stand for?? @@ -167,6 +174,20 @@ more :) =item Makes Object Orientation So Easy +=item Makes Object Orientation Sound Easy + +=item Makes Object Orientation Spiffy- Er + +=item My Overcraft Overfilled (with) Some Eels + +=item Moose Often Ovulate Sorta Early + +=item Most Other Object Systems Emasculate + +=item Many Overloaded Object Systems Exists + +=item Moose Offers Often Super Extensions + =back =head1 BUGS diff --git a/lib/Moose/Meta/SafeMixin.pm b/lib/Moose/Meta/SafeMixin.pm new file mode 100644 index 0000000..f042d6c --- /dev/null +++ b/lib/Moose/Meta/SafeMixin.pm @@ -0,0 +1,189 @@ + +package Moose::Meta::SafeMixin; + +use strict; +use warnings; + +use Scalar::Util 'blessed'; +use Carp 'confess'; + +our $VERSION = '0.01'; + +use base 'Class::MOP::Class'; + +sub mixin { + # fetch the metaclass for the + # caller and the mixin arg + my $metaclass = shift; + my $mixin = $metaclass->initialize(shift); + + # according to Scala, the + # the superclass of our class + # must be a subclass of the + # superclass of the mixin (see above) + my ($super_meta) = $metaclass->superclasses(); + my ($super_mixin) = $mixin->superclasses(); + ($super_meta->isa($super_mixin)) + || confess "The superclass ($super_meta) must extend a subclass of the superclass of the mixin ($super_mixin)" + if defined $super_mixin && defined $super_meta; + + # collect all the attributes + # and clone them so they can + # associate with the new class + my @attributes = map { + $mixin->get_attribute($_)->clone() + } $mixin->get_attribute_list; + + my %methods = map { + my $method = $mixin->get_method($_); + # we want to ignore accessors since + # they will be created with the attrs + (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor')) + ? () : ($_ => $method) + } $mixin->get_method_list; + + # NOTE: + # I assume that locally defined methods + # and attributes get precedence over those + # from the mixin. + + # add all the attributes in .... + foreach my $attr (@attributes) { + $metaclass->add_attribute($attr) + unless $metaclass->has_attribute($attr->name); + } + + # add all the methods in .... + foreach my $method_name (keys %methods) { + $metaclass->alias_method($method_name => $methods{$method_name}) + unless $metaclass->has_method($method_name); + } +} + +1; + +__END__ + +=pod + +=head1 NAME + +Moose::Meta::SafeMixin - A meta-object for safe mixin-style composition + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This is a meta-object which provides B mixin-style composition +of classes. The key word here is "safe" because we enforce a number +of rules about mixing in which prevent some of the instability +inherent in other mixin systems. However, it should be noted that we +still allow you enough rope with which to shoot yourself in the foot +if you so desire. + +=over 4 + +=item * + +In order to mix classes together, they must inherit from a common +superclass. This assures at least some level of similarity between +the classes being mixed together, which should result in a more +stable end product. + +The only exception to this rule is if the class being mixed in has +no superclasses at all. In this case we assume the mixin is valid. + +=item * + +Since we enforce a common ancestral relationship, we need to be +mindful of method and attribute conflicts. The common ancestor +increases the potential of method conflicts because it is common +for subclasses to override their parents methods. However, it is +less common for attributes to be overriden. The way these are +resolved is to use a Trait/Role-style conflict mechanism. + +If two classes are mixed together, any method or attribute conflicts +will result in a failure of the mixin and a fatal exception. It is +not possible to resolve a method or attribute conflict dynamically. +This is because to do so would open the possibility of breaking +classes in very subtle and dangerous ways, particularly in the area +of method interdependencies. The amount of implementation knowledge +which would need to be known by the mixee would (IMO) increase the +complexity of the feature exponentially for each class mixed in. + +However fear not, there is a solution (see below) ... + +=item * + +Safe mixin's offer the possibility of CLOS style I, I +and I methods with which method conflicts can be resolved. + +A method, which would normally conflict, but which is labeled with +either a I, I or I attribute, will instead be +combined with the original method in the way implied by the attribute. + +The result of this is a generalized event-handling system for classes. +Which can be used to create things more specialized, such as plugins +and decorators. + +=back + +=head2 What kinda crack are you on ?!?!?!? + +This approach may seem crazy, but I am fairly confident that it will +work, and that it will not tie your hands unnessecarily. All these +features have been used with certain degrees of success in the object +systems of other languages, but none (IMO) provided a complete +solution. + +In CLOS, I, I and I methods provide a high +degree of flexibility for adding behavior to methods, but do not address +any concerns regarding classes since in CLOS, classes and methods are +separate components of the system. + +In Scala, mixins are restricted by their ancestral relationships, which +results in a need to have seperate "traits" to get around this restriction. +In addition, Scala does not seem to have any means of method conflict +resolution for mixins (at least not that I can find). + +In Perl 6, the role system forces manual disambiguation which (as +mentioned above) can cause issues with method interdependecies when +composing roles together. This problem will grow exponentially in one +direction with each role composed and in the other direction with the +number of roles that role itself is composed of. The result is that the +complexity of the system becomes unmanagable for all but very simple or +very shallow roles. Now, this is not to say that roles are unusable, in +fact, this feature (IMO) promotes good useage of roles by keeping them +both small and simple. But, the same behaviors cannot be applied to +class mixins without hitting these barriers all too quickly. + +The same too can be said of the original Traits system, with its +features for aliasing and exclusion of methods. + +So after close study of these systems, and in some cases actually +implementing said systems, I have come to the see that each on it's +own is not robust enough and that combining the best parts of each +gives us (what I hope is) a better, safer and saner system. + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index 3639c56..adf7cc6 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -32,6 +32,15 @@ sub DEMOLISHALL { } } +sub NEXT { + my $self = shift; + my $method = (caller())[3]; + my $code = $self->meta->find_next_method_by_name($method); + (defined $code) + || confess "Could not find the NEXT method for ($method) in ($self)"; + return $code->($self, @_); +} + sub DESTROY { goto &DEMOLISHALL } 1; diff --git a/t/030_basic_safe_mixin.t b/t/030_basic_safe_mixin.t new file mode 100644 index 0000000..44b81a9 --- /dev/null +++ b/t/030_basic_safe_mixin.t @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 16; + +BEGIN { + use_ok('Moose'); +} + +## Mixin a class without a superclass. +{ + package FooMixin; + use Moose; + sub foo { 'FooMixin::foo' } + + package Foo; + use Moose; + + with 'FooMixin'; + + sub new { (shift)->meta->new_object(@_) } +} + +my $foo = Foo->new(); +isa_ok($foo, 'Foo'); + +can_ok($foo, 'foo'); +is($foo->foo, 'FooMixin::foo', '... got the right value from the mixin method'); + +## Mixin a class who shares a common ancestor +{ + package Baz; + use Moose; + extends 'Foo'; + + sub baz { 'Baz::baz' } + + package Bar; + use Moose; + extends 'Foo'; + + package Foo::Baz; + use Moose; + extends 'Foo'; + eval { with 'Baz' }; + ::ok(!$@, '... the classes superclass must extend a subclass of the superclass of the mixins'); + +} + +my $foo_baz = Foo::Baz->new(); +isa_ok($foo_baz, 'Foo::Baz'); +isa_ok($foo_baz, 'Foo'); + +can_ok($foo_baz, 'baz'); +is($foo_baz->baz(), 'Baz::baz', '... got the right value from the mixin method'); + +{ + package Foo::Bar; + use Moose; + extends 'Foo', 'Bar'; + + package Foo::Bar::Baz; + use Moose; + extends 'Foo::Bar'; + eval { with 'Baz' }; + ::ok(!$@, '... the classes superclass must extend a subclass of the superclass of the mixins'); +} + +my $foo_bar_baz = Foo::Bar::Baz->new(); +isa_ok($foo_bar_baz, 'Foo::Bar::Baz'); +isa_ok($foo_bar_baz, 'Foo::Bar'); +isa_ok($foo_bar_baz, 'Foo'); +isa_ok($foo_bar_baz, 'Bar'); + +can_ok($foo_bar_baz, 'baz'); +is($foo_bar_baz->baz(), 'Baz::baz', '... got the right value from the mixin method'); + diff --git a/t/031_mixin_example.t b/t/031_mixin_example.t new file mode 100644 index 0000000..0ac4883 --- /dev/null +++ b/t/031_mixin_example.t @@ -0,0 +1,123 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; + +BEGIN { + use_ok('Moose'); +} + +=pod + +This test demonstrates how simple it is to create Scala Style +Class Mixin Composition. Below is an example taken from the +Scala web site's example section, and trancoded to Class::MOP. + +NOTE: +We require SUPER for this test to handle the issue with SUPER:: +being determined at compile time. + +L + +A class can only be used as a mixin in the definition of another +class, if this other class extends a subclass of the superclass +of the mixin. Since ColoredPoint3D extends Point3D and Point3D +extends Point2D which is the superclass of ColoredPoint2D, the +code above is well-formed. + + class Point2D(xc: Int, yc: Int) { + val x = xc; + val y = yc; + override def toString() = "x = " + x + ", y = " + y; + } + + class ColoredPoint2D(u: Int, v: Int, c: String) extends Point2D(u, v) { + val color = c; + def setColor(newCol: String): Unit = color = newCol; + override def toString() = super.toString() + ", col = " + color; + } + + class Point3D(xc: Int, yc: Int, zc: Int) extends Point2D(xc, yc) { + val z = zc; + override def toString() = super.toString() + ", z = " + z; + } + + class ColoredPoint3D(xc: Int, yc: Int, zc: Int, col: String) + extends Point3D(xc, yc, zc) + with ColoredPoint2D(xc, yc, col); + + + Console.println(new ColoredPoint3D(1, 2, 3, "blue").toString()) + + "x = 1, y = 2, z = 3, col = blue" + +=cut + +{ + package Point2D; + use metaclass; + + Point2D->meta->add_attribute('$x' => ( + accessor => 'x', + init_arg => 'x', + )); + + Point2D->meta->add_attribute('$y' => ( + accessor => 'y', + init_arg => 'y', + )); + + sub new { + my $class = shift; + $class->meta->new_object(@_); + } + + sub toString { + my $self = shift; + "x = " . $self->x . ", y = " . $self->y; + } + + package ColoredPoint2D; + our @ISA = ('Point2D'); + + ColoredPoint2D->meta->add_attribute('$color' => ( + accessor => 'color', + init_arg => 'color', + )); + + sub toString { + my $self = shift; + $self->SUPER() . ', col = ' . $self->color; + } + + package Point3D; + our @ISA = ('Point2D'); + + Point3D->meta->add_attribute('$z' => ( + accessor => 'z', + init_arg => 'z', + )); + + sub toString { + my $self = shift; + $self->SUPER() . ', z = ' . $self->z; + } + + package ColoredPoint3D; + our @ISA = ('Point3D'); + + ::with('ColoredPoint2D'); + +} + +my $colored_point_3d = ColoredPoint3D->new(x => 1, y => 2, z => 3, color => 'blue'); +isa_ok($colored_point_3d, 'ColoredPoint3D'); +isa_ok($colored_point_3d, 'Point3D'); +isa_ok($colored_point_3d, 'Point2D'); + +is($colored_point_3d->toString(), + 'x = 1, y = 2, z = 3, col = blue', + '... got the right toString method'); +