I am trying to build an inheritable object, and I am using examples from
the Perl Cookbook, 2nd edition, mostly Recipe 13.1, using the new and
_init methods.
I created a base class Logon and a subclass called DBLogon, in files
Logon.pm and DBLogon.pm, respectively. All referenced files are copied
below. I can create a Logon object and print its contents with no
problem (see test program testlogon.pl). However, my subclass is not
working. According to Recipe 13.1 in the cookbook, have an _init()
function called by new() can make the class more inheritable ("separate
the memory allocation and blessing step from the instance data
initialization step", p. 507-508).
When I try to assign values to the DBLogon object's attributes, I get
the following error: "Can't access 'USERID' field in object of class
DBLogon at testdblogon.pl line 7". What am I missing?
# ==================== Logon.pm ====================
package Logon;
use Carp;
# Constructor
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {};
bless $self, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->{USERID} = undef;
$self->{SERVER} = undef;
}
sub display {
my $self = shift;
my @keys;
if (@_ == 0) {
@keys = sort keys (%$self);
} else {
@keys = @_;
}
foreach $key (@keys) {
$key = uc $key;
my $label = ucfirst lc $key;
print "$label: $self->{$key}\n";
}
}
sub userid;
sub server;
sub AUTOLOAD {
my $self = shift;
my $type = ref($self) || croak "$self is not an object";
my $name = uc $AUTOLOAD;
$name =~ s/.*://; # Strip fully-qualified portion
unless ( exists $self->{$name} ) {
croak "Can't access '$name' field in object of class
$type";
}
if (@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
1;
# ==================== DBLogon.pm ====================
package DBLogon;
use Logon;
@ISA = qw (Logon);
use Carp;
# Constructor
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = $class->SUPER::new();
bless $self, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->{DBNAME} = undef;
}
1;
There are also 2 test programs, testlogon.pm and testdblogon.pm:
# ==================== Logon.pm ====================
#!/usr/bin/perl
use DBLogon;
my $mylogon = DBLogon->new();
$mylogon->userid("user1");
$mylogon->server("server1");
$mylogon->dbname("db1");
$mylogon->display();
# ==================== Logon.pm ====================
#!/usr/bin/perl
use DBLogon;
my $mylogon = DBLogon->new();
$mylogon->userid("user1");
$mylogon->server("server1");
$mylogon->dbname("db1");
$mylogon->display();