Revision history for Perl extension Moose
-0.03_01
+0.03_02
+ * Moose
+ - you must now explictly use Moose::Util::TypeConstraints
+ it no longer gets exported for you automatically
+
+ * Moose::Object
+ - new() now accepts hash-refs as well as key/value lists
+
+0.03_01 Mon. March 10, 2006
* Moose::Cookbook
- added new Role recipe (no content yet, only code)
t/011_require_superclasses.t
t/012_super_and_override.t
t/013_inner_and_augment.t
+t/014_override_augment_inner_super.t
+t/015_override_and_foreign_classes.t
t/020_foreign_inheritence.t
t/030_attribute_reader_generation.t
t/031_attribute_writer_generation.t
# we should never export to main
return if $pkg eq 'main';
- Moose::Util::TypeConstraints->import($pkg);
+ #Moose::Util::TypeConstraints->import($pkg);
# make a subtype for each Moose class
subtype $pkg
=back
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+It should be noted that C<super> and C<inner> can B<not> be used in the same
+method. However, they can be combined together with the same class hierarchy,
+see F<t/014_override_augment_inner_super.t> for an example.
+
+The reason that this is so is because C<super> is only valid within a method
+with the C<override> modifier, and C<inner> will never be valid within an
+C<override> method. In fact, C<augment> will skip over any C<override> methods
+when searching for it's appropriate C<inner>.
+
+This might seem like a restriction, but I am of the opinion that keeping these
+two features seperate (but interoperable) actually makes them easy to use since
+their behavior is then easier to predict. Time will tell if I am right or not.
+
+=back
+
=head1 ACKNOWLEDGEMENTS
=over 4
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
use Locale::US;
use Regexp::Common 'zip';
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
has 'name' => (is => 'rw', isa => 'Str', required => 1);
has 'address' => (is => 'rw', isa => 'Address');
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
use HTTP::Headers ();
use Params::Coerce ();
my $super = $self->find_next_method_by_name($name);
(defined $super)
|| confess "You cannot override '$name' because it has no super method";
- $self->add_method($name => sub {
+ $self->add_method($name => bless sub {
my @args = @_;
no strict 'refs';
no warnings 'redefine';
local *{$_super_package . '::super'} = sub { $super->(@args) };
return $method->(@args);
- });
+ } => 'Moose::Meta::Method::Overriden');
}
sub add_augment_method_modifier {
- my ($self, $name, $method) = @_;
+ my ($self, $name, $method) = @_;
my $super = $self->find_next_method_by_name($name);
(defined $super)
- || confess "You cannot augment '$name' because it has no super method";
+ || confess "You cannot augment '$name' because it has no super method";
+ my $_super_package = $super->package_name;
+ # BUT!,... if this is an overriden method ....
+ if ($super->isa('Moose::Meta::Method::Overriden')) {
+ # we need to be sure that we actually
+ # find the next method, which is not
+ # an 'override' method, the reason is
+ # that an 'override' method will not
+ # be the one calling inner()
+ my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name);
+ $_super_package = $real_super->package_name;
+ }
$self->add_method($name => sub {
my @args = @_;
no strict 'refs';
no warnings 'redefine';
- local *{$super->package_name . '::inner'} = sub { $method->(@args) };
+ local *{$_super_package . '::inner'} = sub { $method->(@args) };
return $super->(@args);
});
}
+sub _find_next_method_by_name_which_is_not_overridden {
+ my ($self, $name) = @_;
+ my @methods = $self->find_all_methods_by_name($name);
+ foreach my $method (@methods) {
+ return $method->{code}
+ if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
+ }
+ return undef;
+}
+
+package Moose::Meta::Method::Overriden;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use base 'Class::MOP::Method';
+
1;
__END__
':attribute_metaclass' => 'Moose::Meta::Attribute'
);
-our $VERSION = '0.02';
+our $VERSION = '0.03';
sub new {
- my ($class, %params) = @_;
+ my $class = shift;
+ my %params = (scalar @_ == 1) ? %{$_[0]} : @_;
my $self = $class->meta->new_object(%params);
$self->BUILDALL(\%params);
return $self;
# Point3D
-my $point3d = Point3D->new(x => 10, y => 15, z => 3);
+my $point3d = Point3D->new({ x => 10, y => 15, z => 3 });
isa_ok($point3d, 'Point3D');
isa_ok($point3d, 'Point');
isa_ok($point3d, 'Moose::Object');
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
use Locale::US;
use Regexp::Common 'zip';
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
has 'name' => (is => 'rw', isa => 'Str', required => 1);
has 'address' => (is => 'rw', isa => 'Address');
my $ii;
lives_ok {
- $ii = Company->new(
+ $ii = Company->new({
name => 'Infinity Interactive',
address => Address->new(
street => '565 Plandome Rd., Suite 307',
address => Address->new(city => 'Marysville', state => 'OH')
),
]
- );
+ });
} '... created the entire company successfully';
isa_ok($ii, 'Company');
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
use HTTP::Headers ();
use Params::Coerce ();
{
package Foo;
use Moose;
+ use Moose::Util::TypeConstraints;
}
can_ok('Foo', 'meta');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+{
+ package Foo;
+ use strict;
+ use warnings;
+ use Moose;
+
+ sub foo { 'Foo::foo(' . (inner() || '') . ')' };
+ sub bar { 'Foo::bar(' . (inner() || '') . ')' }
+
+ package Bar;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Foo';
+
+ augment 'foo' => sub { 'Bar::foo' };
+ override 'bar' => sub { 'Bar::bar -> ' . super() };
+
+ package Baz;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Bar';
+
+ override 'foo' => sub { 'Baz::foo -> ' . super() };
+ augment 'bar' => sub { 'Baz::bar' };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+=pod
+
+Let em clarify what is happening here. Baz::foo is calling
+super(), which calls Bar::foo, which is an augmented sub
+that calls Foo::foo, then calls inner() which actually
+then calls Bar::foo. Confusing I know,.. but this is
+*exactly* what is it supposed to do :)
+
+=cut
+
+is($baz->foo,
+ 'Baz::foo -> Foo::foo(Bar::foo)',
+ '... got the right value from mixed augment/override foo');
+
+=pod
+
+Allow me to clarify this one now ...
+
+Since Baz::bar is an augment routine, it needs to find the
+correct inner() to be called by. In this case it is Foo::bar.
+However, Bar::bar is inbetween us, so it should actually be
+called first. Bar::bar is an overriden sub, and calls super()
+which in turn then calls our Foo::bar, which calls inner(),
+which calls Baz::bar.
+
+Confusing I know, but it is correct :)
+
+=cut
+
+is($baz->bar,
+ 'Bar::bar -> Foo::bar(Baz::bar)',
+ '... got the right value from mixed augment/override bar');
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+=pod
+
+This just tests the interaction of override/super
+with non-Moose superclasses. It really should not
+cause issues, the only thing it does is to create
+a metaclass for Foo so that it can find the right
+super method.
+
+This may end up being a sensitive issue for some
+non-Moose classes, but in 99% of the cases it
+should be just fine.
+
+=cut
+
+{
+ package Foo;
+ use strict;
+ use warnings;
+
+ sub new { bless {} => shift() }
+
+ sub foo { 'Foo::foo' }
+ sub bar { 'Foo::bar' }
+ sub baz { 'Foo::baz' }
+
+ package Bar;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Foo';
+
+ override bar => sub { 'Bar::bar -> ' . super() };
+
+ package Baz;
+ use strict;
+ use warnings;
+ use Moose;
+
+ extends 'Bar';
+
+ override bar => sub { 'Baz::bar -> ' . super() };
+ override baz => sub { 'Baz::baz -> ' . super() };
+}
+
+my $baz = Baz->new();
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+is($baz->foo(), 'Foo::foo', '... got the right value from &foo');
+is($baz->bar(), 'Baz::bar -> Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($baz->baz(), 'Baz::baz -> Foo::baz', '... got the right value from &baz');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+is($bar->foo(), 'Foo::foo', '... got the right value from &foo');
+is($bar->bar(), 'Bar::bar -> Foo::bar', '... got the right value from &bar');
+is($bar->baz(), 'Foo::baz', '... got the right value from &baz');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is($foo->foo(), 'Foo::foo', '... got the right value from &foo');
+is($foo->bar(), 'Foo::bar', '... got the right value from &bar');
+is($foo->baz(), 'Foo::baz', '... got the right value from &baz');
\ No newline at end of file
use strict;
use warnings;
use Moose;
+ use Moose::Util::TypeConstraints;
coerce 'HTTPHeader'
=> from ArrayRef
use strict;
use warnings;
use Moose;
+use Moose::Util::TypeConstraints;
type Baz => where { 1 };
projects / gitmo/Moose.git / commitdiff