|
Even though proxy methods can provide a more convenient approach to making more struct-like
classes than tediously coding up data methods as functions, it still leaves a bit to be desired.
For one thing, it means you have to handle bogus calls that you don't mean to trap via your
proxy. It also means you have to be quite careful when dealing with inheritance, as detailed
above.
Perl programmers have responded to this by creating several different class construction
classes. These metaclasses are classes that create other classes. A couple worth looking at are
Class::Struct and Alias. These and other related metaclasses can be found in the modules
directory on CPAN.
One of the older ones is Class::Struct. In fact, its syntax and interface were sketched out
long before perl5 even solidified into a real thing. What it does is provide you a way to
"declare" a class as having objects whose fields are of a specific type. The function
that does this is called, not surprisingly enough, struct(). Because structures or records are
not base types in Perl, each time you want to create a class to provide a record-like data
object, you yourself have to define a new() method, plus separate data-access methods for each
of that record's fields. You'll quickly become bored with this process. The
Class::Struct::struct() function alleviates this tedium.
Here's a simple example of using it:
use Class::Struct qw(struct);
use Jobbie; # user-defined; see below
struct 'Fred' => {
one => '$',
many => '@',
profession => Jobbie, # calls Jobbie->new()
};
$ob = Fred->new;
$ob->one("hmmmm");
$ob->many(0, "here");
$ob->many(1, "you");
$ob->many(2, "go");
print "Just set: ", $ob->many(2), "\n";
$ob->profession->salary(10_000);
|
|
You can declare types in the struct to be basic Perl types, or user-defined types (classes).
User types will be initialized by calling that class's new() method.
Here's a real-world example of using struct generation. Let's say you wanted to override
Perl's idea of gethostbyname() and gethostbyaddr() so that they would return objects that acted
like C structures. We don't care about high-falutin' OO gunk. All we want is for these objects
to act like structs in the C sense.
use Socket;
use Net::hostent;
$h = gethostbyname("perl.com"); # object return
printf "perl.com's real name is %s, address %s\n",
$h->name, inet_ntoa($h->addr);
|
|
Here's how to do this using the Class::Struct module. The crux is going to be this call:
struct 'Net::hostent' => [ # note bracket
name => '$',
aliases => '@',
addrtype => '$',
'length' => '$',
addr_list => '@',
];
|
|
Which creates object methods of those names and types. It even creates a new() method for us.
We could also have implemented our object this way:
struct 'Net::hostent' => { # note brace
name => '$',
aliases => '@',
addrtype => '$',
'length' => '$',
addr_list => '@',
};
|
|
and then Class::Struct would have used an anonymous hash as the object type, instead of an
anonymous array. The array is faster and smaller, but the hash works out better if you
eventually want to do inheritance. Since for this struct-like object we aren't planning on
inheritance, this time we'll opt for better speed and size over better flexibility.
Here's the whole implementation:
package Net::hostent;
use strict;
BEGIN {
use Exporter ();
our @EXPORT = qw(gethostbyname gethostbyaddr gethost);
our @EXPORT_OK = qw(
$h_name @h_aliases
$h_addrtype $h_length
@h_addr_list $h_addr
);
our %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
}
our @EXPORT_OK;
# Class::Struct forbids use of @ISA
sub import { goto &Exporter::import }
use Class::Struct qw(struct);
struct 'Net::hostent' => [
name => '$',
aliases => '@',
addrtype => '$',
'length' => '$',
addr_list => '@',
];
sub addr { shift->addr_list->[0] }
sub populate (@) {
return unless @_;
my $hob = new(); # Class::Struct made this!
$h_name = $hob->[0] = $_[0];
@h_aliases = @{ $hob->[1] } = split ' ', $_[1];
$h_addrtype = $hob->[2] = $_[2];
$h_length = $hob->[3] = $_[3];
$h_addr = $_[4];
@h_addr_list = @{ $hob->[4] } = @_[ (4 .. $#_) ];
return $hob;
}
sub gethostbyname ($) { populate(CORE::gethostbyname(shift)) }
sub gethostbyaddr ($;$) {
my ($addr, $addrtype);
$addr = shift;
require Socket unless @_;
$addrtype = @_ ? shift : Socket::AF_INET();
populate(CORE::gethostbyaddr($addr, $addrtype))
}
sub gethost($) {
if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
require Socket;
&gethostbyaddr(Socket::inet_aton(shift));
} else {
&gethostbyname;
}
}
1;
|
|
We've snuck in quite a fair bit of other concepts besides just dynamic class creation, like
overriding core functions, import/export bits, function prototyping, short-cut function call via
&whatever, and function replacement with goto &whatever. These
all mostly make sense from the perspective of a traditional module, but as you can see, we can
also use them in an object module.
You can look at other object-based, struct-like overrides of core functions in the 5.004
release of Perl in File::stat, Net::hostent, Net::netent, Net::protoent, Net::servent,
Time::gmtime, Time::localtime, User::grent, and User::pwent. These modules have a final
component that's all lowercase, by convention reserved for compiler pragmas, because they affect
the compilation and change a builtin function. They also have the type names that a C programmer
would most expect.
If you're used to C++ objects, then you're accustomed to being able to get at an object's
data members as simple variables from within a method. The Alias module provides for this, as
well as a good bit more, such as the possibility of private methods that the object can call but
folks outside the class cannot.
Here's an example of creating a Person using the Alias module. When you update these magical
instance variables, you automatically update value fields in the hash. Convenient, eh?
package Person;
# this is the same as before...
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
NAME => undef,
AGE => undef,
PEERS => [],
};
bless($self, $class);
return $self;
}
use Alias qw(attr);
our ($NAME, $AGE, $PEERS);
sub name {
my $self = attr shift;
if (@_) { $NAME = shift; }
return $NAME;
}
sub age {
my $self = attr shift;
if (@_) { $AGE = shift; }
return $AGE;
}
sub peers {
my $self = attr shift;
if (@_) { @PEERS = @_; }
return @PEERS;
}
sub exclaim {
my $self = attr shift;
return sprintf "Hi, I'm %s, age %d, working with %s",
$NAME, $AGE, join(", ", @PEERS);
}
sub happy_birthday {
my $self = attr shift;
return ++$AGE;
}
|
|
The need for the our declaration is because what Alias does is play with package
globals with the same name as the fields. To use globals while use strict is in
effect, you have to predeclare them. These package variables are localized to the block
enclosing the attr() call just as if you'd used a local() on them. However, that means that
they're still considered global variables with temporary values, just as with any other local().
It would be nice to combine Alias with something like Class::Struct or Class::MethodMaker.
|
|
