Perl - call an instance of a class

Question

Is there way to catch the event of calling an instance of a Perl class?

my $obj = ExampleClass->new();
$obj(); # do something without producing error

I would like to be able to handle this from within the class/module definition. Something similar to the __call__ method in Python, or the __call metamethod in Lua.

Answer 1

What you're looking for is called a functor. You can create a base class to implement your functors more easily. For instance:

package AbstractFunctorObject;
use strict;
use warnings;
use overload '&{}' => sub { $_[0]->can( '__invoke' ) };

sub new
{
  my $class = shift;
  bless { @_ }, $class;
}

1;
__END__

Then, you can implement your functors as follows:

package FunctorObject;
use strict;
use warnings;
use parent 'AbstractFunctorObject';

sub __invoke
{
  print "Called as a functor with args: @{ [ @_ ? @_ : 'no argument given' ] }\n";
}

1;
__END__

And finally, you can call the functor as follows:

package main;
use FunctorObject;

my $functor = FunctorObject->new();
$functor->('firstname', 'lastname');
$functor->();

Result will be:

root@jessie:/usr/local/src# perl callable_object.pl 
Called as a functor with args: firstname lastname
Called as a functor with args: no argument given

Answer 2

I'm still not sure what the use case is, but you can overload the class to handle code dereferencing.

package ExampleClass;
use overload '&{}' => \&__call__;   # Or an anon sub.
sub new {
   bless {@_}, shift;
}
sub __call__ {
    sub { warn "calling an instance event" };
}

package main;
my $obj = ExampleClass->new;
$obj->();
&$obj();      # same as $obj->()

Typical output:

$ perl 44956235.pl
calling an instance event at 44956235.pl line 7.
calling an instance event at 44956235.pl line 7.

Answer 3

Overloading "&{}" is obviously the way to go, but you could base your object on a sub instead of the commonly-preferred hash.

ExampleClass.pm:

package ExampleClass;

use strict;
use warnings;
use feature qw( current_sub say );

my %objects;

sub new {
   my $class = shift;
   my $dummy;  # Force each evaluation of sub{} to return a new variable.
   my $self = bless(sub { $dummy if 0; __SUB__ ->__call__(@_) }, $class) }, $class);
   my $inner = $objects{$self} = {};
   return $self;
}

sub DESTROY {
   my $self = shift;
   delete($objects{$self});
}

sub __call__ {
   my $inner = $objects{ my $self = shift };
   say "__call__(".join(", ", @_).")";
}

sub some_attribute {
   my $inner = $objects{ my $self = shift };
   if (@_) { $inner->{some_attribute} = $_[0]; }
   return $inner->{some_attribute};
}

1;

The main program:

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

use ExampleClass qw( );

{
   my $obj = ExampleClass->new();

   $obj->some_attribute("value");
   say $obj->some_attribute();

   $obj->(qw( a b c ));
}

{
   my $obj1 = ExampleClass->new();
   $obj1->some_attribute("value1");

   my $obj2 = ExampleClass->new();
   $obj2->some_attribute("value2");

   say $obj1->some_attribute();
   say $obj2->some_attribute();
}

Output:

value
__call__(a, b, c)
value1
value2

This is basically what's called an "inside-out" object.