ch14_01.htm

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

$string .= "And here is another line, automatically appended.\n";</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;DESTROY</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a>
This method is triggered when the object associated with the tied
variable is about to be garbage collected, in case it needs to do something
special to clean up after itself.  As with other classes, such a
method is seldom necessary, since Perl deallocates the moribund
object's memory for you automatically.  Here, we'll define a
<tt class="literal">DESTROY</tt> method that decrements our count of tied files:
<blockquote>
<pre class="programlisting">sub DESTROY {
    my $self = shift;
    confess "wrong type" unless ref $self;
    $count--;
}</pre>
</blockquote>

We might then also supply an extra class method to retrieve the current
count.  Actually, it doesn't care whether it's called as a class method
or an object method, but you don't have an object anymore after the
<tt class="literal">DESTROY</tt>, now do you?
<blockquote>
<pre class="programlisting">sub count {
    # my $invocant = shift;
    $count;
}</pre>
</blockquote>

You can call this as a class method at any time like this:
<blockquote>
<pre class="programlisting">if (ScalarFile-&gt;count) {
    warn "Still some tied ScalarFiles sitting around somewhere...\n";
}</pre>
</blockquote>
</p>
</dd>

</dl>

<p>
</p>

<p>That's about all there is to it.  Actually, it's more than all there is
to it, since we've done a few nice things here for the sake of
completeness, robustness, and general aesthetics (or lack thereof).
Simpler <tt class="literal">TIESCALAR</tt> classes are certainly possible.</p>

<a name="INDEX-2689"></a><a name="INDEX-2690"></a><a name="INDEX-2691"></a>






<h3 class="sect2">14.1.2. Magical Counter Variables</h3>

<p>
<a name="INDEX-2692"></a><a name="INDEX-2693"></a><a name="INDEX-2694"></a><a name="INDEX-2695"></a>
Here's a simple <tt class="literal">Tie::Counter</tt> class, inspired by the
CPAN module of the same name.  Variables tied to this class
increment themselves by 1 every time they're used.  For example:
<blockquote>
<pre class="programlisting">tie my $counter, "Tie::Counter", 100;
@array = qw /Red Green Blue/;
for my $color (@array) {               # Prints:
    print "  $counter  $color\n";      #   100  Red
}                                      #   101  Green
                                       #   102  Blue</pre>
</blockquote>

The constructor takes as an optional extra argument the first value
of the counter, which defaults to 0.  Assigning to the counter will
set a new value.  Here's the class:
<blockquote>
<pre class="programlisting">package Tie::Counter;
sub FETCH     { ++ ${ $_[0] } }
sub STORE     { ${ $_[0] } = $_[1] }
sub TIESCALAR {
    my ($class, $value) = @_;
    $value = 0 unless defined $value;
    bless \$value =&gt; $class;
}
1;  # if in module</pre>
</blockquote>

See how small that is?  It doesn't take much code to put together
a class like this.</p>






<h3 class="sect2">14.1.3. Magically Banishing $_</h3>

<p>
<a name="INDEX-2696"></a><a name="INDEX-2697"></a>
This curiously exotic tie class is used to outlaw unlocalized uses of
<tt class="literal">$_</tt>.  Instead of pulling in the module with
<tt class="literal">use</tt>, which invokes the class's
<tt class="literal">import</tt> method, this module should be loaded with
<tt class="literal">no</tt> to call the seldom-used
<tt class="literal">unimport</tt> method.  The user says:
<blockquote>
<pre class="programlisting">no Underscore;</pre>
</blockquote>

And then all uses of <tt class="literal">$_</tt> as an unlocalized global raise an exception.</p>

<p>Here's a little test suite for the module:
<blockquote>
<pre class="programlisting">#!/usr/bin/perl
no Underscore;
@tests = (
    "Assignment"  =&gt; sub { $_ = "Bad" },
    "Reading"     =&gt; sub { print },
    "Matching"    =&gt; sub { $x = /badness/ },
    "Chop"        =&gt; sub { chop },
    "Filetest"    =&gt; sub { -x },
    "Nesting"     =&gt; sub { for (1..3) { print } },
);

while ( ($name, $code) = splice(@tests, 0, 2) ) {
    print "Testing $name: ";
    eval { &amp;$code };
    print $@ ? "detected" : " missed!";
    print "\n";
}</pre>
</blockquote>

which prints out the following:
<blockquote>
<pre class="programlisting">Testing Assignment: detected
Testing Reading: detected
Testing Matching: detected
Testing Chop: detected
Testing Filetest: detected
Testing Nesting: 123 missed!</pre>
</blockquote>

The last one was "missed" because it was properly localized
by the <tt class="literal">for</tt> loop and thus safe to access.</p>

<p>
<a name="INDEX-2698"></a>
Here's the curiously exotic <tt class="literal">Underscore</tt> module
itself.  (Did we mention that it's curiously exotic?)  It works
because tied magic is effectively hidden by a
<tt class="literal">local</tt>.  The module does the <tt class="literal">tie</tt>
in its own initialization code so that a <tt class="literal">require</tt>
also works.
<blockquote>
<pre class="programlisting">package Underscore;
use Carp;
sub TIESCALAR { bless \my $dummy =&gt; shift }
sub FETCH { croak 'Read access to $_ forbidden'  }
sub STORE { croak 'Write access to $_ forbidden' }
sub unimport { tie($_, __PACKAGE__) }
sub import   { untie $_ }
tie($_, __PACKAGE__) unless tied $_;
1;</pre>
</blockquote>

It's hard to usefully mix calls to <tt class="literal">use</tt> and
<tt class="literal">no</tt> for this class in your program, because they all
happen at compile time, not run time.  You could call
<tt class="literal">Underscore-&gt;import</tt> and
<tt class="literal">Underscore-&gt;unimport</tt> directly, just as
<tt class="literal">use</tt> and <tt class="literal">no</tt> do.  Normally,
though, to renege and let yourself freely use <tt class="literal">$_</tt>
again, you'd just use <tt class="literal">local</tt> on it, which is the
whole point.</p>

<a name="INDEX-2699"></a><a name="INDEX-2700"></a><a name="INDEX-2701"></a>























































<a name="INDEX-2797"></a><a name="INDEX-2798"></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="ch13_10.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_02.htm"><img src="../gifs/txtnexta.gif" alt="Next" border="0"></a></td>
</tr>
<tr>
<td align="left" valign="top" width="172">13.10. Overloading Diagnostics</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.2. Tying Arrays</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>