From: Stevan Little Date: Sat, 18 Mar 2006 16:42:43 +0000 (+0000) Subject: removing-roles-n-mixins X-Git-Tag: 0_05~92 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bdb6823a3f5be69c0ebde8477f7209e0bd6e3ff7;p=gitmo%2FMoose.git removing-roles-n-mixins --- diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm deleted file mode 100644 index e227579..0000000 --- a/lib/Moose/Meta/Role.pm +++ /dev/null @@ -1,149 +0,0 @@ - -package Moose::Meta::Role; - -use strict; -use warnings; -use metaclass; - -use Carp 'confess'; -use Scalar::Util 'blessed', 'reftype'; -use Sub::Name 'subname'; -use B 'svref_2object'; - -our $VERSION = '0.01'; - -Moose::Meta::Role->meta->add_attribute('$:package' => ( - reader => 'name', - init_arg => ':package', -)); - -Moose::Meta::Role->meta->add_attribute('@:requires' => ( - reader => 'requires', - predicate => 'has_requires', - init_arg => ':requires', - default => sub { [] } -)); - -{ - my %ROLES; - sub initialize { - my ($class, %options) = @_; - my $pkg = $options{':package'}; - $ROLES{$pkg} ||= $class->meta->new_object(%options); - } -} - -sub add_method { - my ($self, $method_name, $method) = @_; - (defined $method_name && $method_name) - || confess "You must define a method name"; - # use reftype here to allow for blessed subs ... - ('CODE' eq (reftype($method) || '')) - || confess "Your code block must be a CODE reference"; - my $full_method_name = ($self->name . '::' . $method_name); - - no strict 'refs'; - no warnings 'redefine'; - *{$full_method_name} = subname $full_method_name => $method; -} - -sub alias_method { - my ($self, $method_name, $method) = @_; - (defined $method_name && $method_name) - || confess "You must define a method name"; - # use reftype here to allow for blessed subs ... - ('CODE' eq (reftype($method) || '')) - || confess "Your code block must be a CODE reference"; - my $full_method_name = ($self->name . '::' . $method_name); - - no strict 'refs'; - no warnings 'redefine'; - *{$full_method_name} = $method; -} - -sub has_method { - my ($self, $method_name) = @_; - (defined $method_name && $method_name) - || confess "You must define a method name"; - - my $sub_name = ($self->name . '::' . $method_name); - - no strict 'refs'; - return 0 if !defined(&{$sub_name}); - my $method = \&{$sub_name}; - return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name && - (svref_2object($method)->GV->NAME || '') ne '__ANON__'; - return 1; -} - -sub get_method { - my ($self, $method_name) = @_; - (defined $method_name && $method_name) - || confess "You must define a method name"; - - return unless $self->has_method($method_name); - - no strict 'refs'; - return \&{$self->name . '::' . $method_name}; -} - -sub remove_method { - my ($self, $method_name) = @_; - (defined $method_name && $method_name) - || confess "You must define a method name"; - - my $removed_method = $self->get_method($method_name); - - no strict 'refs'; - delete ${$self->name . '::'}{$method_name} - if defined $removed_method; - - return $removed_method; -} - -sub get_method_list { - my $self = shift; - no strict 'refs'; - grep { !/meta/ && $self->has_method($_) } %{$self->name . '::'}; -} - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::Meta::Role - The Moose role metaobject - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 METHODS - -=over 4 - -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=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 \ No newline at end of file diff --git a/lib/Moose/Meta/SafeMixin.pm b/lib/Moose/Meta/SafeMixin.pm deleted file mode 100644 index 949d3a4..0000000 --- a/lib/Moose/Meta/SafeMixin.pm +++ /dev/null @@ -1,203 +0,0 @@ - -package Moose::Meta::SafeMixin; - -use strict; -use warnings; - -use Scalar::Util 'blessed'; -use Carp 'confess'; - -our $VERSION = '0.01'; - -use base 'Class::MOP::Class'; - -Moose::Meta::SafeMixin->meta->add_attribute('mixed_in' => ( - accessor => 'mixed_in', - default => sub { [] } -)); - -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; - - # check for conflicts here ... - - $metaclass->has_attribute($_) - && confess "Attribute conflict ($_)" - foreach $mixin->get_attribute_list; - - foreach my $method_name ($mixin->get_method_list) { - # skip meta, cause everyone has that :) - next if $method_name =~ /meta/; - $metaclass->has_method($method_name) && confess "Method conflict ($method_name)"; - } - - # collect all the attributes - # and clone them so they can - # associate with the new class - # add all the attributes in .... - foreach my $attr ($mixin->get_attribute_list) { - $metaclass->add_attribute( - $mixin->get_attribute($attr)->clone() - ); - } - - # add all the methods in .... - foreach my $method_name ($mixin->get_method_list) { - # no need to mess with meta - next if $method_name eq 'meta'; - my $method = $mixin->get_method($method_name); - # and ignore accessors, the - # attributes take care of that - next if blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'); - $metaclass->alias_method($method_name => $method); - } - - push @{$metaclass->mixed_in} => $mixin - unless $metaclass->name eq 'Moose::Meta::Class'; -} - -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 - -=item B - -Accessor for the cache of mixed-in classes - -=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/Role.pm b/lib/Moose/Role.pm deleted file mode 100644 index 4460e72..0000000 --- a/lib/Moose/Role.pm +++ /dev/null @@ -1,105 +0,0 @@ - -package Moose::Role; - -use strict; -use warnings; - -use Carp 'confess'; -use Scalar::Util 'blessed'; -use Sub::Name 'subname'; - -our $VERSION = '0.01'; - -use Moose::Meta::Role; -use Moose::Util::TypeConstraints; - -sub import { - shift; - my $pkg = caller(); - - # we should never export to main - return if $pkg eq 'main'; - - Moose::Util::TypeConstraints->import($pkg); - - my $meta; - if ($pkg->can('meta')) { - $meta = $pkg->meta(); - (blessed($meta) && $meta->isa('Moose::Meta::Role')) - || confess "Whoops, not møøsey enough"; - } - else { - $meta = Moose::Meta::Role->initialize(':package' => $pkg); - $meta->add_method('meta' => sub { - # re-initialize so it inherits properly - Moose::Meta::Role->initialize(':package' => $pkg); - }) - } - - # NOTE: - # &alias_method will install the method, but it - # will not name it with - $meta->alias_method('requires' => subname 'Moose::Role::requires' => sub { - push @{$meta->requires} => @_; - }); - - - # make sure they inherit from Moose::Role::Base - { - no strict 'refs'; - @{$meta->name . '::ISA'} = ('Moose::Role::Base'); - } - - # we recommend using these things - # so export them for them - $meta->alias_method('confess' => \&Carp::confess); - $meta->alias_method('blessed' => \&Scalar::Util::blessed); -} - -package Moose::Role::Base; - -use strict; -use warnings; - -our $VERSION = '0.01'; - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::Role - The Moose role - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 METHODS - -=over 4 - -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=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 \ No newline at end of file diff --git a/t/030_basic_safe_mixin.t b/t/030_basic_safe_mixin.t deleted file mode 100644 index c2df61e..0000000 --- a/t/030_basic_safe_mixin.t +++ /dev/null @@ -1,101 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 21; - -BEGIN { - use_ok('Moose'); -} - -## Mixin a class without a superclass. -{ - package FooMixin; - use Moose; - sub foo { 'FooMixin::foo' } - - package Foo; - use Moose; - with 'FooMixin'; -} - -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'); - -is_deeply( - [ sort map { $_->name } @{Foo->meta->mixed_in} ], - [ 'FooMixin' ], - '... got the right mixin list'); - -## 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'); - -is_deeply( - [ sort map { $_->name } @{Baz->meta->mixed_in} ], - [], - '... got the right mixin list'); - -is_deeply( - [ sort map { $_->name } @{Bar->meta->mixed_in} ], - [], - '... got the right mixin list'); - -is_deeply( - [ sort map { $_->name } @{Foo::Baz->meta->mixed_in} ], - [ 'Baz' ], - '... got the right mixin list'); - -{ - 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'); - -is_deeply( - [ sort map { $_->name } @{Foo::Bar::Baz->meta->mixed_in} ], - [ 'Baz' ], - '... got the right mixin list'); - \ No newline at end of file diff --git a/t/031_mixin_example.t b/t/031_mixin_example.t deleted file mode 100644 index 7594960..0000000 --- a/t/031_mixin_example.t +++ /dev/null @@ -1,107 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 5; -use SUPER; - -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 Moose. - -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 Moose; - - has 'x' => (is => 'rw'); - has 'y' => (is => 'rw'); - - sub to_string { - my $self = shift; - "x = " . $self->x . ", y = " . $self->y; - } - - package ColoredPoint2D; - use Moose; - - extends 'Point2D'; - - has 'color' => (is => 'rw'); - - sub to_string { - my $self = shift; - $self->SUPER . ', col = ' . $self->color; - } - - package Point3D; - use Moose; - - extends 'Point2D'; - - has 'z' => (is => 'rw'); - - sub to_string { - my $self = shift; - $self->SUPER . ', z = ' . $self->z; - } - - package ColoredPoint3D; - use Moose; - - extends '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->to_string(), - 'x = 1, y = 2, z = 3, col = blue', - '... got the right toString method'); - diff --git a/t/040_basic_role.t b/t/040_basic_role.t deleted file mode 100644 index 2f949aa..0000000 --- a/t/040_basic_role.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 5; - -BEGIN { - use_ok('Moose'); -} - -{ - package Eq; - use strict; - use warnings; - use Moose::Role; - - requires 'equal'; - - sub not_equal { - my ($self, $other) = @_; - !$self->equal($other); - } -} - -isa_ok(Eq->meta, 'Moose::Meta::Role'); -ok(Eq->isa('Moose::Role::Base'), '... Eq is a role'); - -is_deeply( - Eq->meta->requires, - [ 'equal' ], - '... got the right required method'); - -is_deeply( - [ sort Eq->meta->get_method_list ], - [ 'not_equal' ], - '... got the right method list'); -