ch14_01.htm

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

<tt class="literal">Tie::Scalar</tt> provides elemental methods that do very
little, and <tt class="literal">Tie::StdScalar</tt> provides methods that
make a tied scalar behave like a regular Perl scalar.  (Which seems
singularly useless, but sometimes you just want a bit of a wrapper
around the ordinary scalar semantics, for example, to count the number
of times a particular variable is set.)
<a name="INDEX-2682"></a><a name="INDEX-2683"></a>
</p>

<p>Before we show you our elaborate example and complete description of
all the mechanics, here's a taste just to whet your appetite--and to
show you how easy it really is.  Here's a complete program:
<blockquote>
<pre class="programlisting">#!/usr/bin/perl
package Centsible;
sub TIESCALAR { bless \my $self, shift }
sub STORE { ${ $_[0] } = $_[1] }  # do the default thing
sub FETCH { sprintf "%.02f", ${ my $self = shift } } # round value

package main;
tie $bucks, "Centsible";
$bucks = 45.00;
$bucks *= 1.0715; # tax
$bucks *= 1.0715; # and double tax!
print "That will be $bucks, please.\n";</pre>
</blockquote>

When run, that program produces:
<blockquote>
<pre class="programlisting">That will be 51.67, please.</pre>
</blockquote>

To see the difference it makes, comment out the call
to <tt class="literal">tie</tt>; then you'll get:
<blockquote>
<pre class="programlisting">That will be 51.66505125, please.</pre>
</blockquote>

Admittedly, that's more work than you'd normally go through to
round numbers.</p>


<h3 class="sect2">14.1.1. Scalar-Tying Methods</h3>

<p>
<a name="INDEX-2684"></a><a name="INDEX-2685"></a><a name="INDEX-2686"></a>
Now that you've seen a sample of what's to come, let's develop a more
elaborate scalar-tying class.  Instead of using any canned package for
the base class (especially since scalars are so simple), we'll look at
each of the four methods in turn, building an example class named
<tt class="literal">ScalarFile</tt>.  Scalars tied to this class contain
regular strings, and each such variable is implicitly associated with
a file where that string is stored.  (You might name your variables to
remind you which file you're referring to.)  Variables are tied to the
class this way:
<blockquote>
<pre class="programlisting">use ScalarFile;       # load ScalarFile.pm
tie $camel, "ScalarFile", "/tmp/camel.lot";</pre>
</blockquote>

Once the variable has been tied, its previous contents are clobbered,
and the internal connection between the variable and its object
overrides the variable's normal semantics.  When you ask for the value
of <tt class="literal">$camel</tt>, it now reads the contents of
<em class="emphasis">/tmp/camel.lot</em>, and when you assign a value to
<tt class="literal">$camel</tt>, it writes the new contents out to
<em class="emphasis">/tmp/camel.lot</em>, obliterating any previous
occupants.</p>

<p>The tie is on the variable, not the value, so the tied nature of a
variable does not propagate across assignment.  For example, let's say
you copy a variable that's been tied:
<blockquote>
<pre class="programlisting">$dromedary = $camel;</pre>
</blockquote>
</p>

<p>Instead of
reading the value in the ordinary fashion from the
<tt class="literal">$camel</tt> scalar variable, Perl invokes the
<tt class="literal">FETCH</tt> method on the associated underlying object.
It's as though you'd written this:
<blockquote>
<pre class="programlisting">$dromedary = (tied $camel)-&gt;FETCH():</pre>
</blockquote>
<a name="INDEX-2687"></a>
Or if you remember the object returned by <tt class="literal">tie</tt>, you
could use that reference directly, as in the following sample code:
<blockquote>
<pre class="programlisting">$clot = tie $camel, "ScalarFile", "/tmp/camel.lot";
$dromedary = $camel;          # through the implicit interface
$dromedary = $clot-&gt;FETCH();  # same thing, but explicitly</pre>
</blockquote>

If the class provides methods besides <tt class="literal">TIESCALAR</tt>,
<tt class="literal">FETCH</tt>, <tt class="literal">STORE</tt>, and
<tt class="literal">DESTROY</tt>, you could use <tt class="literal">$clot</tt> to
invoke them manually.  However, one normally minds one's own business
and leaves the underlying object alone, which is why you often see the
return value from <tt class="literal">tie</tt> ignored.  You can still get
at the object via <tt class="literal">tied</tt> if you need it later (for
example, if the class happens to document any extra methods you need).
Ignoring the returned object also eliminates certain kinds of errors,
which we'll cover later.</p>

<p>Here's the preamble of our class, which we will put into
<em class="emphasis">ScalarFile.pm</em>:
<blockquote>
<pre class="programlisting">package ScalarFile;
use Carp;                # Propagate error messages nicely.
use strict;              # Enforce some discipline on ourselves.
use warnings;            # Turn on lexically scoped warnings.
use warnings::register;  # Allow user to say "use warnings 'ScalarFile'".
my $count = 0;           # Internal count of tied ScalarFiles.</pre>
</blockquote>
<a name="INDEX-2688"></a>
The standard <tt class="literal">Carp</tt> module exports the
<tt class="literal">carp</tt>, <tt class="literal">croak</tt>, and
<tt class="literal">confess</tt> subroutines, which we'll use in the code
later in this section.  As usual, see <a href="ch32_01.htm">Chapter 32, "Standard Modules"</a>, or the online docs for more
about <tt class="literal">Carp</tt>.</p>

<p>The following methods are defined by the class.</p>

<dl>
<dt>
<b><em class="replaceable">CLASSNAME</em><tt class="literal">-&gt;TIESCALAR(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>  The <tt class="literal">TIESCALAR</tt> method
of the class is triggered whenever you <tt class="literal">tie</tt> a scalar
variable.  The optional <em class="replaceable">LIST</em> contains any
parameters needed to initialize the object properly.  (In our example,
there is only one parameter: the name of the file.) The method should
return an object, but this doesn't have to be a reference to a scalar.
In our example, though, it is.
<blockquote>
<pre class="programlisting">sub TIESCALAR {           # in ScalarFile.pm
    my $class    = shift;
    my $filename = shift;
    $count++;             # A file-scoped lexical, private to class.
    return bless \$filename, $class;
}</pre>
</blockquote>
Since there's no scalar equivalent to the anonymous array and hash
composers, <tt class="literal">[]</tt> and <tt class="literal">{}</tt>, we merely
bless a lexical variable's referent, which effectively becomes
anonymous as soon as the name goes out of scope.  This works fine (you
could do the same thing with arrays and hashes) as long as the
variable really is lexical.  If you try this trick on a global, you
might think you're getting away with it, until you try to create
another <em class="filename">camel.lot</em>.  Don't be tempted to write
something like this:
<blockquote>
<pre class="programlisting">sub TIESCALAR { bless \$_[1], $_[0] }    # WRONG, could refer to global.</pre>
</blockquote>
A more robustly written constructor might check that the filename is
accessible.  We check first to see if the file is readable, since we
don't want to clobber the existing value.  (In other words, we
shouldn't assume the user is going to write first.  They might be
treasuring their old Camel Lot file from a previous run of the
program.) If we can't open or create the filename specified, we'll
indicate the error gently by returning <tt class="literal">undef</tt> and
optionally printing a warning via <tt class="literal">carp</tt>.  (We could
just <tt class="literal">croak</tt> instead--it's a matter of taste whether
you prefer fish or frogs.) We'll use the <tt class="literal">warnings</tt>
pragma to determine whether the user is interested in our warning:
<blockquote>
<pre class="programlisting">sub TIESCALAR {           # in ScalarFile.pm
    my $class    = shift;
    my $filename = shift;
    my $fh;
    if (open $fh, "&lt;", $filename or
        open $fh, "&gt;", $filename)
    {
        close $fh;
        $count++;
        return bless \$filename, $class;
    }
    carp "Can't tie $filename: $!" if warnings::enabled();
    return;
}</pre>
</blockquote>
Given such a constructor, we can now associate the scalar
<tt class="literal">$string</tt> with the file
<em class="filename">camel.lot</em>:</p>

<blockquote>
<pre class="programlisting">tie ($string, "ScalarFile", "camel.lot") or die;</pre>
</blockquote>

<p>
<a name="INDEX-"></a>
(We're still assuming some things we shouldn't.  In a production
version of this, we'd probably open the filehandle once and remember
the filehandle as well as the filename for the duration of the tie,
keeping the handle exclusively locked with <tt class="literal">flock</tt>
the whole time.  Otherwise we're open to race conditions--see "Timing
Glitches" in <a href="ch23_01.htm">Chapter 23, "Security"</a>.)</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;FETCH</tt></b>
</dt>
<dd>
<p>This method is invoked whenever you access the tied variable (that is,
read its value).  It takes no arguments beyond the object tied to the
variable.  In our example, that object contains the filename.
<blockquote>
<pre class="programlisting">sub FETCH {
    my $self  = shift;
    confess "I am not a class method" unless ref $self;
    return unless open my $fh, $$self;
    read($fh, my $value, -s $fh);  # NB: don't use -s on pipes!
    return $value;
}</pre>
</blockquote>

This time we've decided to blow up (raise an exception) if
<tt class="literal">FETCH</tt> gets something other than a reference.
(Either it was invoked as a class method, or someone miscalled it as a
subroutine.) There's no other way for us to return an error, so it's
probably the right thing to do.  In fact, Perl would have raised an
exception in any event as soon as we tried to dereference
<tt class="literal">$self</tt>; we're just being polite and using
<tt class="literal">confess</tt> to spew a complete stack backtrace onto the
user's screen.  (If that can be considered polite.)</p>

<p>We can now see the contents of <em class="filename">camel.lot</em> when we say this:
<blockquote>
<pre class="programlisting">tie($string, "ScalarFile", "camel.lot");
print $string;</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;STORE(</tt><em class="replaceable">VALUE</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a>
This method is run when the tied variable is set (assigned).  The
first argument, <em class="replaceable">SELF</em>, is as always the object associated with the
variable; <em class="replaceable">VALUE</em> is whatever was assigned to the variable.  (We
use the term "assigned" loosely--any operation that modifies
the variable can call <tt class="literal">STORE</tt>.)
<blockquote>
<pre class="programlisting">sub STORE {
    my($self,$value) = @_;
    ref $self                   or confess "not a class method";
    open my $fh, "&gt;", $$self    or croak "can't clobber $$self: $!";
    syswrite($fh, $value) == length $value
                                or croak "can't write to $$self: $!";
    close $fh                   or croak "can't close $$self: $!";
    return $value;
}</pre>
</blockquote>
After "assigning" it, we return the new value--because that's what
assignment does.  If the assignment wasn't successful, we
<tt class="literal">croak</tt> out the error.  Possible causes might be that
we didn't have permission to write to the associated file, or the disk
filled up, or gremlins infested the disk controller.  Sometimes you
control the magic, and sometimes the magic controls you.</p>

<p>We can now write to <em class="filename">camel.lot</em> when we say this:
<blockquote>
<pre class="programlisting">tie($string, "ScalarFile", "camel.lot");
$string  = "Here is the first line of camel.lot\n";