Revision history for Perl extension Moose
+0.22
+ * Moose
+ - added SUPER_SLOT and INNER_SLOT class hashes to support unimport
+ - modified unimport to remove super and inner along with the rest
+ - altered unimport tests to handle this
+
+ * Moose::Role
+ - altered super export to populate SUPER_SLOT
+
+ * Moose::Meta::Class
+ - altered augment and override modifier application to use *_SLOT
+ - modified tests for these to unimport one test class each to test
+
0.21
* Moose::Meta::Role
- fixed issue where custom attribute metaclasses
};
},
super => sub {
+ {
+ our %SUPER_SLOT;
+ no strict 'refs';
+ $SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
+ }
return subname 'Moose::super' => sub {};
},
override => sub {
};
},
inner => sub {
+ {
+ our %INNER_SLOT;
+ no strict 'refs';
+ $INNER_SLOT{$CALLER} = \*{"${CALLER}::inner"};
+ }
return subname 'Moose::inner' => sub {};
},
augment => sub {
my $class = caller();
# loop through the exports ...
foreach my $name (keys %exports) {
- next if $name =~ /inner|super|self/;
# if we find one ...
if (defined &{$class . '::' . $name}) {
|| confess "You cannot override '$name' because it has no super method";
$self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
my @args = @_;
- no strict 'refs';
no warnings 'redefine';
- local *{$_super_package . '::super'} = sub { $super->(@args) };
- return $method->(@args);
+ if ($Moose::SUPER_SLOT{$_super_package}) {
+ local *{$Moose::SUPER_SLOT{$_super_package}}
+ = sub { $super->(@args) };
+ return $method->(@args);
+ } else {
+ confess "Trying to call override modifier'd method without super()";
+ }
}));
}
}
$self->add_method($name => sub {
my @args = @_;
- no strict 'refs';
no warnings 'redefine';
- local *{$_super_package . '::inner'} = sub { $method->(@args) };
- return $super->(@args);
+ if ($Moose::INNER_SLOT{$_super_package}) {
+ local *{$Moose::INNER_SLOT{$_super_package}}
+ = sub { $method->(@args) };
+ return $super->(@args);
+ } else {
+ return $super->(@args);
+ }
});
}
};
},
super => sub {
+ {
+ no strict 'refs';
+ $Moose::SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
+ }
my $meta = _find_meta();
return subname 'Moose::Role::super' => sub {};
},
override bar => sub { 'Baz::bar -> ' . super() };
override baz => sub { 'Baz::baz -> ' . super() };
+
+ no Moose; # ensure super() still works after unimport
}
my $baz = Baz->new();
augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' };
augment bar => sub { 'Bar::bar' };
+
+ no Moose; # ensure inner() still works after unimport
package Baz;
use Moose;
before after around
override
augment
-);
-
-my @moose_not_unimported = qw(
super inner
);
ok(!$@, '... Moose succesfully exported into Foo');
can_ok('Foo', $_) for @moose_exports;
-can_ok('Foo', $_) for @moose_not_unimported;
eval q{
package Foo;
ok(!$@, '... Moose succesfully un-exported from Foo');
ok(!Foo->can($_), '... Foo can no longer do ' . $_) for @moose_exports;
-can_ok('Foo', $_) for @moose_not_unimported;
# and check the type constraints as well