ch12_05.htm

编程珍珠,里面很多好用的代码,大家可以参考学习呵呵,

<p>See the descriptions of <tt class="literal">use base</tt> and <tt class="literal">use fields</tt> in 
<a href="ch31_01.htm">Chapter 31, "Pragmatic Modules"</a> for further details.</p>






<h3 class="sect2">12.5.2. Accessing Overridden Methods</h3>

<a name="INDEX-2455"></a><a name="INDEX-2456"></a><a name="INDEX-2457"></a><a name="INDEX-2458"></a><a name="INDEX-2459"></a><a name="INDEX-2460"></a><a name="INDEX-2461"></a>
<p>When a class defines a method, that subroutine overrides methods of the
same name in any base classes.  Imagine that you've a <tt class="literal">Mule</tt> object
(which is derived from class <tt class="literal">Horse</tt> and class <tt class="literal">Donkey</tt>), and you decide
to invoke your object's <tt class="literal">breed</tt> method.  Although the parent classes
have their own <tt class="literal">breed</tt> methods, the designer of the <tt class="literal">Mule</tt> class
overrode those by supplying the <tt class="literal">Mule</tt> class with its own <tt class="literal">breed</tt>
method.  That means the following cross is unlikely to be productive:
<blockquote>
<pre class="programlisting">$stallion = Horse-&gt;new(gender =&gt; "male");
$molly = Mule-&gt;new(gender =&gt; "female");
$colt = $molly-&gt;breed($stallion);</pre>
</blockquote>

Now suppose that through the miracle of genetic engineering, you
find some way around a mule's notorious sterility problem, so you
want to skip over the nonviable <tt class="literal">Mule::breed</tt> method.  You
<em class="emphasis">could</em> call your method as an ordinary subroutine, being sure to
pass the invocant explicitly:
<blockquote>
<pre class="programlisting">$colt = Horse::breed($molly, $stallion);</pre>
</blockquote>

However, this sidesteps inheritance, which is nearly always the wrong
thing to do.  It's perfectly imaginable that no
<tt class="literal">Horse::breed</tt> subroutine exists because both <tt class="literal">Horse</tt>s and <tt class="literal">Donkey</tt>s derive that behavior from a common parent class called <tt class="literal">Equine</tt>.  If,
on the other hand, you want to specify that Perl should <em class="emphasis">start</em>
searching for a method in a particular class, just use ordinary method
invocation but qualify the method name with the class:
<blockquote>
<pre class="programlisting">$colt = $molly-&gt;Horse::breed($stallion);</pre>
</blockquote>
<a name="INDEX-2462"></a>
Occasionally, you'll want a method in a derived class to act as a wrapper
around some method in a base class.  The method in the derived class
can itself invoke the method in the base class, adding its own actions
before or after that invocation.  You <em class="emphasis">could</em> use the notation just
demonstrated to specify at which class to start the search.  But in
most cases of overridden methods, you don't want to have to know or
specify which parent class's overridden method to execute.</p>

<p>
<a name="INDEX-2463"></a><a name="INDEX-2464"></a><a name="INDEX-2465"></a>
That's where the <tt class="literal">SUPER</tt> pseudoclass comes in handy.  It lets you
invoke an overridden base class method without having to specify which
class defined that method.<a href="#FOOTNOTE-6">[6]</a> The following subroutine looks in the current package's <tt class="literal">@ISA</tt> without
making you specify particular classes:
<blockquote>
<pre class="programlisting">package Mule;
our @ISA = qw(Horse Donkey);
sub kick {
    my $self = shift;
    print "The mule kicks!\n";
    $self-&gt;SUPER::kick(@_);
}</pre>
</blockquote>

The <tt class="literal">SUPER</tt> pseudopackage is meaningful only when used <em class="emphasis">inside</em>
a method.  Although the implementer of a class can employ <tt class="literal">SUPER</tt>
in their own code, someone who merely uses a class's objects cannot.</p>
<blockquote class="footnote">

<a name="FOOTNOTE-6"></a>
<p>[6] This is not to be confused with
the mechanism mentioned in <a href="ch11_01.htm">Chapter 11, "Modules"</a> for overriding Perl's built-in
functions, which aren't object methods and so aren't overridden by
inheritance.  You call overridden built-ins via the <tt class="literal">CORE</tt>
pseudopackage, not the <tt class="literal">SUPER</tt> pseudopackage.</p>

</blockquote>

<p>
<a name="INDEX-2466"></a><tt class="literal">SUPER</tt> does not always work as you might like when multiple
inheritance is involved.  As you'd expect, it follows <tt class="literal">@ISA</tt> just as
the regular inheritance mechanism does: in left-to-right, recursive,
depth-first order.  If both <tt class="literal">Horse</tt> and <tt class="literal">Donkey</tt> had a <tt class="literal">speak</tt>
method, and you preferred the <tt class="literal">Donkey</tt> method, you'd have to name
that parent class explicitly:
<blockquote>
<pre class="programlisting">sub speak {
    my $self = shift;
    print "The mule speaks!\n";
    $self-&gt;Donkey::speak(@_);
}</pre>
</blockquote>

More elaborate approaches to multiple inheritance situations can
be crafted using the <tt class="literal">UNIVERSAL::can</tt> method described in the next
section.   Or you can grab the <tt class="literal">Class::Multimethods</tt>
module from CPAN, which provides many elaborate solutions, including
finding the closest match instead of leftmost one.
<a name="INDEX-2467"></a>
</p>

<p>Every bit of code in Perl knows what its current package is, as
determined by the last <tt class="literal">package</tt> statement.  A <tt class="literal">SUPER</tt> method
consults the <tt class="literal">@ISA</tt> only of the package into which the call 
to <tt class="literal">SUPER</tt> was compiled.  It does not care about the class of the invocant, nor
about the package of the subroutine that was called.  This can cause
problems if you try to define methods in another class by merely
playing tricks with the method name:
<blockquote>
<pre class="programlisting">package Bird;
use Dragonfly;
sub Dragonfly::divebomb { shift-&gt;SUPER::divebomb(@_) }</pre>
</blockquote>
<a name="INDEX-2468"></a>
</p>

<p>Unfortunately, this invokes <tt class="literal">Bird</tt>'s superclass, not <tt class="literal">Dragonfly</tt>'s.
To do what you're trying to do, you need to explicitly switch into the
appropriate package for the compilation of <tt class="literal">SUPER</tt> as well:
<blockquote>
<pre class="programlisting">package Bird;
use Dragonfly;
{
    package Dragonfly;
    sub divebomb { shift-&gt;SUPER::divebomb(@_) }
}</pre>
</blockquote>
<a name="INDEX-2469"></a>
As this example illustrates, you never need to edit a module file just to add
methods to an existing class.  Since a class is just a package, and a
method just a subroutine, all you have to do is define a function in
that package as we've done here, and the class suddenly has a new
method.  No inheritance required.  Only the package matters, and since
packages are global, any package can be accessed from anywhere in the
program.  (Did we mention we're going to install a jacuzzi in your living
room next week?)</p>





<a name="ch12-sect-uni"></a>
<h3 class="sect2">12.5.3. UNIVERSAL: The Ultimate Ancestor Class</h3>

<p>
<a name="INDEX-2470"></a><a name="INDEX-2471"></a>
If no method definition with the right name is found after searching the invocant's class
and all its ancestor classes recursively, one more check for a method
of that name is made in the special predefined class called
<tt class="literal">UNIVERSAL</tt>.  This package never appears in an <tt class="literal">@ISA</tt>, but is always
consulted when an <tt class="literal">@ISA</tt> check fails.  You can think of <tt class="literal">UNIVERSAL</tt>
as the ultimate ancestor from which all classes implicitly derive.</p>

<p>The following predefined methods are available in class
<tt class="literal">UNIVERSAL</tt>, and thus in all classes.  These all work
regardless of whether they are invoked as class methods or object
methods.
<a name="INDEX-2472"></a>
</p>

<dl>
<dt>
<b><em class="replaceable">INVOCANT</em><tt class="literal">-&gt;isa(</tt><em class="replaceable">CLASS</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-2473"></a>
The <tt class="literal">isa</tt> method returns true if
<em class="replaceable">INVOCANT</em>'s class is
<em class="replaceable">CLASS</em> or any class inheriting from
<em class="replaceable">CLASS</em>.  Instead of a package name,
<em class="replaceable">CLASS</em> may also be one of the built-in
types, such as "<tt class="literal">HASH</tt>" or
"<tt class="literal">ARRAY</tt>".  (Checking for an exact type does not bode
well for encapsulation or polymorphism, though.  You should be relying
on method dispatch to give you the right method.)
<blockquote>
<pre class="programlisting">use FileHandle;
if (FileHandle-&gt;isa("Exporter")) {
    print "FileHandle is an Exporter.\n";
}

$fh = FileHandle-&gt;new();
if ($fh-&gt;isa("IO::Handle")) {
    print "\$fh is some sort of IOish object.\n";
}
if ($fh-&gt;isa("GLOB")) {
    print "\$fh is really a GLOB reference.\n";
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">INVOCANT</em><tt class="literal">-&gt;can(</tt><em class="replaceable">METHOD</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-2474"></a>
The <tt class="literal">can</tt> method returns a reference to the
subroutine that would be called if <em class="replaceable">METHOD</em>
were applied to <em class="replaceable">INVOCANT</em>.  If no such
subroutine is found, <tt class="literal">can</tt> returns
<tt class="literal">undef</tt>.
<blockquote>
<pre class="programlisting">if ($invocant-&gt;can("copy")) {
    print "Our invocant can copy.\n";
}</pre>
</blockquote>

This could be used to conditionally invoke a method only if one exists:
<blockquote>
<pre class="programlisting">$obj-&gt;snarl if $obj-&gt;can("snarl");</pre>
</blockquote>
<a name="INDEX-2475"></a><a name="INDEX-2476"></a><a name="INDEX-2477"></a>
Under multiple inheritance, this allows a method to invoke all
overridden base class methods, not just the leftmost one:
<blockquote>
<pre class="programlisting">sub snarl {
    my $self = shift;
    print "Snarling: @_\n";
    my %seen;
    for my $parent (@ISA) {
        if (my $code = $parent-&gt;can("snarl")) {
            $self-&gt;$code(@_) unless $seen{$code}++;
        }
    }
}</pre>
</blockquote>