Moose::Meta::Method::Overridden - A Moose Method metaclass for overridden methods

Moose documentation Contained in the Moose distribution.

Index

Code Index:

NAME

Top

Moose::Meta::Method::Overridden - A Moose Method metaclass for overridden methods

DESCRIPTION

Top

This class implements method overriding logic for the Moose override keyword.

The overriding subroutine's parent will be invoked explicitly using the super keyword from the parent class's method definition.

METHODS

Top

Moose::Meta::Method::Overridden->new(%options)

This constructs a new object. It accepts the following options:

* class

The metaclass object for the class in which the override is being declared. This option is required.

* name

The name of the method which we are overriding. This method must exist in one of the class's superclasses. This option is required.

* method

The subroutine reference which implements the overriding. This option is required.

BUGS

Top

See BUGS in Moose for details on reporting bugs.

AUTHOR

Top

Yuval Kogman <nothingmuch@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2006-2010 by Infinity Interactive, Inc.

http://www.iinteractive.com

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Moose documentation Contained in the Moose distribution. 
package Moose::Meta::Method::Overridden;

use strict;
use warnings;

our $VERSION   = '0.99';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';

use base 'Moose::Meta::Method';

sub new {
    my ( $class, %args ) = @_;

    # the package can be overridden by roles
    # it is really more like body's compilation stash
    # this is where we need to override the definition of super() so that the
    # body of the code can call the right overridden version
    my $super_package = $args{package} || $args{class}->name;

    my $name = $args{name};

    my $super = $args{class}->find_next_method_by_name($name);

    (defined $super)
        || $class->throw_error("You cannot override '$name' because it has no super method", data => $name);

    my $super_body = $super->body;

    my $method = $args{method};

    my $body = sub {
        local $Moose::SUPER_PACKAGE = $super_package;
        local @Moose::SUPER_ARGS = @_;
        local $Moose::SUPER_BODY = $super_body;
        return $method->(@_);
    };

    # FIXME do we need this make sure this works for next::method?
    # subname "${super_package}::${name}", $method;

    # FIXME store additional attrs
    $class->wrap(
        $body,
        package_name => $args{class}->name,
        name         => $name
    );
}

1;

__END__