ch14_03.htm

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

    my $dot = shift;
    my $dir = $self->{HOME};
    my $file = "$dir/.$dot";

    unless (exists $self->{CONTENTS}->{$dot} || -f $file) {
        carp "@{[&whowasi]}: no $dot file" if $DEBUG;
        return undef;
    }

    # Implement a cache.
    if (defined $self->{CONTENTS}->{$dot}) {
        return $self->{CONTENTS}->{$dot};
    } else {
        return $self->{CONTENTS}->{$dot} = `cat $dir/.$dot`;
    }
}</pre>
</blockquote>
<a name="INDEX-"></a>
We cheated a little by running the Unix <em class="emphasis">cat</em>(1) command, but it would
be more portable (and more efficient) to open the file
ourselves.  On the other hand, since dotfiles are a Unixy concept,
we're not that concerned.  Or shouldn't be.  Or something...</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;STORE(</tt><em class="replaceable">KEY</em><tt class="literal">,</tt> <em class="replaceable">VALUE</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>This method does the dirty work whenever an element in the tied hash is
set (written).  It takes two arguments after the object: the
key under which we're storing the new value, and the value itself.</p>

<p>For our <tt class="literal">DotFiles</tt> example, we won't let users overwrite a file without
first invoking the <tt class="literal">clobber</tt> method on the original object returned by
<tt class="literal">tie</tt>:
<blockquote>
<pre class="programlisting">sub STORE {
    carp &amp;whowasi if $DEBUG;
    my $self  = shift;
    my $dot   = shift;
    my $value = shift;
    my $file  = $self-&gt;{HOME} . "/.$dot";

    croak "@{[&amp;whowasi]}: $file not clobberable"
        unless $self-&gt;{CLOBBER};

    open(F, "&gt; $file") or croak "can't open $file: $!";
    print F $value;
    close(F);
}</pre>
</blockquote>
If someone wants to clobber something, they can say:
<blockquote>
<pre class="programlisting">$ob = tie %daemon_dots, "daemon";
$ob-&gt;clobber(1);
$daemon_dots{signature} = "A true daemon\n";</pre>
</blockquote>

But they could alternatively set <tt class="literal">{CLOBBER}</tt> with <tt class="literal">tied</tt>:
<blockquote>
<pre class="programlisting">tie %daemon_dots, "DotFiles", "daemon";
tied(%daemon_dots)-&gt;clobber(1);</pre>
</blockquote>

or as one statement:
<blockquote>
<pre class="programlisting">(tie %daemon_dots, "DotFiles", "daemon")-&gt;clobber(1);</pre>
</blockquote>

The <tt class="literal">clobber</tt> method is simply:
<blockquote>
<pre class="programlisting">sub clobber {
    my $self = shift;
    $self-&gt;{CLOBBER} = @_ ? shift : 1;
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;DELETE(</tt><em class="replaceable">KEY</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>This method handles requests to remove an element from the hash.  If
your emulated hash uses a real hash somewhere, you can just call
the real <tt class="literal">delete</tt>.  Again, we'll be careful to check whether the
user really wants to clobber files:
<blockquote>
<pre class="programlisting">sub DELETE   {
    carp &amp;whowasi if $DEBUG;
    my $self = shift;
    my $dot = shift;
    my $file = $self-&gt;{HOME} . "/.$dot";
    croak "@{[&amp;whowasi]}: won't remove file $file"
        unless $self-&gt;{CLOBBER};
    delete $self-&gt;{CONTENTS}-&gt;{$dot};
    unlink $file or carp "@{[&amp;whowasi]}: can't unlink $file: $!";
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;CLEAR</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a>
This method is run when the whole hash needs to be cleared, usually
by assigning the empty list to it. In our example, that would remove all the user's dot files!  It's such a
dangerous thing that we'll require <tt class="literal">CLOBBER</tt> to be set higher than <tt class="literal">1</tt>
before this can happen:
<blockquote>
<pre class="programlisting">sub CLEAR {
    carp &amp;whowasi if $DEBUG;
    my $self = shift;
    croak "@{[&amp;whowasi]}: won't remove all dotfiles for $self-&gt;{USER}"
        unless $self-&gt;{CLOBBER} &gt; 1;
    for my $dot ( keys %{$self-&gt;{CONTENTS}}) {
        $self-&gt;DELETE($dot);
    }
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;EXISTS(</tt><em class="replaceable">KEY</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a>
This method runs when the user invokes the <tt class="literal">exists</tt> function on
a particular hash.  In our example, we'll look at the <tt class="literal">{CONTENTS}</tt> hash
element to find the answer:
<blockquote>
<pre class="programlisting">sub EXISTS   {
    carp &amp;whowasi if $DEBUG;
    my $self = shift;
    my $dot  = shift;
    return exists $self-&gt;{CONTENTS}-&gt;{$dot};
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;FIRSTKEY</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a><a name="INDEX-"></a><a name="INDEX-"></a><a name="INDEX-"></a>
This method is called when the user begins to iterate through the
hash, such as with a <tt class="literal">keys</tt>, <tt class="literal">values</tt>, or <tt class="literal">each</tt> call.  By calling
<tt class="literal">keys</tt> in a scalar context, we reset its internal state to ensure
that the next <tt class="literal">each</tt> used in the <tt class="literal">return</tt> statement will get the
first key.
<blockquote>
<pre class="programlisting">sub FIRSTKEY {
    carp &amp;whowasi if $DEBUG;
    my $self = shift;
    my $temp = keys %{$self-&gt;{CONTENTS}};
    return scalar each %{$self-&gt;{CONTENTS}};
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;NEXTKEY(</tt><em class="replaceable">PREVKEY</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>This method is the iterator for a <tt class="literal">keys</tt>, <tt class="literal">values</tt>, or <tt class="literal">each</tt>
function.  <em class="replaceable">PREVKEY</em> is the last key accessed, which Perl knows
to supply.  This is useful if the <tt class="literal">NEXTKEY</tt> method needs to know
its previous state to calculate the next state.</p>

<p>For our example, we are using a real hash to represent the tied hash's
data, except that this hash is stored in the hash's <tt class="literal">CONTENTS</tt> field
instead of in the hash itself.  So we can just rely on Perl's <tt class="literal">each</tt>
iterator:
<blockquote>
<pre class="programlisting">sub NEXTKEY  {
    carp &amp;whowasi if $DEBUG;
    my $self = shift;
    return scalar each %{ $self-&gt;{CONTENTS} }
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;DESTROY</tt></b>
</dt>
<dd>
<p>This method is triggered when a tied hash's object is about to be
deallocated.  You don't really need it except for debugging and extra
cleanup.  Here's a very simple version:
<blockquote>
<pre class="programlisting">sub DESTROY  {
    carp &amp;whowasi if $DEBUG;
}</pre>
</blockquote>
</p>
</dd>

</dl>

<p>
</p>

<p>Now that we've given you all those methods, your homework is to go back
and find the places we interpolated <tt class="literal">@{[&amp;whowasi]}</tt> and replace
them with a simple tied scalar named <tt class="literal">$whowasi</tt> that does the same thing.</p>

<a name="INDEX-2730"></a><a name="INDEX-2731"></a><a name="INDEX-2732"></a>



<!-- BOTTOM NAV BAR -->

<hr width="515" align="left">
<div class="navbar">
<table width="515" border="0">
<tr>
<td align="left" valign="top" width="172"><a href="ch14_02.htm"><img src="../gifs/txtpreva.gif" alt="Previous" border="0"></a></td><td align="center" valign="top" width="171"><a href="index.htm"><img src="../gifs/txthome.gif" alt="Home" border="0"></a></td><td align="right" valign="top" width="172"><a href="ch14_04.htm"><img src="../gifs/txtnexta.gif" alt="Next" border="0"></a></td>
</tr>
<tr>
<td align="left" valign="top" width="172">14.2. Tying Arrays</td><td align="center" valign="top" width="171"><a href="index/index.htm"><img src="../gifs/index.gif" alt="Book Index" border="0"></a></td><td align="right" valign="top" width="172">14.4. Tying Filehandles</td>
</tr>
</table>
</div>
<hr width="515" align="left">

<!-- LIBRARY NAV BAR -->

<img src="../gifs/smnavbar.gif" usemap="#library-map" border="0" alt="Library Navigation Links"><p>
<font size="-1"><a href="copyrght.htm">Copyright &copy; 2001</a> O'Reilly &amp; Associates. All rights reserved.</font>
</p>
<map name="library-map"> <area shape="rect" coords="2,-1,79,99" href="../index.htm"><area shape="rect" coords="84,1,157,108" href="../perlnut/index.htm"><area shape="rect" coords="162,2,248,125" href="../prog/index.htm"><area shape="rect" coords="253,2,326,130" href="../advprog/index.htm"><area shape="rect" coords="332,1,407,112" href="../cookbook/index.htm"><area shape="rect" coords="414,2,523,103" href="../sysadmin/index.htm">
</map>

<!-- END OF BODY -->

</body>
</html>