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();
# 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) = @_;
Moose is built on top of L<Class::MOP>, 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??
=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
--- /dev/null
+
+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<safe> 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<before>, I<after>
+and I<around> methods with which method conflicts can be resolved.
+
+A method, which would normally conflict, but which is labeled with
+either a I<before>, I<after> or I<around> 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<before>, I<after> and I<around> 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<mixin ($mixin)>
+
+=back
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#!/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');
+
--- /dev/null
+#!/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<http://scala.epfl.ch/intro/mixin.html>
+
+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');
+
projects / gitmo/Moose.git / commitdiff