perltoot.pod

来自「视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.」· POD 代码 · 共 1,743 行 · 第 1/5 页

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

    sub as_string {
        my $self = shift;
        my $name = join(" ", @$self{'CHRISTIAN', 'SURNAME'});
        if ($self->{TITLE}) {
            $name = $self->{TITLE} . " " . $name;
        }
        return $name;
    }

    1;

Finally, here's the test program:

    #!/usr/bin/perl -w
    use strict;
    use Person;
    sub END { show_census() }

    sub show_census ()  {
        printf "Current population: %d\n", Person->population;
    }

    Person->debug(1);

    show_census();

    my $him = Person->new();

    $him->fullname->christian("Thomas");
    $him->fullname->surname("Aquinas");
    $him->fullname->nickname("Tommy");
    $him->fullname->title("St");
    $him->age(1);

    printf "%s is really %s.\n", $him->name, $him->fullname->as_string;
    printf "%s's age: %d.\n", $him->name, $him->age;
    $him->happy_birthday;
    printf "%s's age: %d.\n", $him->name, $him->age;

    show_census();

=head1 Inheritance

Object-oriented programming systems all support some notion of
inheritance.  Inheritance means allowing one class to piggy-back on
top of another one so you don't have to write the same code again and
again.  It's about software reuse, and therefore related to Laziness,
the principal virtue of a programmer.  (The import/export mechanisms in
traditional modules are also a form of code reuse, but a simpler one than
the true inheritance that you find in object modules.)

Sometimes the syntax of inheritance is built into the core of the
language, and sometimes it's not.  Perl has no special syntax for
specifying the class (or classes) to inherit from.  Instead, it's all
strictly in the semantics.  Each package can have a variable called @ISA,
which governs (method) inheritance.  If you try to call a method on an
object or class, and that method is not found in that object's package,
Perl then looks to @ISA for other packages to go looking through in
search of the missing method.

Like the special per-package variables recognized by Exporter (such as
@EXPORT, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, and $VERSION), the @ISA
array I<must> be a package-scoped global and not a file-scoped lexical
created via my().  Most classes have just one item in their @ISA array.
In this case, we have what's called "single inheritance", or SI for short.

Consider this class:

    package Employee;
    use Person;
    @ISA = ("Person");
    1;

Not a lot to it, eh?  All it's doing so far is loading in another
class and stating that this one will inherit methods from that
other class if need be.  We have given it none of its own methods.
We rely upon an Employee to behave just like a Person.

Setting up an empty class like this is called the "empty subclass test";
that is, making a derived class that does nothing but inherit from a
base class.  If the original base class has been designed properly,
then the new derived class can be used as a drop-in replacement for the
old one.  This means you should be able to write a program like this:

    use Employee;
    my $empl = Employee->new();
    $empl->name("Jason");
    $empl->age(23);
    printf "%s is age %d.\n", $empl->name, $empl->age;

By proper design, we mean always using the two-argument form of bless(),
avoiding direct access of global data, and not exporting anything.  If you
look back at the Person::new() function we defined above, we were careful
to do that.  There's a bit of package data used in the constructor,
but the reference to this is stored on the object itself and all other
methods access package data via that reference, so we should be ok.

What do we mean by the Person::new() function -- isn't that actually
a method?  Well, in principle, yes.  A method is just a function that
expects as its first argument a class name (package) or object
(blessed reference).   Person::new() is the function that both the
C<< Person->new() >> method and the C<< Employee->new() >> method end
up calling.  Understand that while a method call looks a lot like a
function call, they aren't really quite the same, and if you treat them
as the same, you'll very soon be left with nothing but broken programs.
First, the actual underlying calling conventions are different: method
calls get an extra argument.  Second, function calls don't do inheritance,
but methods do.

        Method Call             Resulting Function Call
        -----------             ------------------------
        Person->new()           Person::new("Person")
        Employee->new()         Person::new("Employee")

So don't use function calls when you mean to call a method.

If an employee is just a Person, that's not all too very interesting.
So let's add some other methods.  We'll give our employee
data fields to access their salary, their employee ID, and their
start date.

If you're getting a little tired of creating all these nearly identical
methods just to get at the object's data, do not despair.  Later,
we'll describe several different convenience mechanisms for shortening
this up.  Meanwhile, here's the straight-forward way:

    sub salary {
        my $self = shift;
        if (@_) { $self->{SALARY} = shift }
        return $self->{SALARY};
    }

    sub id_number {
        my $self = shift;
        if (@_) { $self->{ID} = shift }
        return $self->{ID};
    }

    sub start_date {
        my $self = shift;
        if (@_) { $self->{START_DATE} = shift }
        return $self->{START_DATE};
    }

=head2 Overridden Methods

What happens when both a derived class and its base class have the same
method defined?  Well, then you get the derived class's version of that
method.  For example, let's say that we want the peers() method called on
an employee to act a bit differently.  Instead of just returning the list
of peer names, let's return slightly different strings.  So doing this:

    $empl->peers("Peter", "Paul", "Mary");
    printf "His peers are: %s\n", join(", ", $empl->peers);

will produce:

    His peers are: PEON=PETER, PEON=PAUL, PEON=MARY

To do this, merely add this definition into the Employee.pm file:

    sub peers {
        my $self = shift;
        if (@_) { @{ $self->{PEERS} } = @_ }
        return map { "PEON=\U$_" } @{ $self->{PEERS} };
    }

There, we've just demonstrated the high-falutin' concept known in certain
circles as I<polymorphism>.  We've taken on the form and behaviour of
an existing object, and then we've altered it to suit our own purposes.
This is a form of Laziness.  (Getting polymorphed is also what happens
when the wizard decides you'd look better as a frog.)

Every now and then you'll want to have a method call trigger both its
derived class (also known as "subclass") version as well as its base class
(also known as "superclass") version.  In practice, constructors and
destructors are likely to want to do this, and it probably also makes
sense in the debug() method we showed previously.

To do this, add this to Employee.pm:

    use Carp;
    my $Debugging = 0;

    sub debug {
        my $self = shift;
        confess "usage: thing->debug(level)"    unless @_ == 1;
        my $level = shift;
        if (ref($self))  {
            $self->{"_DEBUG"} = $level;
        } else {
            $Debugging = $level;            # whole class
        }
        Person::debug($self, $Debugging);   # don't really do this
    }

As you see, we turn around and call the Person package's debug() function.
But this is far too fragile for good design.  What if Person doesn't
have a debug() function, but is inheriting I<its> debug() method
from elsewhere?  It would have been slightly better to say

    Person->debug($Debugging);

But even that's got too much hard-coded.  It's somewhat better to say

    $self->Person::debug($Debugging);

Which is a funny way to say to start looking for a debug() method up
in Person.  This strategy is more often seen on overridden object methods
than on overridden class methods.

There is still something a bit off here.  We've hard-coded our
superclass's name.  This in particular is bad if you change which classes
you inherit from, or add others.  Fortunately, the pseudoclass SUPER
comes to the rescue here.

    $self->SUPER::debug($Debugging);

This way it starts looking in my class's @ISA.  This only makes sense
from I<within> a method call, though.  Don't try to access anything
in SUPER:: from anywhere else, because it doesn't exist outside
an overridden method call. Note that C<SUPER> refers to the superclass of
the current package, I<not> to the superclass of C<$self>.

Things are getting a bit complicated here.  Have we done anything
we shouldn't?  As before, one way to test whether we're designing
a decent class is via the empty subclass test.  Since we already have
an Employee class that we're trying to check, we'd better get a new
empty subclass that can derive from Employee.  Here's one:

    package Boss;
    use Employee;        # :-)
    @ISA = qw(Employee);

And here's the test program:

    #!/usr/bin/perl -w
    use strict;
    use Boss;
    Boss->debug(1);

    my $boss = Boss->new();

    $boss->fullname->title("Don");
    $boss->fullname->surname("Pichon Alvarez");
    $boss->fullname->christian("Federico Jesus");
    $boss->fullname->nickname("Fred");

    $boss->age(47);
    $boss->peers("Frank", "Felipe", "Faust");

    printf "%s is age %d.\n", $boss->fullname->as_string, $boss->age;
    printf "His peers are: %s\n", join(", ", $boss->peers);

Running it, we see that we're still ok.  If you'd like to dump out your
object in a nice format, somewhat like the way the 'x' command works in
the debugger, you could use the Data::Dumper module from CPAN this way:

    use Data::Dumper;
    print "Here's the boss:\n";
    print Dumper($boss);

Which shows us something like this:

    Here's the boss:
    $VAR1 = bless( {
	 _CENSUS => \1,
	 FULLNAME => bless( {
			      TITLE => 'Don',
			      SURNAME => 'Pichon Alvarez',
			      NICK => 'Fred',
			      CHRISTIAN => 'Federico Jesus'
			    }, 'Fullname' ),
	 AGE => 47,
	 PEERS => [
		    'Frank',
		    'Felipe',
		    'Faust'
		  ]
       }, 'Boss' );

Hm.... something's missing there.  What about the salary, start date,
and ID fields?  Well, we never set them to anything, even undef, so they
don't show up in the hash's keys.  The Employee class has no new() method
of its own, and the new() method in Person doesn't know about Employees.
(Nor should it: proper OO design dictates that a subclass be allowed to
know about its immediate superclass, but never vice-versa.)  So let's
fix up Employee::new() this way:

    sub new {
        my $class = shift;
        my $self  = $class->SUPER::new();
        $self->{SALARY}        = undef;
        $self->{ID}            = undef;
        $self->{START_DATE}    = undef;
        bless ($self, $class);          # reconsecrate
        return $self;
    }

Now if you dump out an Employee or Boss object, you'll find
that new fields show up there now.

=head2 Multiple Inheritance

Ok, at the risk of confusing beginners and annoying OO gurus, it's
time to confess that Perl's object system includes that controversial
notion known as multiple inheritance, or MI for short.  All this means
is that rather than having just one parent class who in turn might
itself have a parent class, etc., that you can directly inherit from
two or more parents.  It's true that some uses of MI can get you into
trouble, although hopefully not quite so much trouble with Perl as with
dubiously-OO languages like C++.

The way it works is actually pretty simple: just put more than one package
name in your @ISA array.  When it comes time for Perl to go finding
methods for your object, it looks at each of these packages in order.
Well, kinda.  It's actually a fully recursive, depth-first order by
default (see L<mro> for alternate method resolution orders).
Consider a bunch of @ISA arrays like this:

    @First::ISA    = qw( Alpha );
    @Second::ISA   = qw( Beta );
    @Third::ISA    = qw( First Second );

If you have an object of class Third:

    my $ob = Third->new();
    $ob->spin();

How do we find a spin() method (or a new() method for that matter)?
Because the search is depth-first, classes will be looked up
in the following order: Third, First, Alpha, Second, and Beta.

In practice, few class modules have been seen that actually
make use of MI.  One nearly always chooses simple containership of
one class within another over MI.  That's why our Person
object I<contained> a Fullname object.  That doesn't mean
it I<was> one.

However, there is one particular area where MI in Perl is rampant:
borrowing another class's class methods.  This is rather common,
especially with some bundled "objectless" classes,
like Exporter, DynaLoader, AutoLoader, and SelfLoader.  These classes
do not provide constructors; they exist only so you may inherit their
class methods.  (It's not entirely clear why inheritance was done