3.8 Gene3.pm: A Third Example of a Perl Class

We've gone through two iterations building an OO class with the Gene1.pm and Gene2.pm modules. Now, let's add a few more features and create the Gene3.pm module as a penultimate example for this introduction to OO programming in Perl.

Here is the code for Gene3.pm and for the test program testGene3; also included is the output produced by running testGene3. Following the code will be a discussion of the new features of this third version of our example class. But I'll point out before you read on, that AUTOLOAD is a special name in Perl for a subroutine that will handle a call to any undefined subroutine in a class. (I'll give more details after you look at the code.)

package Gene3;

#
# A third version of the Gene.pm module
#

use strict;
use warnings;
our $AUTOLOAD; # before Perl 5.6.0 say "use vars '$AUTOLOAD';"
use Carp;

# Class data and methods, that refer to the collection of all objects
# in the class, not just one specific object
{
    my $_count = 0;
    sub get_count {
        $_count;
    }
    sub _incr_count {
        ++$_count;
    }
    sub _decr_count {
        --$_count;
    }
}

# The constructor for the class
sub new {
    my ($class, %arg) = @_;
    my $self = bless {
        _name        => $arg{name}      || croak("Error: no name"),
        _organism    => $arg{organism}  || croak("Error: no organism"),
        _chromosome  => $arg{chromosome}|| "????",
        _pdbref      => $arg{pdbref}    || "????",
        _author      => $arg{author}    || "????",
        _date        => $arg{date}      || "????",
    }, $class;
    $class->_incr_count(  );
    return $self;
}

# This takes the place of such accessor definitions as:
#  sub get_attribute { ... }
# and of such mutator definitions as:
#  sub set_attribute { ... }
sub AUTOLOAD {
    my ($self, $newvalue) = @_;

    my ($operation, $attribute) = ($AUTOLOAD =~ /(get|set)(_\w+)$/);
    
    # Is this a legal method name?
    unless($operation && $attribute) {
        croak "Method name $AUTOLOAD is not in the recognized form (get|set)_
attribute\n";
    }
    unless(exists $self->{$attribute}) {
        croak "No such attribute '$attribute' exists in the class ", ref($self);
    }

    # Turn off strict references to enable "magic" AUTOLOAD speedup
    no strict 'refs';

    # AUTOLOAD accessors
    if($operation eq 'get') {
        # define subroutine
        *{$AUTOLOAD} = sub { shift->{$attribute} };

    # AUTOLOAD mutators
    }elsif($operation eq 'set') {
        # define subroutine
        *{$AUTOLOAD} = sub { shift->{$attribute} = shift; };

        # set the new attribute value
        $self->{$attribute} = $newvalue;
    }

    # Turn strict references back on
    use strict 'refs';

    # return the attribute value
    return $self->{$attribute};
}

# When an object is no longer being used, this will be automatically called
# and will adjust the count of existing objects
sub DESTROY {
    my($self) = @_;
    $self->_decr_count(  );
}

# Other methods.  They do not fall into the same form as the majority handled by 
AUTOLOAD
# This is an example of a method that is both accessor and mutator, depending on the
# number of arguments provided to it.
sub citation {
    my ($self, $author, $date) = @_;
    $self->{_author} = set_author($author) if $author;
    $self->{_date} = set_date($date) if $date;
    return ($self->{_author}, $self->{_date})
}

1;

3.8.1 Testing Gene3.pm

Here is the test program testGene3 for the Gene3.pm class:

#!/usr/bin/perl

#
# Test the third version of the Gene module
#

use strict;
use warnings;

# Change this line to show the folder where you store Gene.pm
use lib "/home/tisdall/MasteringPerlBio/development/lib";
use Gene3;

print "Object 1:\n\n";

# Create first object
my $obj1 = Gene3->new(
        name            => "Aging",
        organism        => "Homo sapiens",
        chromosome      => "23",
        pdbref          => "pdb9999.ent"
); 

# Print the attributes of the first object
print $obj1->get_name, "\n";
print $obj1->get_organism, "\n";
print $obj1->get_chromosome, "\n";
print $obj1->get_pdbref, "\n";
# Test AUTOLOAD failure: try uncommenting one or both of these lines
#print $obj1->get_exon, "\n";
#print $obj1->getexon, "\n";

print "\n\nObject 2:\n\n";

# Create second object
my $obj2 = Gene3->new(
        organism        => "Homo sapiens",
        name            => "Aging",
); 

# Print the attributes of the second object ... some will be unset
print $obj2->get_name, "\n";
print $obj2->get_organism, "\n";
print $obj2->get_chromosome, "\n";
print $obj2->get_pdbref, "\n";

# Reset some of the attributes of the second object
$obj2->set_name("RapidAging");
$obj2->set_chromosome("22q");
$obj2->set_pdbref("pdf9876.ref");
$obj2->set_author("D. Enay");
$obj2->set_date("February 9, 1952");

print "\n\n";

# Print the reset attributes of the second object
print $obj2->get_name, "\n";
print $obj2->get_organism, "\n";
print $obj2->get_chromosome, "\n";
print $obj2->get_pdbref, "\n";
print $obj2->citation, "\n";

# Use a class method to report on a statistic about all existing objects
print "\nCount is ", Gene3->get_count, "\n\n";

print "\n\nObject 3:\n\n";

# Create a third object: but this fails
#  because the "name" value is required (see Gene.pm)
my $obj3 = Gene3->new(
        organism        => "Homo sapiens",
        chromosome      => "23",
        pdbref          => "pdb9999.ent"
); 

# This line is not reached due to the fatal failure to
#  create the third object
print "\nCount is ", Gene3->get_count, "\n\n";

Finally, here is the output from running the test program testGene3:

Object 1:

Aging
Homo sapiens
23
pdb9999.ent

Object 2:

Aging
Homo sapiens
????
????

RapidAging
Homo sapiens
22q
pdf9876.ref
D. EnayFebruary 9, 1952

Count is 2

Object 3:

Error: no name at testGene3 line 70