Mastering Perl for Bioinformatics [Electronic resources] نسخه متنی

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