April 2017 Archives

Golang's 'defer' in Perl

My day job involves programming in Go. One feature I like about Go is "defer". Any function that's deferred gets ran at the end of the functions scope. As a very simple example, the program below prints

hello
world

instead of the other way around, because "world" is deferred until the main() function exits.

package main
import "fmt"

func main() {
    defer fmt.Println("world")
    fmt.Println("hello")
}

I find this cleaner: you can write clean-up closer to where you allocate/acquire resources, instead of remembering to do it at the end of your function. In order to do this in perl, I created a defer() function which, given a subref, returns a wrapper subref blessed into a dummy package. Then, I give that dummy package a destructor (DESTROY) which calls itself. The result is that the subroutine given will be run when the variable it is assigned to goes out of scope:

use v5.10.1;
use strict;
use warnings FATAL => "all";

sub defer{
    my ($sub) = @_;
    my $pid = $$;
    return bless sub {
        # I check that I'm running in the process that I called defer() in,
        # because I don't want child processes to call $sub->();
        if ($$ == $pid) { 
            $sub->();
        }
    }, 'my_deferer_dummy_package';
}

sub my_deferer_dummy_package::DESTROY {
    my ($self) = @_;
    $self->();
}

To give a simple usage example, we create a function which opens a file and defers it's close()ing:

sub upper_caser {
    my $file = shift;

    open my $fh, '<:crlf', $file;
    my $defered = defer sub { 
        say "defer function called!";
        close $fh;
    };

    while (defined(my $line = <$fh>)){
        chomp $line;
        say uc $line;
    }
}

there's a file called "test.txt" containing the lines:

just
another
perl
hacker

Now, calling the function,

upper_caser "test.txt";

it yields:

# JUST
# ANOTHER
# PERL
# HACKER
# defer function called!

I also found this very useful in functional programming, when I want to return an iterator subroutine, but also clean-up after it when it is no longer needed:

sub make_upper_caser_iterator {
    my $file = shift;

    open my $fh, '<:crlf', $file;
    my $defered = defer sub { 
        say "defer function in closure called!";
        close $fh;
    };

    return sub{
        # make sure that the closure captures $defered 
        # and keeps it alive as long as this closure is.
        my $defered = $defered;

        if (defined(my $line = <$fh>)){
            chomp $line;
            return $line;
        }
        return;
    };
}

my $iter = make_upper_caser_iterator "test.txt";
while (defined(my $line = $iter->())){
    say uc $line;
}

As expected, the above use of the iterator yields:

JUST
ANOTHER
PERL
HACKER
defer function in closure called!

A very simple LRU cache with Tie::IxHash

Recently, I needed to add a simple cache to my application. In particular, I was looking for a way to memo-ize a function, and age out old entries as necessary. There's great cache modules on CPAN that do this, but I needed to accomplish it with only standard modules.

In order to create a very dumb Least-Recently-Used cache, you need a list and a hash. The hash obviously stores mapping from keys to values, and the list keeps the order of items in the most recently-used order. When an existing item is modified or retrieved, its key moves to the end of the list. When an insertion is made that would overflow the size limit of the cache, entries from the front of the list are removed. Note that the implementation below would only work for string keys (and things that are convertible to strings, like intergers, since perl hash keys are stringified), but it shouldn't be too hard to modify to handle arbitrary objects.

Fortunately, there's a standard module called Tie::IxHash which makes this trivial to implement. Tie::IxHash, when tied to an ordinary perl hash, will make its keys ordered! Here's what it looks like:

use v5.10.1;
use strict;
use warnings;
use Data::Dumper;

use Tie::IxHash;

my $size_limit = 10;

# %lru keys are now ordered, so 'each' and 'keys' will return the keys 
# in the order they were added.
tie my %lru, 'Tie::IxHash'; 

sub set {
    my ($lru, $k, $v) = @_;

    if (exists $lru->{$k}) {
        delete $lru->{$k};
    }

    # $k now is the last item.
    $lru->{$k} = $v;

    # note: the 'keys' call in the conditional resets the 'each' iterator
    while (keys %$lru > $size_limit) {
        # in scalar context, each returns the key. for a IxHash, it returns them in order added.
        my $oldest = each %$lru; 
        delete $lru->{$oldest};
    }
}

sub get {
    my ($lru, $k) = @_;

    if (exists $lru->{$k}) {
        my $v = delete $lru->{$k};
        # $k now is the last item.
        $lru->{$k} = $v;
        return $v;
    }
    return;
}

We test it out by setting 10 kv-pairs, filling up the cache.

set \%lru, 1, "one";
set \%lru, 2, "two";
set \%lru, 3, "three";
set \%lru, 4, "four";
set \%lru, 5, "five";
set \%lru, 6, "six";
set \%lru, 7, "seven";
set \%lru, 8, "eight";
set \%lru, 9, "nine";
set \%lru, 10, "ten";

say Dumper \%lru;

# $VAR1 = {
#           '1' => 'one',
#           '2' => 'two',
#           '3' => 'three',
#           '4' => 'four',
#           '5' => 'five',
#           '6' => 'six',
#           '7' => 'seven',
#           '8' => 'eight',
#           '9' => 'nine',
#           '10' => 'ten'
#         };

Note that thanks to Tie::IxHash, Data::Dumper dumps the hash in key-order. Next, we reset some of the keys:

set \%lru, 2, "TWO";
set \%lru, 4, "FOUR";
set \%lru, 4, "FOUR";
set \%lru, 5, "FIVE";
set \%lru, 11, "ELEVEN";

say Dumper \%lru;

# $VAR1 = {
#           '3' => 'three',
#           '6' => 'six',
#           '7' => 'seven',
#           '8' => 'eight',
#           '9' => 'nine',
#           '10' => 'ten',
#           '2' => 'TWO',
#           '4' => 'FOUR',
#           '5' => 'FIVE',
#           '11' => 'ELEVEN',
#         };

Notice that 2, 4, and 5 values have been updated and moved to the end of the key list (the most recently used), and the "1" entry has been removed because it was at the beginning of the list.

About tnish

user-pic I do security research and hacking at a anti-spam company in SF, mostly in Perl and Go. Formerly worked in computational genomics/bioinformatics.