Dynamic Attributes in Perl

August 2, 2013

In Perl, it’s sometimes difficult to ensure that you maintain a propper API contract. Because Perl is a dynamicaly typed language, you can redefine variables on the fly. Sometimes this isn’t a good thing.

There are certain Perl CPAN modules that make attribute definition easy, and I’m not going to touch on those. Instead, I’m going to show how you can roll your own using the AUTOLOAD method, and some meta programming.

package Attributes;

use strict;
use vars '$AUTOLOAD';

use Carp;

our %_attrs = ();

{
    %_attrs = ( 
        _name        => 'read/write',
        _age     => 'read/write',
        _salary      => 'read',
    );

    sub _accessible { 
        my $name = shift;
        exists $_attrs{"_" . $name}; 
    }

    sub _access {
        my $self = shift;
        my $name = shift;
        my $arg = shift;

        if( $arg ){
            unless( $_attrs{"_".$name} =~ /write/ ){
                carp "$name is readonly";
            } else {
                $self->{ $name } = $arg;
            }
        }
        return $self->{$name};
    }
}

sub new {
    my $class = shift;

    my $o = bless { @_ } => $class;

    if( defined( $o->{ATTRIBUTES} ) ){
        use Data::Dumper;
        for my $k ( keys %{$o->{ATTRIBUTES}} ){
            $_attrs{"_".$k} = $o->{ATTRIBUTES}->{$k};
        }
        delete $o->{ATTRIBUTES};
    }
    return $o;
}

sub AUTOLOAD {
    my ($self) = shift;
    
    $AUTOLOAD =~ s/.*::(.*)/$1/;
    
    #print "Calling $AUTOLOAD\n";
    
    if( _accessible($AUTOLOAD) ){
        #print "Accessing $AUTOLOAD\n";
    
        _access( $self, $AUTOLOAD, @_ );
    } else {
        carp "Cannot access $AUTOLOAD"
            unless $AUTOLOAD eq 'DESTROY';
    }
}

1;

This can be used thus:

#!/usr/bin/perl
use strict;
use lib '.';
use Attributes;

my $o = Attributes->new( name => 'Peter', age => 32, salary => 10,
    ATTRIBUTES => { salary => 'read/write' },
);

printf "Name is %s\n", $o->name;
printf "Age is %s\n", $o->age;
printf "Salary is %s\n", $o->salary;

# Lets change the salary
print "Doubling our salary.. heheheh..\n";
$o->salary( $o->salary * 2 );

use Data::Dumper;
print Dumper( $o ),"\n";

When we execute it, we see:

$ perl test-att.pl
Name is Peter
Age is 32
Salary is 10
Doubling our salary.. heheheh..
$VAR1 = bless( {
                 'name' => 'Peter',
                 'age' => 32,
                 'salary' => 20
               }, 'Attributes' );

We see that the salary attribute was doubled. This is contradictory to the class definition:

%_attrs = (
   _name    => 'read/write',
   _age     => 'read/write',
   _salary  => 'read',
);

Why? Because in the object instantiation, we override the ATTRIBUTES named variable which will then be used by the constructor to override the read/write attributes. Let’s re-run our example, but this time we instantiate it as:

my $o = Attributes->new( name => 'Peter', age => 32, salary => 10,
    #ATTRIBUTES => { salary => 'read/write' },
)
$ perl test-att.pl 
Name is Peter
Age is 32
Salary is 10
Doubling our salary.. heheheh..
salary is readonly at test-att.pl line 16.
$VAR1 = bless( {
                 'name' => 'Peter',
                 'age' => 32,
                 'salary' => 10
               }, 'Attributes' );

We see that: salary is readonly at test-att.pl line 16. gives us a warning, that we’re trying to mutate a read-only variable. And the final objects attributes show that the modification did not take place.

But, how is this working? First, the Perl interpreter receives a method call on the instantiated object, and it inspects that object’s method list. If it cannot find an existing method name, then Perl calls the AUTOLOAD method. Within our AUTOLOAD definition, we strip the package name off of the method call, and pass the name to the accessible function. This checks a map for a list of attribute names and read/write permissions. If no attribute is defined, then a error will be thrown. If the attribute has been defined, a call to the access function is called. If the string “write” was not set in the permissions flag, then a warning is thrown indicating that it cannot be modified.

Discussion, links, and tweets

Follow me on Twitter