Many objects use accessors and mutators to provide restricted access to otherwise private data. In Perl, the accessors and mutators are often combined into a single method, like this:

sub foo 
{
    my $self = shift;
    $self->{foo} = shift if @_;
    return $self->{foo};
}
[download]

90% of the time, the code for each accessor/mutator is identical to all other accessors/mutators, except for the name of the field. In Perl, there is a shortcut we can use involving closures to generate the accessors/mutators (this snippet is a trimmed-down version of the one on pp. 338-339 of the Blue Camel):

for my $field (qw(name race aliases)) {
    my $slot = __PACKAGE__ . "::$field";
    no strict "refs";   # So symbolic ref to typeglob works
    *$field = sub {
        my $self = shift;
        $self->{$slot} = shift if @_;
        return $self->{$slot};
    };
}
[download]

That is cool enough, and cuts out a lot of redundant code. Once I finally understood what was going on here, I was awestruck.

Let's move into a working application of the above:

#!/usr/bin/perl
use strict;
use warnings;



package Foo;

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

    $self->{baz} = 1;
    $self->{bah} = 2;
    
    return $self;
}

sub baz 
{
    die "baz() not overriden\n";
}

sub bah 
{
    die "bah() not overriden\n";
}


package Bar;

our @ISA = qw(Foo);

for my $field (qw(baz bah)) {
    my $slot = __PACKAGE__ . "::$field";
    no strict 'refs';  # Need symbolic refs to typeglob

    *$field = sub {
        my $self = shift;
        $self->{$slot} = shift if @_;
        return $self->{$slot};
    };
}


package main;

my $obj = Bar->new();

print "Baz: ", $obj->baz, "\n";
print "Bah: ", $obj->bah, "\n";
[download]

Run that, and you'll see it print out:

Baz: 1
Bah: 2
[download]

Now remove the 'bah' on line 37 from the list. It will now die when it calls $obj->bah.

Now for the dangerous part. Using closures, we can create and destroy methods at runtime whenever we feel like it.

#!/usr/bin/perl
use strict;
use warnings;



package Foo;

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

    $self->{baz} = 1;
    $self->{bah} = 2;
    
    return $self;
}

sub baz 
{
    die "baz() not overriden\n";
}

sub bah 
{
    die "bah() not overriden\n";
}


package Bar;

our @ISA = qw(Foo);
my @DYNAMIC_METHODS = qw(faz);

sub make_methods 
{
    for my $field (@DYNAMIC_METHODS) {
        my $slot = __PACKAGE__ . "::$field";
        no strict 'refs';
    
        *$field = sub {
            print "Called faz\n";
        };
    }
}

sub destroy_methods 
{
    for my $field (@DYNAMIC_METHODS) {
        my $slot = __PACKAGE__ . "::$field";
        no strict 'refs';

        undef *$field;
    }
}

for my $field (qw(baz bah)) {
    my $slot = __PACKAGE__ . "::$field";
    no strict 'refs';  # Need symbolic refs to typeglob

    *$field = sub {
        my $self = shift;
        $self->{$slot} = shift if @_;
        return $self->{$slot};
    };
}


package main;

my $obj = Bar->new();

print "Baz: ", $obj->baz, "\n";
print "Bah: ", $obj->bah, "\n";

$obj->make_methods();
$obj->faz();
$obj->destroy_methods();
$obj->faz();
[download]

The second call to $obj->faz() will fail. Crazy, no?

Update: Fixed bug in the example closure where $fields and $slot were in the wrong places (thanks to djantzen for pointing this out).