Fixing Legacy Perl Functions With Decorators

in perl

Function decorators give us a way to modify a function's behaviour without changing its source. This is useful in changing the behaviour of complex or legacy functions that you don't want to touch.

Although perl does not have a built-in syntax for creating or using decorators, typeglob manipulations are used to easily fill the gap.

Reasons To Decorate

Take the following implementation for fibonacci calculating function:

sub fib {
    my ($n) = @_;
    print "DEBUG - calculating fib($n)\n";
    $n < 2 ? 1 : fib($n-1) + fib($n-2)
}

It's simple but problematic: To calculate fib(10) you'll first need to calculate fib(9) and fib(8). But fib(9) will also calculate fib(8) which repeats the calculation unnecessarily.

When running the above code for example on fib(5) we get the following output:

DEBUG - calculating fib(5)
DEBUG - calculating fib(4)
DEBUG - calculating fib(3)
DEBUG - calculating fib(2)
DEBUG - calculating fib(1)
DEBUG - calculating fib(0)
DEBUG - calculating fib(1)
DEBUG - calculating fib(2)
DEBUG - calculating fib(1)
DEBUG - calculating fib(0)
DEBUG - calculating fib(3)
DEBUG - calculating fib(2)
DEBUG - calculating fib(1)
DEBUG - calculating fib(0)
DEBUG - calculating fib(1)

It's easy to see fib(3) is calculated twice.

One way to fix our above implementation is to add a state hash variable that'll hold all previous calculations that were already performed, and skip calculation for known values. Decorators will give us a way to "inject" the described functionality to the function without changing its source code.

Our First Decorator: Log Inputs and Output

A decorator is a higher order function which takes a function and returns a new one with some modified behaviour. Let's start with a simple example that just adds a debug print before and after calling the function.

The decorator code itself to add log messages would look something like this:

sub logged {
  my ($f) = @_;
  return sub {
    warn "Calling function with: @_";
    my $res = $f->(@_);
    warn "Got: $res";

    $res;
  }
}

It's a function that takes another function as its first argument and returns a new implementation which uses the original function but adds some new functionality around it.

We'll use logged in the following way:

sub twice { $_[0] * 2 }

sub logged {
  my ($f) = @_;
  return sub {
    warn "Calling function with: @_";
    my $res = $f->(@_);
    warn "Got: $res";

    $res;
  }
}

my $loggedTwice = logged(\&twice);
say $loggedTwice->(10);

Which prints:

Calling function with: 10 at a.pl line 14.
Got: 20 at a.pl line 16.
20

A Second Example: Call Count

Higher order functions can also save data in a special way. Every variable defined inside the external (higher order function) but above the internal result function will maintain its value between invocations of the internal function.

This allows us to add memory to our decorated function. The following decorator prints how many times a function was called before calling it:

sub twice { $_[0] * 2 }

sub counted {
  my ($f) = @_;
  my $counter = 0;
  return sub {
    $counter++;
    warn "Function was called $counter times";    
    $f->(@_);
  }
}

my $countedTwice = counted(\&twice);
say $countedTwice->(10);
say $countedTwice->(10);
say $countedTwice->(10);

And the output:

Function was called 1 times at a.pl line 16.
20
Function was called 2 times at a.pl line 16.
20
Function was called 3 times at a.pl line 16.
20

Of course we can combine the two decorators to get both call count and log:

my $loggedTwice = counted(logged(\&twice));
say $loggedTwice->(10);
say $loggedTwice->(20);

And get the output:

Function was called 1 times at a.pl line 16.
Calling function with: 10 at a.pl line 30.
Got: 20 at a.pl line 32.
20
Function was called 2 times at a.pl line 16.
Calling function with: 20 at a.pl line 30.
Got: 40 at a.pl line 32.
40

Installing The Decorator

So far we were able to use higher order functions to modify behaviour or existing functions, but we always had to call the newly created function by reference. I think that felt a bit odd.

Luckily perl lets us modify the package's symbol table by using typeglobs, so this code works:

*{main::twice} = logged(\&twice);
say twice(10);

Or for a more generic version which installs the decorator into the current package:

no strict 'refs';
*{__PACKAGE__."::twice"} = logged(\&twice);
say twice(10);

Either way after manipulating the symbol table calling twice invokes our logged(\&twice) version.

Utility Function: Decorate

Not everyone's a fan of symbol table manipulations. The following utility function can make installing decorators feel a bit nicer:

sub decorate {
  my ($name, @decorators) = @_;
  no strict 'refs';
  my $f = *{"$name"}{CODE};

  foreach my $hof (@decorators) {
    $f = $hof->($f);
  }

  *{"$name"} = $f;
}

And as a bonus it also allows using multiple decorators. Here's a sample usage:

decorate('main::twice', \&counted, \&logged);
twice(5);

Back To Fixing Fib

I belive now we're ready to fix our broken fib function using a decorator. The decorator is called memoize and its job is to remember past invocations and results, and if a function is called for a second time with the same input, the value is fetched from memory. This saves fib the need to perform the same calculations over and over again.

sub memoize {
  my ($f) = @_;
  my %mem;

  return sub {
    my ($n) = @_;
    $mem{$n} //= $f->($n);
  };
}

Applying the decorator and calling fib:

decorate('main::fib', \&memoize);
fib(5);

And we get the much shorter output:

DEBUG - calculating fib(5)
DEBUG - calculating fib(4)
DEBUG - calculating fib(3)
DEBUG - calculating fib(2)
DEBUG - calculating fib(1)
DEBUG - calculating fib(0)

Caveats

Decorators are a great pattern to have in your toolbox. When writing this post I skipped some issues that may be of importance in your code:

  1. When calling a decorated function we change its context. In the general case you probably want to use wantarray.
  2. Decorators may add metadata to functions (for example call count). Unfortunately perl offers no good place to store this data. The best I found was to add a new function to the symbol table that fetches this data. Better ideas are welcomed.
  3. Symbol table manipulation in perl may be a bit slow. If that's a problem to you it may be a good idea to implement decorate as XS.

Comments