Aggregation

Suppose you later want to change the class to implement better names. Perhaps you'd like to support both given names (called Christian names, irrespective of one's religion) and family names (called surnames), plus nicknames and titles. If users of your Person class have been properly accessing it through its documented interface, then you can easily change the underlying implementation. If they haven't, then they lose and it's their fault for breaking the contract and voiding their warranty.

To do this, we'll make another class, this one called Fullname. What's the Fullname class look like? To answer that question, you have to first figure out how you want to use it. How about we use it this way: 

    $him = Person->new();
    $him->fullname->title("St");
    $him->fullname->christian("Thomas");
    $him->fullname->surname("Aquinas");
    $him->fullname->nickname("Tommy");
    printf "His normal name is %s\n", $him->name;
    printf "But his real name is %s\n", $him->fullname->as_string;

Ok. To do this, we'll change Person::new() so that it supports a full name field this way: 

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        $self->{FULLNAME} = Fullname->new();
        $self->{AGE}      = undef;
        $self->{PEERS}    = [];
        $self->{"_CENSUS"} = \$Census;
        bless ($self, $class);
        ++ ${ $self->{"_CENSUS"} };
        return $self;
    }


    sub fullname {
        my $self = shift;
        return $self->{FULLNAME};
    }

Then to support old code, define Person::name() this way: 

    sub name {
        my $self = shift;
        return $self->{FULLNAME}->nickname(@_)
          ||   $self->{FULLNAME}->christian(@_);
    }

Here's the Fullname class. We'll use the same technique of using a hash reference to hold data fields, and methods by the appropriate name to access them: 

    package Fullname;
    use strict;


    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {
            TITLE       => undef,
            CHRISTIAN   => undef,
            SURNAME     => undef,
            NICK        => undef,
        };
        bless ($self, $class);
        return $self;
    }


    sub christian {
        my $self = shift;
        if (@_) { $self->{CHRISTIAN} = shift }
        return $self->{CHRISTIAN};
    }


    sub surname {
        my $self = shift;
        if (@_) { $self->{SURNAME} = shift }
        return $self->{SURNAME};
    }


    sub nickname {
        my $self = shift;
        if (@_) { $self->{NICK} = shift }
        return $self->{NICK};
    }


    sub title {
        my $self = shift;
        if (@_) { $self->{TITLE} = shift }
        return $self->{TITLE};
    }


    sub as_string {
        my $self = shift;
        my $name = join(" ", @$self{'CHRISTIAN', 'SURNAME'});
        if ($self->{TITLE}) {
            $name = $self->{TITLE} . " " . $name;
        }
        return $name;
    }


    1;

Finally, here's the test program: 

    #!/usr/bin/perl -w
    use strict;
    use Person;
    sub END { show_census() }


    sub show_census ()  {
        printf "Current population: %d\n", Person->population;
    }


    Person->debug(1);


    show_census();


    my $him = Person->new();


    $him->fullname->christian("Thomas");
    $him->fullname->surname("Aquinas");
    $him->fullname->nickname("Tommy");
    $him->fullname->title("St");
    $him->age(1);


    printf "%s is really %s.\n", $him->name, $him->fullname;
    printf "%s's age: %d.\n", $him->name, $him->age;
    $him->happy_birthday;
    printf "%s's age: %d.\n", $him->name, $him->age;


    show_census();