perlmoosemoosex-types

Perl MooseX::Method::Signatures inject custom code to all methods


I am trying to use MooseX::Method::Signatures and MooseX::Declare in an application, my need is to inject custom code at the beginning of each method at compile time not at run time:

instead of this:

use MooseX::Declare;

method check ($value) {
     $return $value;
}

I want to inject a code at the beginning of each method at compile time to be like that:

method check ($value) {
     my ($value) = $self->validate($value);
     $return $value;
}

now I want the code

my ($value) = $self->validate($value);

to be injected automatically at the beginning of all methods in the package using the MooseX::Decalre module at compile time and not at run time, I mean not using the Moose method modifiers before, after, around etc.

This needs a modification of these module but I need someone to tell me where to start.

I was able to modify the module Method::Signatures::Simple to do this exactly and emailed the author for the modification but did not get a reply. The reason I can not use this even with modification because it does not support type checking and defaults like MooseX::Declare.

The modified version of the module Method::Signatures::Simple below for reference and I use it as follows:

use Method::Signatures::Simple (method => 'method,action', function => 'function', invocant=>'$this', 'inject'=>'my ($me) = $this->me;');

now in all methods, I get the code my ($me) = $this->me; injected and I just can use it like that:

method check ($value) {
     say $me 
}

Here is the modified Method::Signatures::Simple module.

package Method::Signatures::Simple;
{
  $Method::Signatures::Simple::VERSION = '1.07';
}

use warnings;
use strict;

=head1 NAME

Method::Signatures::Simple - Basic method declarations with signatures, without source filters

=head1 VERSION

version 1.07

=cut

use base 'Devel::Declare::MethodInstaller::Simple';

our $inject_code;

sub import {
    my $class = shift;
    my %opts  = @_;
    $opts{into} ||= caller;

    my $meth = delete $opts{name} || delete $opts{method};
    my $func = delete $opts{function};
    my $invocant = delete $opts{invocant} || '$self';
    $inject_code = delete $opts{inject};

    $inject_code .= ";" if ($inject_code && $inject_code !~ /\;$/);

    # if no options are provided at all, then we supply defaults
    unless (defined $meth || defined $func) {
        $meth = 'method';
        $func = 'func';
    }

    my @meth = split /\s*\,+\s*/, $meth;

    # we only install keywords that are requested
    foreach $meth (@meth) {
        if (defined $meth) {
            $class->install_methodhandler(
            name     => $meth,
            invocant => $invocant,
            %opts,
            );
        }
    }

    if (defined $func) {
        $class->install_methodhandler(
          name     => $func,
          %opts,
          invocant => undef,
        );
    }
}

sub strip_proto {
    my $self = shift;
    my ($proto) = $self->SUPER::strip_proto()
      or return '';
    # we strip comments and newlines here, and stash the number of newlines.
    # we will re-inject the newlines in strip_attrs(), because DD does not
    # like it when you inject them into the following code block. it does not
    # object to tacking on newlines to the code attribute spec though.
    # (see the call to inject_if_block() in DD::MethodInstaller::Simple->parser)
    $proto =~ s/\s*#.*$//mg;
    $self->{__nls} = $proto =~ s/[\r\n]//g;
    $proto;
}

sub strip_attrs {
    my $self = shift;
    my ($attrs) = $self->SUPER::strip_attrs();
    $attrs ||= '';
    $attrs .= $/ x $self->{__nls} if $self->{__nls};
    $attrs;
}

sub parse_proto {
    my $self = shift;
    my ($proto) = @_;
    $proto ||= '';
    $proto =~ s/\s*#.*$//mg;
    $proto =~ s/^\s+//mg;
    $proto =~ s/\s+$//mg;
    $proto =~ s/[\r\n]//g;
    my $invocant = $self->{invocant};

    $invocant = $1 if $proto =~ s{(\$\w+)\s*:\s*}{};

    my $inject = '';
    $inject .= "my ${invocant} = shift;" if $invocant;
    $inject .= "my ($proto) = \@_;"      if defined $proto and length $proto;
    $inject .= "$inject_code" if $inject_code;
    $inject .= '();'; # fix for empty method body

    return $inject;
}

Solution

  • Moops and Kavorka provide a syntax almost compatible with MooseX::Declare and MooseX::Method::Signatures, and are designed to be very extensible (even from within!) via traits. I'll draw your attention to the following section of documentation for MooseX::Declare:

    Warning: MooseX::Declare is based on Devel::Declare, a giant bag of crack originally implemented by mst with the goal of upsetting the perl core developers so much by its very existence that they implemented proper keyword handling in the core.

    [...]

    If you want to use declarative syntax in new code, please for the love of kittens get yourself a recent perl and look at Moops instead.

    MooseX::Declare itself is not very easy to extend. I know. I've tried.

    So bearing all that in mind, and also because I wrote Moops, I'll use that for the example. Here we define a role Kavorka::TraitFor::Sub::ProvidesMe which is will inject a little bit of code into a method. We then apply that role to a method using does ProvideMe.

    package main;
    use Moops;
    
    role Kavorka::TraitFor::Sub::ProvideMe
    {
        around inject_prelude (@_)
        {
            my $prelude = $self->$next(@_);
            $prelude .= 'my ($me) = $self->me;();';
            return $prelude;
        }
    }
    
    class MyClass
    {
        method me () { "tobyink" }
    
        method example () does ProvideMe
        {
            # This gets injected: my ($me) = $self->me;
            return $me;
        }
    }
    
    my $obj = MyClass->new;
    say $obj->example;  ## says "tobyink"