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 =~ /(getset)(_\w+)$/);          # Is this a legal method name?     unless($operation && $attribute) {         croak "Method name $AUTOLOAD is not in the recognized form (getset)_ 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