Is there a Perl module / a simple way to wrap methods of an object in a subroutine?

Question

Title;

I have a Perl class, let's call it Foo, and I would like to conditionally and automatically (automatically as in: without changing the implementation of its methods) wrap some of its instances' methods (not the class' methods!) in a subroutine that, on one of the methods' invokation, will do some stuff before calling the target method itself.

Example:

package Foo;

sub new {
    my $self = bless({}, shift);

    my $wrap = shift;

    # I want to conditionally wrap **the blessed reference's**
    # methods here, based on a list of methods names, depending on
    # the value of $wrap; this is done so that the caller can decide
    # whether to wrap its own instance's methods or not, and so
    # that, if it decides to do so, a subroutine will run **before**
    # a method listed in the list of methods is run

    return $self;
}

sub method1 {
    return;
}

sub method2 {
    return;
}

# [...]

The wrapper should have access to the arguments passed by the caller to the target method (such as 'foo' and 'bar' in Foo -> method1('foo', 'bar'))

What I've tried:

• Hook::LexWrap: it works fine, but it can only transparently wrap class methods (not what I want, as wrapping the class' methods defeats the purpose of wrapping only some specific instances' methods); it can wrap anonymous subroutines, however, in that case, it will return a reference to the wrapped subroutine, which defeats the purpose of automatically wrapping the methods;
• Perinci::Sub::Wrapper: I didn't really try this, as it appears to also return a reference to the wrapped subroutine;
• I looked at another module, which I can't recall the name of. That also suffered from one of these two problems.

I'll gladly accept a module suggestion as well as a simple idea on how to implement this myself (just the idea is fine, I should be able to implement it myself as long as I'm pointed in the right direction).

Answer 1

I wrote Wrap::Sub to do this kind of thing:

Package:

package Package;

use warnings;
use strict;

use Wrap::Sub;

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

    my $self = bless { wrap => $wrap }, $class;

    my @to_wrap = qw (
        one
        three
    );

    if ($wrap) {
        my $wrapper = Wrap::Sub->new;

        for (@to_wrap) {
            my $sub = __PACKAGE__ . "::$_";

            $self->{wrapped}{$sub} = $wrapper->wrap(
                $sub,
                pre => sub {
                    my ($self, @params) = @_;
                    if ($self->{wrap}) {
                        print "$Wrap::Sub::name is wrapped!\n";
                        if (@params) {
                            print(join(', ', @params) . "\n");
                        }
                    }
                }
            );
        }
    }

    return $self;
}

sub one {
    print "in sub one\n";
}

sub two {
    print "in sub two\n";
}

sub three {
    print "in sub three\n";
}

1;

Script:

use warnings;
use strict;

use lib '.';

use Package;

my $instance = Package->new(1);

$instance->one;
$instance->two;
$instance->three(1, 2 ,3);

Output:

Package::one is wrapped!
in sub one
in sub two
Package::three is wrapped!
1, 2, 3
in sub three

Answer 2

Since there is no distinction between class and instance methods in perl, you can't modify the behavior of an instance without changing the class at the same time. Possible options are changing the class definition to

• include code in the instances (see answer by @ikegami)
• include state in the instances to execute code conditionally
• add a delegate to the instances (like a logger object) which might be a silent dummy

Another possibility is to rebless the object into a derived class (for only this one instance), that modifies the behavior. This has the advantage, that it works with any existing class/method without changing the original package.

The following example dynamically creates a subclass for the instance passed in, wraps the requested methods and reblesses the instance into that class. The class is removed when the object is destroyed.

While it would be possible to have this wrapper be part of the original class and take a constructor argument,it made more sense to me to have a seperate package for it so it can be applied to any class/method.

MyClass.pm

package MyClass;
use strict;
use warnings;
use v5.032;
sub new{
    return bless {};
}

sub method1 {
   say 'MyClass::method1';
}

sub method2 {
   say 'MyClass::method2';
}
1;

InstanceWrapper.pm:

package InstanceWrapper;
use strict;
use warnings;
use v5.032;
use Scalar::Util 'blessed';
use Sub::Install;
use Symbol 'delete_package';
my $id = 0;

sub wrap{
    shift;
    my $instance = shift;
    my ($wrapped_methods,$coderef) = @_;
    my $wrapped_class = blessed($instance);
    my $classname = sprintf( '%s::%s::%d', $wrapped_class, 'Wrapped', $id++ );
    {
        no strict 'refs';
        @{ "${classname}::ISA" } = $wrapped_class;
    }
    for my $method (@$wrapped_methods){
        my $wrapped_meth = $wrapped_class->can($method);
        Sub::Install::install_sub({
            code => sub{
                say "calling coderef";
                $coderef->(@_);
                say "calling original $method";
                $wrapped_meth->(@_);
            },
            into => $classname,
            as   => $method,
        });
    }
    Sub::Install::install_sub({
         code => sub{
             say "removing package $classname";
             delete_package($classname);
         },
         into => $classname,
         as   => 'DESTROY',
    });
    bless $instance, $classname;
}
1;

test.pl:

use 5.032;
use warnings;
use strict;
use lib '.';
use MyClass;
use InstanceWrapper;
use Data::Dumper;
my $inst = MyClass->new();
my $inst2 = MyClass->new();
my $logger =  sub{say "wrapped call args:\n",Dumper \@_};
InstanceWrapper->wrap($inst, ['method1'],$logger);
$inst->method1('arg');  # wrapped
$inst2->method1('arg'); # not wrapped
InstanceWrapper->wrap($inst2,['method2'],$logger);
$inst->method2;   # not wrapped
undef $inst;      # DESTROY removes symbol table entry for $inst
$inst2->method2;  # wrapped
                  # $inst2 out of scope removes symbol table entry for $inst2

Output:

calling coderef
wrapped call args:
$VAR1 = [
          bless( {}, 'MyClass::Wrapped::0' ),
          'arg'
        ];

calling original method1
MyClass::method1
MyClass::method1
MyClass::method2
removing package MyClass::Wrapped::0
calling coderef
wrapped call args:
$VAR1 = [
          bless( {}, 'MyClass::Wrapped::1' )
        ];

calling original method2
MyClass::method2
removing package MyClass::Wrapped::1

Answer 3

Perl's object system doesn't have instance-specific methods. All methods come from the class, including class methods (Class->foo) and instance methods ($obj->foo).

---

Since you appear to have a fixed list of per-instance methods you want to override, you could use something like the following:

package Foo;

sub new {
   my $class = shift;
   
   my $self = bless( { }, $class );

   $self->{ method1 } = sub { ... };
   $self->{ method2 } = sub { ... };

   return $self;
}

sub method1 { $_[0]{ method1 }->( @_ ) }
sub method2 { $_[0]{ method2 }->( @_ ) }

1