perltoot.pod

来自「ARM上的如果你对底层感兴趣」· POD 代码 · 共 1,696 行 · 第 1/5 页

Here's what the module initialization code and class
constructor will look like when taking this approach:

    package Person;
    use Carp;
    use vars qw($AUTOLOAD);  # it's a package global

    my %fields = (
	name        => undef,
	age         => undef,
	peers       => undef,
    );

    sub new {
	my $that  = shift;
	my $class = ref($that) || $that;
	my $self  = {
	    _permitted => \%fields,
	    %fields,
	};
	bless $self, $class;
	return $self;
    }

If we wanted our record to have default values, we could fill those in
where current we have C<undef> in the %fields hash.

Notice how we saved a reference to our class data on the object itself?
Remember that it's important to access class data through the object
itself instead of having any method reference %fields directly, or else
you won't have a decent inheritance.

The real magic, though, is going to reside in our proxy method, which
will handle all calls to undefined methods for objects of class Person
(or subclasses of Person).  It has to be called AUTOLOAD.  Again, it's
all caps because it's called for us implicitly by Perl itself, not by
a user directly.

    sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self)
		    or croak "$self is not an object";

	my $name = $AUTOLOAD;
	$name =~ s/.*://;   # strip fully-qualified portion

	unless (exists $self->{_permitted}->{$name} ) {
	    croak "Can't access `$name' field in class $type";
	}

	if (@_) {
	    return $self->{$name} = shift;
	} else {
	    return $self->{$name};
	}
    }

Pretty nifty, eh?  All we have to do to add new data fields
is modify %fields.  No new functions need be written.

I could have avoided the C<_permitted> field entirely, but I
wanted to demonstrate how to store a reference to class data on the
object so you wouldn't have to access that class data
directly from an object method.

=head2 Inherited Autoloaded Data Methods

But what about inheritance?  Can we define our Employee
class similarly?  Yes, so long as we're careful enough.

Here's how to be careful:

    package Employee;
    use Person;
    use strict;
    use vars qw(@ISA);
    @ISA = qw(Person);

    my %fields = (
	id          => undef,
	salary      => undef,
    );

    sub new {
	my $that  = shift;
	my $class = ref($that) || $that;
	my $self = bless $that->SUPER::new(), $class;
	my($element);
	foreach $element (keys %fields) {
	    $self->{_permitted}->{$element} = $fields{$element};
	}
	@{$self}{keys %fields} = values %fields;
	return $self;
    }

Once we've done this, we don't even need to have an
AUTOLOAD function in the Employee package, because
we'll grab Person's version of that via inheritance,
and it will all work out just fine.

=head1 Metaclassical Tools

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.

=head2 Class::Struct

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   ();
	use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
	@EXPORT      = qw(gethostbyname gethostbyaddr gethost);
	@EXPORT_OK   = qw(
			   $h_name         @h_aliases
			   $h_addrtype     $h_length
			   @h_addr_list    $h_addr
		       );
	%EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    use vars      @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 C<&whatever>, and
function replacement with C<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.

=head2 Data Members as Variables

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);
    use vars qw($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 C<use vars> declaration is because what Alias does
is play with package globals with the same na