ch14_04.htm

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

    return eof $self;
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;BINMODE(</tt><em class="replaceable">DISC</em><tt class="literal">)</tt></b>
</dt>
<dd>
<p>This method specifies the I/O discipline to be used on the filehandle.  If
none is specified, it puts the tied filehandle into binary mode (the
<tt class="literal">:raw</tt> discipline), for filesystems that distinguish between text and
binary files.
<blockquote>
<pre class="programlisting">sub BINMODE {
    my $self = shift;
    my $disc = shift || ":raw";
    return binmode $self, $disc;
}</pre>
</blockquote>

That's how you'd write it, but it's actually useless in our case
because the <tt class="literal">open</tt> already wrote on the handle.  So in our case we should
probably make it say:
<blockquote>
<pre class="programlisting">sub BINMODE { croak("Too late to use binmode") }</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;FILENO</tt></b>
</dt>
<dd>
<p>
<a name="INDEX-"></a><a name="INDEX-"></a>
This method should return the file descriptor (<tt class="literal">fileno</tt>) associated
with the tied filehandle by the operating system.
<blockquote>
<pre class="programlisting">sub FILENO {
    my $self = shift;
    return fileno $self;
}</pre>
</blockquote>
</p>
</dd>


<dt>
<b><em class="replaceable">SELF</em><tt class="literal">-&gt;DESTROY</tt></b>
</dt>
<dd>
<p>As with the other types of ties, this method is triggered when the tied
object is about to be destroyed.  This is useful for letting the
object clean up after itself.  Here, we make sure that the file is
closed, in case the program forgot to call <tt class="literal">close</tt>.  We could just
say <tt class="literal">close $self</tt>, but it's better to invoke the <tt class="literal">CLOSE</tt> method of
the class.  That way if the designer of the class decides to change
how files are closed, this <tt class="literal">DESTROY</tt> method won't have to be modified.
<blockquote>
<pre class="programlisting">sub DESTROY {
    my $self = shift;
    $self-&gt;CLOSE;      # Close the file using Shout's CLOSE method.
}</pre>
</blockquote>
</p>
</dd>

</dl>

<p>
</p>

<p>Here's a demonstration of our <tt class="literal">Shout</tt> class:
<blockquote>
<pre class="programlisting">#!/usr/bin/perl
use Shout;
tie(*FOO, Shout::, "&gt;filename");
print FOO "hello\n";            # Prints HELLO.
seek FOO, 0, 0;                 # Rewind to beginning.
@lines = &lt;FOO&gt;;                 # Calls the READLINE method.
close FOO;                      # Close file explicitly.
open(FOO, "+&lt;", "filename");    # Reopen FOO, calling OPEN.
seek(FOO, 8, 0);                # Skip the "&lt;SHOUT&gt;\n".
sysread(FOO, $inbuf, 5);        # Read 5 bytes from FOO into $inbuf.
print "found $inbuf\n";         # Should print "hello".
seek(FOO, -5, 1);               # Back up over the "hello".
syswrite(FOO, "ciao!\n", 6);    # Write 6 bytes into FOO.
untie(*FOO);                    # Calls the CLOSE method implicitly.</pre>
</blockquote>

After running this, the file contains:
<blockquote>
<pre class="programlisting">&lt;SHOUT&gt;
CIAO!
&lt;/SHOUT&gt;</pre>
</blockquote>
<a name="INDEX-2742"></a><a name="INDEX-2743"></a>
Here are some more strange and wonderful things to do with that internal glob.  We
use the same hash as before, but with new keys <tt class="literal">PATHNAME</tt> and <tt class="literal">DEBUG</tt>.
First we install a stringify overloading so that printing one of our
objects reveals the pathname (see <a href="ch13_01.htm">Chapter 13, "Overloading"</a>):
<blockquote>
<pre class="programlisting"># This is just so totally cool!
use overload q("") =&gt; sub { $_[0]-&gt;pathname };

# This is the stub to put in each function you want to trace.
sub trace {
    my $self = shift;
    local $Carp::CarpLevel = 1;
    Carp::cluck("\ntrace magical method") if $self-&gt;debug;
}

# Overload handler to print out our path.
sub pathname {
    my $self = shift;
    confess "i am not a class method" unless ref $self;
    $$self-&gt;{PATHNAME} = shift if @_;
    return $$self-&gt;{PATHNAME};
}
# Dual moded.
sub debug {
    my $self = shift;
    my $var = ref $self ? \$$self-&gt;{DEBUG} : \our $Debug;
    $$var = shift if @_;
    return ref $self ? $$self-&gt;{DEBUG} || $Debug : $Debug;
}</pre>
</blockquote>

And then call <tt class="literal">trace</tt> on entry to all your ordinary methods like this:
<blockquote>
<pre class="programlisting">sub GETC { $_[0]-&gt;trace;           # NEW
    my($self) = @_;
    getc($self);
}</pre>
</blockquote>
And also set the pathname in <tt class="literal">TIEHANDLE</tt> and
<tt class="literal">OPEN</tt>:
<blockquote>
<pre class="programlisting">sub TIEHANDLE {
    my $class    = shift;
    my $form = shift;
    my $name = "$form@_";          # NEW
    open my $self, $form, @_   or croak "can't open $name: $!";
    if ($form =~ /&gt;/) {
        print $self  "&lt;SHOUT&gt;\n";
        $$self-&gt;{WRITING} = 1;     # Remember to do end tag
    }
    bless $self, $class;           # $fh is a glob ref
    $self-&gt;pathname($name);        # NEW
    return $self;
}

sub OPEN { $_[0]-&gt;trace;           # NEW
    my $self = shift;
    my $form = shift;
    my $name = "$form@_";          
    $self-&gt;CLOSE;
    open($self, $form, @_)      or croak "can't reopen $name: $!";
    $self-&gt;pathname($name);        # NEW
    if ($form =~ /&gt;/) {
        print $self "&lt;SHOUT&gt;\n" or croak "can't start print: $!";
        $$self-&gt;{WRITING} = 1;     # Remember to do end tag
    }
    else {
        $$self-&gt;{WRITING} = 0;     # Remember not to do end tag
    }
    return 1;
}</pre>
</blockquote>
<a name="INDEX-2744"></a>
Somewhere you also have to call <tt class="literal">$self-&gt;debug(1)</tt>
to turn debugging on.  When you do that, all your
<tt class="literal">Carp::cluck</tt> calls will produce meaningful messages.
Here's one that we get while doing the reopen above.  It shows us
three deep in method calls, as we're closing down the old file in
preparation for opening the new one:
<blockquote>
<pre class="programlisting">trace magical method at foo line 87
    Shout::SEEK('&gt;filename', '&gt;filename', 0, 2) called at foo line 81
    Shout::CLOSE('&gt;filename') called at foo line 65
    Shout::OPEN('&gt;filename', '+&lt;', 'filename') called at foo line 141</pre>
</blockquote>
</p>






<h3 class="sect2">14.4.2. Creative Filehandles</h3>

<p>
<a name="INDEX-2745"></a><a name="INDEX-2746"></a><a name="INDEX-2747"></a>
You can <tt class="literal">tie</tt> the same filehandle to both the input
and the output of a two-ended pipe.  Suppose you wanted to run the
<em class="emphasis">bc</em>(1) (arbitrary precision calculator)
program this way:
<blockquote>
<pre class="programlisting">use Tie::Open2;

tie *CALC, 'Tie::Open2', "bc -l";
$sum = 2;
for (1 .. 7) {
    print CALC "$sum * $sum\n";
    $sum = &lt;CALC&gt;;
    print "$_: $sum";
    chomp $sum;
}
close CALC;</pre>
</blockquote>

One would expect it to print this:
<blockquote>
<pre class="programlisting">1: 4
2: 16
3: 256
4: 65536
5: 4294967296
6: 18446744073709551616
7: 340282366920938463463374607431768211456</pre>
</blockquote>

One's expectations would be correct if one had the <em class="emphasis">bc</em>(1) program on
one's computer, and one also had <tt class="literal">Tie::Open2</tt> defined as follows.
This time we'll use a blessed array for our internal object.  It
contains our two actual filehandles for reading and writing.  (The
dirty work of opening a double-ended pipe is done by <tt class="literal">IPC::Open2</tt>;
we're just doing the fun part.)
<blockquote>
<pre class="programlisting">package Tie::Open2;
use strict;
use Carp;
use Tie::Handle;  # do not inherit from this!
use IPC::Open2;

sub TIEHANDLE {
    my ($class, @cmd) = @_;
    no warnings 'once';
    my @fhpair = \do { local(*RDR, *WTR) };
    bless $_, 'Tie::StdHandle' for @fhpair;
    bless(\@fhpair =&gt; $class)-&gt;OPEN(@cmd) || die;
    return \@fhpair;
}

sub OPEN {
    my ($self, @cmd) = @_;
    $self-&gt;CLOSE if grep {defined} @{ $self-&gt;FILENO };
    open2(@$self, @cmd);
}

sub FILENO {
    my $self = shift;
    [ map { fileno $self-&gt;[$_] } 0,1 ];
}

for my $outmeth ( qw(PRINT PRINTF WRITE) ) {
    no strict 'refs';
    *$outmeth = sub {
        my $self = shift;
        $self-&gt;[1]-&gt;$outmeth(@_);
    };
}
for my $inmeth ( qw(READ READLINE GETC) ) {
    no strict 'refs';
    *$inmeth = sub {
        my $self = shift;
        $self-&gt;[0]-&gt;$inmeth(@_);
    };
}
for my $doppelmeth ( qw(BINMODE CLOSE EOF)) {
    no strict 'refs';
    *$doppelmeth = sub {
        my $self = shift;
        $self-&gt;[0]-&gt;$doppelmeth(@_) &amp;&amp; $self-&gt;[1]-&gt;$doppelmeth(@_);
    };
}
for my $deadmeth ( qw(SEEK TELL)) {
    no strict 'refs';
    *$deadmeth = sub {
        croak("can't $deadmeth a pipe");
    };
}
1;</pre>
</blockquote>

The final four loops are just incredibly snazzy, in our opinion.  For
an explanation of what's going on, look back at the section <a href="ch08_03.htm#ch08-sect-clos">Section 14.3.7.1, "Closures as function templates"</a> in <a href="ch08_01.htm">Chapter 8, "References"</a>.</p>

<p>
<a name="INDEX-2748"></a><a name="INDEX-2749"></a><a name="INDEX-2750"></a>
Here's an even wackier set of classes.  The package names should give you a
clue as to what they do.
<blockquote>
<pre class="programlisting">use strict;
package Tie::DevNull;

    sub TIEHANDLE {
        my $class = shift;
        my $fh = local *FH;
        bless \$fh, $class;
    }
    for (qw(READ READLINE GETC PRINT PRINTF WRITE)) {
        no strict 'refs';
        *$_  = sub { return };
    }

package Tie::DevRandom;

    sub READLINE { rand() . "\n"; }
    sub TIEHANDLE {
        my $class = shift;
        my $fh = local *FH;
        bless \$fh, $class;
    }

    sub FETCH { rand() }
    sub TIESCALAR {
        my $class = shift;
        bless \my $self, $class;
    }

package Tie::Tee;

    sub TIEHANDLE {
        my $class = shift;
        my @handles;
        for my $path (@_) {
            open(my $fh, "&gt;$path") || die "can't write $path";
            push @handles, $fh;
        }
        bless \@handles, $class;
    }

    sub PRINT {
        my $self = shift;
        my $ok = 0;
        for my $fh (@$self) {
            $ok += print $fh @_;
        }
        return $ok == @$self;
    }</pre>
</blockquote>
<a name="INDEX-2751"></a><a name="INDEX-2752"></a><a name="INDEX-2753"></a>
The <tt class="literal">Tie::Tee</tt> class emulates the standard Unix
<em class="emphasis">tee</em>(1) program, which sends one stream of
output to multiple different destinations.  The
<tt class="literal">Tie::DevNull</tt> class emulates the null device,
<em class="emphasis">/dev/null</em> on Unix systems.  And the
<tt class="literal">Tie::DevRandom</tt> class produces random numbers either
as a handle or as a scalar, depending on whether you call
<tt class="literal">TIEHANDLE</tt> or <tt class="literal">TIESCALAR</tt>!
Here's how you call them:
<blockquote>
<pre class="programlisting">package main;

tie *SCATTER,   "Tie::Tee", qw(tmp1 - tmp2 &gt;tmp3 tmp4);
tie *RANDOM,    "Tie::DevRandom";
tie *NULL,      "Tie::DevNull";
tie my $randy,  "Tie::DevRandom";

for my $i (1..10) {
    my $line = &lt;RANDOM&gt;;
    chomp $line;
    for my $fh (*NULL, *SCATTER) {
        print $fh "$i: $line $randy\n";
    }
}</pre>
</blockquote>
This produces something like the following on your screen:
<blockquote>
<pre class="programlisting">1: 0.124115571686165 0.20872819474074
2: 0.156618299751194 0.678171662366353
3: 0.799749050426126 0.300184963960792
4: 0.599474551447884 0.213935286029916
5: 0.700232143543861 0.800773751296671
6: 0.201203608274334 0.0654303290639575
7: 0.605381294683365 0.718162304090487
8: 0.452976481105495 0.574026269121667
9: 0.736819876983848 0.391737610662044
10: 0.518606540417331 0.381805078272308</pre>
</blockquote>
But that's not all!  It wrote to your screen because of the
<tt class="literal">-</tt> in the <tt class="literal">*SCATTER</tt><tt class="literal">tie</tt> above.  But that line also told it to create
files <em class="emphasis">tmp1</em>, <em class="emphasis">tmp2</em>, and
<em class="emphasis">tmp4</em>, as well as to append to file
<em class="emphasis">tmp3</em>.  (We also wrote to the
<tt class="literal">*NULL</tt> filehandle in the loop, though of course that
didn't show up anywhere interesting, unless you're interested in black
holes.)
<a name="INDEX-2754"></a><a name="INDEX-2755"></a>
</p>

<a name="INDEX-2756"></a><a name="INDEX-2757"></a><a name="INDEX-2758"></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_03.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_05.htm"><img src="../gifs/txtnexta.gif" alt="Next" border="0"></a></td>
</tr>
<tr>
<td align="left" valign="top" width="172">14.3. Tying Hashes</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.5. A Subtle Untying Trap</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>