In Perl, fields are not usually hidden by enforcing this through the semantics of the language, but rather through a contract in the form of documentation. However, fields can be hidden through the use of closures. It is also worth noting that Perl does not semantically differentiate between class methods and instance methods.
One of the standard ways to implement objects is a blessed hash, like you do. This hash contains all instance variables / fields. It is customary to start "private" fields with an underscore. Usually, the contract (the documentation) will not state how these fields are stored, but will require the user of the class to go through various method calls.
Class variables should not be stored with the instance. It is better to use global variables, or lexical variables. In the code you gave, $count is just a counter, but you never access it as a class variable. Instead, you assign each instance an unique ID. To use it as a class variable, provide an appropriate accessor (I stripped out unneccessary stuff like returns):
{
package Base;
my $count = 0;
sub new {
my ($class) = @_;
my $self = {
ID => $count++,
};
bless $self, $class;
}
sub Count { $count }
sub ID { my ($self) = @_; $self->{ID} }
sub report { my ($self) = @_; "I am the Base object ".($self->ID)."." }
}
=head1 Base
A generic base class
=head2 Base->Count
Return the object count.
=head2 $base->ID
Give the unique ID of this object.
=head2 $base->report
Returns a string containing a short description.
=cut
The subclass has no business meddling with the count. This is enforced by the scope of the variable $count above, denoted via the outer curly braces. The subs are closures over this variable.
{
package Sub;
use parent -norequire, qw(Base); # remove `-norequire` if Base in different file
sub new {
my ($class) = @_;
my $self = $class->SUPER::new;
$self->{Name} = undef;
$self;
}
sub Name :lvalue {
my ($self) = @_;
$self->{Name};
}
sub report {
my ($self) = @_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
=head1 Sub
A generic subclass. It subclasses Base.
=head2 $sub->Name [= SCALAR]
Gets or sets the name of $sub.
my $oldname = $sub->Name;
$sub->name = "new name";
=cut
As you can see, the Sub constructor calls the Base initializer, then adds a new field. It has no class methods or class variables. The class has no access to the $count variable, except via the accessor class method. The contract is stated via POD documentation.
(In the Name method, I use an :lvalue annotation. This allows me to simply assign to the appropriate field in the object. However, this disallows argument checking.)
The testcase
my $base1 = Base->new; my $base2 = Base->new;
print "There are now " . Base->Count . " Base objects\n";
my $sub1 = Sub->new; my $sub2 = Sub->new;
print "There are now " . Base->Count . " Base objects\n";
$sub2->Name = "Fred";
print $_->report . "\n" for ($base1, $sub1, $base2, $sub2);
prints
There are now 2 Base objects
There are now 4 Base objects
I am the Base object 0.
I am the Sub object 2 called .
I am the Base object 1.
I am the Sub object 3 called Fred.
Beautiful, isn't it? (Except $sub1, that object is missing its name.)
The documentation can be viewed with perldoc -F FILENAME, and would output something like
Base
A generic base class
Base->Count
Return the object count.
$base->ID
Give the unique ID of this object.
$base->report
Returns a string containing a short description.
Sub
A generic subclass. It subclasses Base.
$sub->Name [= SCALAR]
Gets or sets the name of $sub.
my $oldname = $sub->Name;
$sub->name = "new name";
only typeset more nicely, if you are on a *nix system.
Tested under v5.12.4.
Edit: Inside-out objects
While inside-out objects provide better encapulation, they are a bad idea: difficult to understand, difficult to debug, and difficult to inherit they provide more problems than solutions.
{
package Base;
my $count = 0;
sub new { bless \do{my $o = $count++}, shift }
sub Count { $count }
sub ID { ${+shift} }
sub report { my ($self) = @_; "I am the Base object ".($self->ID)."." }
}
{
package Sub;
my @_obj = ();
my $count = 0;
sub new {
my ($class) = @_;
$count++;
$_obj[$count - 1] = +{
parent => Base->new(),
Name => undef,
};
bless \do{my $o = $count - 1}, shift;
}
sub Name :lvalue { $_obj[${+shift}]{Name} }
sub AUTOLOAD {
my $self = shift;
my $package = __PACKAGE__ . "::";
(my $meth = $AUTOLOAD) =~ s/^$package//;
$_obj[$$self]{parent}->$meth(@_)
}
sub report {
my ($self) = @_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
This implementation has the exact same interface, and completes the test case with the same output. This solution is far from optimal, supports only single inheritance, does some intermediate stuff (autoloading, dynamic method calls), but it does suprisingly work. Each object is actually just a reference to an ID that can be used to look up the actual hash containing the fields. The array holding the hashes is not accessible from the outside. The Base class has no fields, therefore no object array had to be created.
Edit2: Objects as coderefs
Yet another bad idea, but it is fun to code:
{
package Base;
my $count = 0;
sub new {
my ($class) = @_;
my $id = $count++;
bless sub {
my ($field) = @_;
die "Undefined field name" unless defined $field;
if ($field eq "ID") { return $id }
else { die "Unrecognised name $field" }
}, $class;
}
sub Count { $count }
sub ID { my ($self) = @_; $self->("ID") }
sub report { my ($self) = @_; "I am the Base object " . $self->ID . "." }
}
{
package Sub;
use parent -norequire, qw(Base);
sub new {
my ($class) = @_;
my $name = undef;
my $super = $class->SUPER::new;
bless sub {
my ($field, $val ) = @_;
die "Undefined field name" unless defined $field;
if ($field eq "Name") { defined $val ? $name = $val : $name }
else { $super->(@_) }
}, $class;
}
sub Name { my $self = shift; $self->("Name", @_) }
sub report {
my ($self) = @_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
The test case has to be adapted to $sub2->Name("Fred"), and the documentation updated accordingly, as we cannot use an lvalue annotation here safely.
