0.06
* Moose
- refactored the keyword exports
- - 'with' now checks Role validaity
+ - 'with' now checks Role validaity and
+ accepts more than one Role at a time
- 'extends' makes metaclass adjustments as
needed to ensure metaclass compatability
- added the 'enum' keyword for simple
string enumerations which can be used as
type constraints
- - see example of usage in t/008_basic.t
+ - see example of usage in t/202_example.t
* Moose::Object
- more careful checking of params to new()
- (still somewhat) experimental delegation support
with the 'handles' option
- added several tests for this
+ - no docs for this yet
0.05 Thurs. April 27, 2006
* Moose
lib/Moose/Cookbook/Recipe6.pod
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/Class.pm
+lib/Moose/Meta/Instance.pm
lib/Moose/Meta/Role.pm
lib/Moose/Meta/TypeCoercion.pm
lib/Moose/Meta/TypeConstraint.pm
lib/Moose/Util/TypeConstraints.pm
t/000_load.t
-t/001_basic.t
-t/002_basic.t
-t/003_basic.t
-t/004_basic.t
-t/005_basic.t
-t/006_basic.t
-t/007_basic.t
+t/001_recipe.t
+t/002_recipe.t
+t/003_recipe.t
+t/004_recipe.t
+t/005_recipe.t
+t/006_recipe.t
t/010_basic_class_setup.t
t/011_require_superclasses.t
t/012_super_and_override.t
t/014_override_augment_inner_super.t
t/015_override_and_foreign_classes.t
t/020_foreign_inheritence.t
+t/021_moose_w_metaclass.t
+t/022_moose_respects_base.t
+t/023_moose_respects_type_constraints.t
t/030_attribute_reader_generation.t
t/031_attribute_writer_generation.t
t/032_attribute_accessor_generation.t
t/033_attribute_triggers.t
t/034_attribute_does.t
+t/035_attribute_required.t
+t/036_attribute_custom_metaclass.t
+t/037_attribute_type_unions.t
+t/038_attribute_inherited_slot_specs.t
+t/039_attribute_delegation.t
t/040_meta_role.t
t/041_role.t
t/042_apply_role.t
t/054_util_type_coercion.t
t/055_util_type_reloading.t
t/056_util_more_type_coercion.t
+t/057_union_types.t
+t/060_moose_for_meta.t
+t/070_more_attr_delegation.t
t/100_subtype_quote_bug.t
t/101_subtype_conflict_bug.t
t/102_Moose_Object_error.t
t/103_subclass_use_base_bug.t
+t/201_example.t
+t/202_example.t
t/pod.t
t/pod_coverage.t
t/lib/Bar.pm
-Moose version 0.05
+Moose version 0.06
===========================
See the individual module documentation for more information
- inherited slot specs
-[10:49] stevan does can be added to,.. but not changed
+'does' can be added to,.. but not changed
+(need type unions for this)
- proxy attributes
-[15:49] stevan you want a proxied attribute
-[15:49] stevan which looks like an attribute,
- talks like an attribute, smells
- like an attribute,.. but if you
- look behind the curtain,.. its
- over there.. in that other object
+a proxied attribute is an attribute
+which looks like an attribute,
+talks like an attribute, smells
+like an attribute,.. but if you
+look behind the curtain,.. its
+over there.. in that other object
+
+(... probably be a custom metaclass)
- compile time extends
use strict;
use warnings;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
with => sub {
my $class = $CALLER;
return subname 'Moose::with' => sub {
- my ($role) = @_;
- _load_all_classes($role);
- ($role->can('meta') && $role->meta->isa('Moose::Meta::Role'))
- || confess "You can only consume roles, $role is not a Moose role";
- $role->meta->apply($class->meta);
+ my (@roles) = @_;
+ _load_all_classes(@roles);
+ ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
+ || confess "You can only consume roles, $_ is not a Moose role"
+ foreach @roles;
+ if (scalar @roles == 1) {
+ $roles[0]->meta->apply($class->meta);
+ }
+ else {
+ Moose::Meta::Role->combine(
+ map { $_->meta } @roles
+ )->apply($class->meta);
+ }
};
},
has => sub {
Stevan Little E<lt>stevan@iinteractive.comE<gt>
-Christian Hansen
+Christian Hansen E<lt>chansen@cpan.orgE<gt>
+
+Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
=head1 COPYRIGHT AND LICENSE
From here on, you can use C<$point> and C<$point3d> just as you would
any other Perl 5 object. For a more detailed example of what can be
-done, you can refer to the F<t/001_basic.t> test file.
+done, you can refer to the F<t/001_recipe.t> test file.
=head1 CONCLUSION
);
And as with the first recipe, a more in-depth example of using
-these classes can be found in the F<t/002_basic.t> test file.
+these classes can be found in the F<t/002_recipe.t> test file.
=head1 CONCLUSION
Now, as with all the other recipes, you can go about using
B<BinaryTree> like any other Perl 5 class. A more detailed example of
-usage can be found in F<t/003_basic.t>.
+usage can be found in F<t/003_recipe.t>.
=head1 CONCLUSION
Once again, as with all the other recipes, you can go about using
these classes like any other Perl 5 class. A more detailed example of
-usage can be found in F<t/004_basic.t>.
+usage can be found in F<t/004_recipe.t>.
=head1 CONCLUSION
use Scalar::Util 'blessed', 'weaken', 'reftype';
use Carp 'confess';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use Moose::Util::TypeConstraints ();
use Carp 'confess';
use Scalar::Util 'weaken', 'blessed', 'reftype';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use base 'Class::MOP::Class';
$options{':role_meta'} = Moose::Meta::Class->initialize(
$options{role_name},
':method_metaclass' => 'Moose::Meta::Role::Method'
- );
+ ) unless defined $options{':role_meta'} &&
+ $options{':role_meta'}->isa('Moose::Meta::Class');
my $self = $class->meta->new_object(%options);
return $self;
}
exists $self->get_required_methods_map->{$method_name} ? 1 : 0;
}
+sub _clean_up_required_methods {
+ my $self = shift;
+ foreach my $method ($self->get_required_method_list) {
+ delete $self->get_required_methods_map->{$method}
+ if $self->has_method($method);
+ }
+}
+
## methods
# NOTE:
}
foreach my $attribute_name ($self->get_attribute_list) {
- # skip it if it has one already
- next if $other->has_attribute($attribute_name);
- # add it, although it could be overriden
- $other->add_attribute(
- $attribute_name,
- %{$self->get_attribute($attribute_name)}
- );
+ # it if it has one already
+ if ($other->has_attribute($attribute_name)) {
+ # see if we are being composed
+ # into a role or not
+ if ($other->isa('Moose::Meta::Role')) {
+ # all attribute conflicts between roles
+ # result in an immediate fatal error
+ confess "Role '" . $self->name . "' has encountered an attribute conflict " .
+ "during composition. This is fatal error and cannot be disambiguated.";
+ }
+ else {
+ # but if this is a class, we
+ # can safely skip adding the
+ # attribute to the class
+ next;
+ }
+ }
+ else {
+ # add it, although it could be overriden
+ $other->add_attribute(
+ $attribute_name,
+ %{$self->get_attribute($attribute_name)}
+ );
+ }
}
foreach my $method_name ($self->get_method_list) {
- # skip it if it has one already
- next if $other->has_method($method_name);
- # add it, although it could be overriden
- $other->alias_method(
- $method_name,
- $self->get_method($method_name)
- );
+ # it if it has one already
+ if ($other->has_method($method_name)) {
+ # see if we are composing into a role
+ if ($other->isa('Moose::Meta::Role')) {
+ # method conflicts between roles result
+ # in the method becoming a requirement
+ $other->add_required_methods($method_name);
+ # NOTE:
+ # we have to remove the method from our
+ # role, if this is being called from combine()
+ # which means the meta is an anon class
+ # this *may* cause problems later, but it
+ # is probably fairly safe to assume that
+ # anon classes will only be used internally
+ # or by people who know what they are doing
+ $other->_role_meta->remove_method($method_name)
+ if $other->_role_meta->name =~ /__ANON__/;
+ }
+ else {
+ next;
+ }
+ }
+ else {
+ # add it, although it could be overriden
+ $other->alias_method(
+ $method_name,
+ $self->get_method($method_name)
+ );
+ }
}
foreach my $method_name ($self->get_method_modifier_list('override')) {
$other->add_role($self);
}
+sub combine {
+ my ($class, @roles) = @_;
+
+ my $combined = $class->new(
+ ':role_meta' => Moose::Meta::Class->create_anon_class()
+ );
+
+ foreach my $role (@roles) {
+ $role->apply($combined);
+ }
+
+ $combined->_clean_up_required_methods;
+
+ #warn ">>> req-methods: " . (join ", " => $combined->get_required_method_list) . "\n";
+ #warn ">>> methods: " . (join ", " => $combined->get_method_list) . "\n";
+ #warn ">>> attrs: " . (join ", " => $combined->get_attribute_list) . "\n";
+
+ return $combined;
+}
+
package Moose::Meta::Role::Method;
use strict;
=item B<apply>
+=item B<combine>
+
=back
=over 4
use Carp 'confess';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
sub new {
my $class = shift;
Stevan Little E<lt>stevan@iinteractive.comE<gt>
-Christian Hansen
+Christian Hansen E<lt>chansen@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+ use_ok('Moose::Role');
+}
+
+=pod
+
+Mutually recursive roles.
+
+=cut
+
+{
+ package Role::Foo;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ requires 'foo';
+
+ sub bar { 'Role::Foo::bar' }
+
+ package Role::Bar;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ requires 'bar';
+
+ sub foo { 'Role::Bar::foo' }
+}
+
+{
+ package My::Test1;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Foo', 'Role::Bar';
+ } '... our mutually recursive roles combine okay';
+
+ package My::Test2;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Bar', 'Role::Foo';
+ } '... our mutually recursive roles combine okay (no matter what order)';
+}
+
+my $test1 = My::Test1->new;
+isa_ok($test1, 'My::Test1');
+
+ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
+ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
+
+can_ok($test1, 'foo');
+can_ok($test1, 'bar');
+
+is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
+is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
+
+my $test2 = My::Test2->new;
+isa_ok($test2, 'My::Test2');
+
+ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
+ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
+
+can_ok($test2, 'foo');
+can_ok($test2, 'bar');
+
+is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
+is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
+
+# check some meta-stuff
+
+ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
+ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
+
+ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
+ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
+
+=pod
+
+Role method conflicts
+
+=cut
+
+{
+ package Role::Bling;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ sub bling { 'Role::Bling::bling' }
+
+ package Role::Bling::Bling;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ sub bling { 'Role::Bling::Bling::bling' }
+}
+
+{
+ package My::Test3;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::throws_ok {
+ with 'Role::Bling', 'Role::Bling::Bling';
+ } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
+
+ package My::Test4;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Bling';
+ with 'Role::Bling::Bling';
+ } '... role methods didnt conflict when manually combined';
+
+ package My::Test5;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Bling::Bling';
+ with 'Role::Bling';
+ } '... role methods didnt conflict when manually combined (in opposite order)';
+
+ package My::Test6;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Bling::Bling', 'Role::Bling';
+ } '... role methods didnt conflict when manually resolved';
+
+ sub bling { 'My::Test6::bling' }
+}
+
+ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
+ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
+ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
+ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
+
+is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
+is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
+is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
+
+# check how this affects role compostion
+
+{
+ package Role::Bling::Bling::Bling;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ with 'Role::Bling::Bling';
+
+ sub bling { 'Role::Bling::Bling::Bling::bling' }
+}
+
+ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
+ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
+
+=pod
+
+Role attribute conflicts
+
+=cut
+
+{
+ package Role::Boo;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
+
+ package Role::Boo::Hoo;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
+}
+
+{
+ package My::Test7;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::throws_ok {
+ with 'Role::Boo', 'Role::Boo::Hoo';
+ } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
+ '... role attrs conflicted and method was required';
+
+ package My::Test8;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Boo';
+ with 'Role::Boo::Hoo';
+ } '... role attrs didnt conflict when manually combined';
+
+ package My::Test9;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::Boo::Hoo';
+ with 'Role::Boo';
+ } '... role attrs didnt conflict when manually combined';
+
+ package My::Test10;
+ use strict;
+ use warnings;
+ use Moose;
+
+ has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
+
+ ::throws_ok {
+ with 'Role::Boo', 'Role::Boo::Hoo';
+ } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
+ '... role attrs conflicted and cannot be manually disambiguted';
+
+}
+
+ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
+ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
+ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
+ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
+
+can_ok('My::Test8', 'ghost');
+can_ok('My::Test9', 'ghost');
+can_ok('My::Test10', 'ghost');
+
+is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
+is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
+is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
+
+
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+ use_ok('Moose::Role');
+}
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 32;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+ use_ok('Moose::Role');
+}
+
+sub U {
+ my $f = shift;
+ sub { $f->($f, @_) };
+}
+
+sub Y {
+ my $f = shift;
+ U(sub { my $h = shift; sub { $f->(U($h)->())->(@_) } })->();
+}
+
+{
+ package List;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ has '_list' => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ init_arg => '::',
+ default => sub { [] }
+ );
+
+ sub head { (shift)->_list->[0] }
+ sub tail {
+ my $self = shift;
+ $self->new(
+ '::' => [
+ @{$self->_list}[1 .. $#{$self->_list}]
+ ]
+ );
+ }
+
+ sub print {
+ join ", " => @{$_[0]->_list};
+ }
+
+ package List::Immutable;
+ use strict;
+ use warnings;
+ use Moose::Role;
+
+ requires 'head';
+ requires 'tail';
+
+ sub is_empty { not defined ($_[0]->head) }
+
+ sub length {
+ my $self = shift;
+ (::Y(sub {
+ my $redo = shift;
+ sub {
+ my ($list, $acc) = @_;
+ return $acc if $list->is_empty;
+ $redo->($list->tail, $acc + 1);
+ }
+ }))->($self, 0);
+ }
+
+ sub apply {
+ my ($self, $function) = @_;
+ (::Y(sub {
+ my $redo = shift;
+ sub {
+ my ($list, $func, $acc) = @_;
+ return $list->new('::' => $acc)
+ if $list->is_empty;
+ $redo->(
+ $list->tail,
+ $func,
+ [ @{$acc}, $func->($list->head) ]
+ );
+ }
+ }))->($self, $function, []);
+ }
+
+ package My::List1;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'List', 'List::Immutable';
+ } '... successfully composed roles together';
+
+ package My::List2;
+ use strict;
+ use warnings;
+ use Moose;
+
+ ::lives_ok {
+ with 'List::Immutable', 'List';
+ } '... successfully composed roles together';
+
+}
+
+{
+ my $coll = My::List1->new;
+ isa_ok($coll, 'My::List1');
+
+ ok($coll->does('List'), '... $coll does List');
+ ok($coll->does('List::Immutable'), '... $coll does List::Immutable');
+
+ ok($coll->is_empty, '... we have an empty collection');
+ is($coll->length, 0, '... we have a length of 1 for the collection');
+}
+
+{
+ my $coll = My::List2->new;
+ isa_ok($coll, 'My::List2');
+
+ ok($coll->does('List'), '... $coll does List');
+ ok($coll->does('List::Immutable'), '... $coll does List::Immutable');
+
+ ok($coll->is_empty, '... we have an empty collection');
+ is($coll->length, 0, '... we have a length of 1 for the collection');
+}
+
+{
+ my $coll = My::List1->new('::' => [ 1 .. 10 ]);
+ isa_ok($coll, 'My::List1');
+
+ ok($coll->does('List'), '... $coll does List');
+ ok($coll->does('List::Immutable'), '... $coll does List::Immutable');
+
+ ok(!$coll->is_empty, '... we do not have an empty collection');
+ is($coll->length, 10, '... we have a length of 10 for the collection');
+
+ is($coll->print, '1, 2, 3, 4, 5, 6, 7, 8, 9, 10', '... got the right printed value');
+
+ my $coll2 = $coll->apply(sub { $_[0] * $_[0] });
+ isa_ok($coll2, 'My::List1');
+
+ is($coll->print, '1, 2, 3, 4, 5, 6, 7, 8, 9, 10', '... original is still the same');
+ is($coll2->print, '1, 4, 9, 16, 25, 36, 49, 64, 81, 100', '... new collection is changed');
+}
+
+{
+ my $coll = My::List2->new('::' => [ 1 .. 10 ]);
+ isa_ok($coll, 'My::List2');
+
+ ok($coll->does('List'), '... $coll does List');
+ ok($coll->does('List::Immutable'), '... $coll does List::Immutable');
+
+ ok(!$coll->is_empty, '... we do not have an empty collection');
+ is($coll->length, 10, '... we have a length of 10 for the collection');
+
+ is($coll->print, '1, 2, 3, 4, 5, 6, 7, 8, 9, 10', '... got the right printed value');
+
+ my $coll2 = $coll->apply(sub { $_[0] * $_[0] });
+ isa_ok($coll2, 'My::List2');
+
+ is($coll->print, '1, 2, 3, 4, 5, 6, 7, 8, 9, 10', '... original is still the same');
+ is($coll2->print, '1, 4, 9, 16, 25, 36, 49, 64, 81, 100', '... new collection is changed');
+}
+
+
+
+
+
+
+
+
projects / gitmo/Moose.git / commitdiff