From: Shawn M Moore Date: Thu, 5 Feb 2009 03:47:44 +0000 (+0000) Subject: Implement override/super X-Git-Tag: 0.19~54 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e6007308abd5bc18fc86ed19d68732488750493f;p=gitmo%2FMouse.git Implement override/super --- diff --git a/lib/Mouse.pm b/lib/Mouse.pm index 0d5e443..c55e053 100644 --- a/lib/Mouse.pm +++ b/lib/Mouse.pm @@ -23,7 +23,7 @@ use Mouse::Meta::Class; use Mouse::Object; use Mouse::Util::TypeConstraints; -our @EXPORT = qw(extends has before after around blessed confess with); +our @EXPORT = qw(extends has before after around override super blessed confess with); sub extends { Mouse::Meta::Class->initialize(caller)->superclasses(@_) } @@ -77,6 +77,36 @@ sub with { Mouse::Util::apply_all_roles((caller)[0], @_); } +our $SUPER_PACKAGE; +our $SUPER_BODY; +our @SUPER_ARGS; + +sub super { + # This check avoids a recursion loop - see + # t/100_bugs/020_super_recursion.t + return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller(); + return unless $SUPER_BODY; $SUPER_BODY->(@SUPER_ARGS); +} + +sub override { + my $meta = Mouse::Meta::Class->initialize(caller); + my $pkg = $meta->name; + + my $name = shift; + my $code = shift; + + my $body = $pkg->can($name) + or confess "You cannot override '$name' because it has no super method"; + + $meta->add_method($name => sub { + local $SUPER_PACKAGE = $pkg; + local @SUPER_ARGS = @_; + local $SUPER_BODY = $body; + + $code->(@_); + }); +} + sub import { my $class = shift; diff --git a/t/042-override.t b/t/042-override.t new file mode 100644 index 0000000..11bf2f1 --- /dev/null +++ b/t/042-override.t @@ -0,0 +1,34 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 3; +use Test::Exception; + +my @parent_calls; +my @child_calls; + +do { + package Parent; + sub foo { push @parent_calls, [@_] } + + package Child; + use Mouse; + extends 'Parent'; + + override foo => sub { + my $self = shift; + push @child_calls, [splice @_]; + super; + }; +}; + +Child->foo(10, 11); +is_deeply([splice @parent_calls], [[Child => 10, 11]]); +is_deeply([splice @child_calls], [[10, 11]]); + +throws_ok { + package Orphan; # :( + use Mouse; + override foo => sub { }; +} qr/^You cannot override 'foo' because it has no super method/; +