The 2002 Perl Advent Calendar
[about] | [archives] | [contact] | [home]

On the 20th day of Advent my True Language brought to me..
Class::Data::Inheritable

Perl programmers are fully familiar with the idea of method inheritance. When I create a method in a class I know that any class that subclasses that class will also get that method. So if my hypothetical Car class has a drive method then I know my subclasses Car::Saloon and Car::Hatchback will get this method too. I also know if it's not suitable any more - for example in the subclass Car::Aquacar I can override it and define a new one without effecting any of the other Car classes that don't inherit from that class itself.

Compare this to class data in Perl. In Perl class data (data that is available to all objects of a class) is commonly stored simply in package variables. These values aren't automatically inherited by the subclasses (you need to remember which class they're defined in) and if you change these values you find it's not possible to change them just for some subclasses - you have to change them for all classes everywhere.

In his book, Object Oriented Perl, Damian Conway developed a set of techniques that allow you to create proper class variables that are inherited and can be overridden on a per subclass bases. This module represents the packaged version of these techniques and abstracts away the technical details.

In order to demonstrate this I'm going to create a class that creates people to use in a TV show. I want to have default values for all the people's attributes which all new instances of the people are initialised from. It's important that I be able to change these defaults at run time to alter the way all new people are created. In short, I need these default values to be stored in class variables.

  package Person;
  use base qw(Class::Data::Inheritable);
  # turn on Perl's safety features
  use strict;
  use warnings;
  # by default people are male and blond
  Person->mk_classdata('default_gender', "male");
  Person->mk_classdata('default_hair'  , "blonde");
  # declare a class variable, but give it no value
  Person->mk_classdata("default_type");

In order to use Class::Data::Inheritable in a class you must make it a base class of that class. Once you've done that you can call the mk_classdata method to creates a new class variable in that class. Accessor methods for that class variable are automatically created so now we can, from anywhere in any program, access the variable.

   # get it
   print Person->default_age;
   # change it to a new value
   print Person->default_age(42);

Now we need to create the rest of the class. First up a constructor that defines the object based on what the class variables were set to at the time the constructor was called.

  # the constructor
  sub new
  {
    my $class = shift;
    my $self  = bless {}, $class;
    # set the default values
    $self->gender($class->default_gender);
    $self->hair($class->default_hair);
    $self->type($class->default_type);
    return $self
  }

Now we just need to create a set of accessors that access the values stored in the current object, so we don't have to access the hash directly.

  # Standard get/set accessors.  Calling any one of these
  # with no parameters will just return the current value.
  # Calling with an argument will set the value.
  sub gender
  {
     my $this = shift;
     $this->{gender} = shift if @_;
     return $this->{gender};
  }
  sub hair
  {
     my $this = shift;
     $this->{hair} = shift if @_;
     return $this->{hair};
  }
  sub type
  {
     my $this = shift;
     $this->{type} = shift if @_;
     return $this->{type};
  }

Okay, so let's look what we can do with this object. To do this we'll use a simple test script to check that things are what we expect them to be. Writing tests for your code is a good habit to get into as it enables you to quickly check everything is as it's meant to be.

Right, first up, let's check whenever we create a Person that we get a object of the Person class back again

  #!/usr/bin/perl
  use strict;
  use warnings;
  use Test::More tests => 8;
  use Person;
  my $person = Person->new();
  isa_ok($person, "Person");
  is($person->gender, "male",   "default gender");
  is($person->hair,   "blonde", "default hair");
  is($person->type,   undef,    "default type");

And we should also check that we can change values:

  # So we can set particular things for people
  $person->hair("red");
  is($person->hair, "red", "person is a redhead");

And if we create a new person, then that person is initialised from the default values, not from what we just set:

  # but that doesn't affect anyone else, the defaults still hold
  my $person2 = Person->new();
  is($person2->hair, "blonde", "person is blonde");

Ah, now the cunning bit. Say we decide we want all people created from now on to be evil by default (say we're creating the bad guys.) This can be done by setting the class variable.

  # set all people to be evil by default from now on
  Person->default_type("evil");
  # check that worked
  my $baddie = Person->new();
  is($baddie->age, "evil", "new default type");

The Clever Bit

The clever bit is when we come round to declaring a subclass of Person, which of course will be the Slayer subclass (oooh, look another Buffy example - how unoriginal.) We create the subclass of Person and change a few of the default values and add another class variable.

  package Slayer;
  use base qw(Person);
  # turn on Perl's safety features
  use strict;
  use warnings;
  # change some of the defaults existing defaults
  Slayer->default_gender("female");  # all slayers are female
  Slayer->default_type("good");      # and start out good anyway
  # and add a new one
  Slayer->mk_classdata("default_skills",["bantering"]);

Note how we say Slayer->default_gender("female") not Person->default_gender("female"). This is because we want to change the defaults only for Slayers not for Persons.

  is(Slayer->default_gender, "female", "slayer's default's female");
  is(Person->default_gender, "male",   "person's default's still male");

What about the other variables? Well, they're inherited. This means if we were to check it we'd find that calling Slayer->default_hair would return blonde as we haven't overridden that value by setting a value by calling Slayer, so we get the value directly from Person instead.

Now all that's left to do is create the constructor and the accessor method for the new attribute, which will launch us off on a quick diversion.

  use Storable qw(dclone);
  # new constructor
  sub new
  {
    my $class = shift;
    # call our parent's new method
    my $this = $class->SUPER::new(@_);
    # then add in our skills
    $this->skills(dclone $class->default_skills);
    # return the object
    return $this;
  }

There's a couple of things worth noting here as an aside that you might potentially not be familiar with. First we're chaining our constructor. By this I mean we're using the $class->SUPER::new(@_) call to create our object. This call will call our superclass's, that is to say Person's, new method, but as we're calling it on $class the returning object will be blessed into Slayer not Person. We get the object modify it slightly before returning it just as if we'd created it ourselves from scratch.

The other thing that's worth noting is that we use Storable's dclone method to copy the default skill. dclone can be used to copy an entire data structure where = won't do. To see why this is necessary consider the following data structure.

  # create a data structure
  my %original = ( 
                   foo => [ "bar", "baz" ]
                 );
  # 'copy' it
  my %copy = %original;
  # add something to the inner list in the original data structure
  $original{foo}[2] = "buzz";
  use Data::Dumper;
  print Dumper \%copy;

This prints out

  $VAR1 = {
            'foo' => [
                       'bar',
                       'baz',
                       'buzz'
                     ]
          };

As even though the = copied the top level hash, it only copied the reference to the array - in both cases both $copy and $original's foo key points to the same array in memory. In order to copy the array properly so that the contents of the array are duplicated we need to use dclone.

Okay, back to the discussion of the module de jour. I think all that's needed is a quick summary to conclude. We've seen how we can have data inheritance that works the same as method inheritance. Whenever we want to create a set of data that can be accessed by all objects of a class we create a class variable with mk_classdata. From this point on, all objects can access this data by calling the method that's named the same as the variable on the object. For example, both Slayer and Person objects can read hair colour.

When we set a class variable it's set for all that class and all classes that subclass from it unless something has explicitly set that value to something different in one of the subclasses. So when we change the default hair colour in Person, it'll be set for Slayer too. However, if there is an explicit override in Slayer (like there is for the default type) changing the default type in Person will have no affect on new Slayer objects created. Setting the default type to evil for people does not effect the newly created slayers.

It all works pretty much as you expect, once you've got your head around it, which is to say the same as method inheritance.

  • Object Oriented Perl