📄 ch14_04.htm
字号:
<html><head><title>Tying Filehandles (Programming Perl)</title><!-- STYLESHEET --><link rel="stylesheet" type="text/css" href="../style/style1.css"><!-- METADATA --><!--Dublin Core Metadata--><meta name="DC.Creator" content=""><meta name="DC.Date" content=""><meta name="DC.Format" content="text/xml" scheme="MIME"><meta name="DC.Generator" content="XSLT stylesheet, xt by James Clark"><meta name="DC.Identifier" content=""><meta name="DC.Language" content="en-US"><meta name="DC.Publisher" content="O'Reilly & Associates, Inc."><meta name="DC.Source" content="" scheme="ISBN"><meta name="DC.Subject.Keyword" content=""><meta name="DC.Title" content="Tying Filehandles"><meta name="DC.Type" content="Text.Monograph"></head><body><!-- START OF BODY --><!-- TOP BANNER --><img src="gifs/smbanner.gif" usemap="#banner-map" border="0" alt="Book Home"><map name="banner-map"><AREA SHAPE="RECT" COORDS="0,0,466,71" HREF="index.htm" ALT="Programming Perl"><AREA SHAPE="RECT" COORDS="467,0,514,18" HREF="jobjects/fsearch.htm" ALT="Search this book"></map><!-- TOP NAV BAR --><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="ch14_01.htm">Chapter 14: Tied Variables</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></table></div><hr width="515" align="left"><!-- SECTION BODY --><h2 class="sect1">14.4. Tying Filehandles</h2><p><a name="INDEX-2733"></a><a name="INDEX-2734"></a><a name="INDEX-2735"></a><a name="INDEX-2736"></a><a name="INDEX-2737"></a><a name="INDEX-2738"></a>A class implementing a tied filehandle should define the followingmethods: <tt class="literal">TIEHANDLE</tt> and at least one of <tt class="literal">PRINT</tt>, <tt class="literal">PRINTF</tt>,<tt class="literal">WRITE</tt>, <tt class="literal">READLINE</tt>, <tt class="literal">GETC</tt>, and <tt class="literal">READ</tt>. The class can alsoprovide a <tt class="literal">DESTROY</tt> method, and <tt class="literal">BINMODE</tt>, <tt class="literal">OPEN</tt>, <tt class="literal">CLOSE</tt>,<tt class="literal">EOF</tt>, <tt class="literal">FILENO</tt>, <tt class="literal">SEEK</tt>, <tt class="literal">TELL</tt>, <tt class="literal">READ</tt>, and <tt class="literal">WRITE</tt> methods toenable the corresponding Perl built-ins for the tied filehandle.(Well, that isn't quite true: <tt class="literal">WRITE</tt> corresponds to <tt class="literal">syswrite</tt> andhas nothing to do with Perl's built-in <tt class="literal">write</tt> function for printingwith <tt class="literal">format</tt> declarations.)</p><p>Tied filehandles are especially useful when Perl is embedded inanother program (such as Apache or <em class="emphasis">vi</em>) and output to <tt class="literal">STDOUT</tt> or <tt class="literal">STDERR</tt> needs to beredirected in some special way.</p><p><a name="INDEX-2739"></a>But filehandles don't actually have to be tied to a file at all. Youcan use output statements to build up an in-memory data structure and inputstatements to read them back in. Here's an easy way to reverse a sequenceof <tt class="literal">print</tt> and <tt class="literal">printf</tt> statements without reversing the individual lines:<blockquote><pre class="programlisting">package ReversePrint;use strict;sub TIEHANDLE { my $class = shift; bless [], $class;}sub PRINT { my $self = shift; push @$self, join '', @_;}sub PRINTF { my $self = shift; my $fmt = shift; push @$self, sprintf $fmt, @_;}sub READLINE { my $self = shift; pop @$self;} package main;my $m = "--MORE--\n";tie *REV, "ReversePrint"; # Do some prints and printfs.print REV "The fox is now dead.$m";printf REV <<"END", int rand 10000000;The quick brown fox jumps overover the lazy dog %d times!END print REV <<"END";The quick brown fox jumpsover the lazy dog.END # Now read back from the same handle.print while <REV>;</pre></blockquote>This prints:<blockquote><pre class="programlisting">The quick brown fox jumps over the lazy dog.The quick brown fox jumps overover the lazy dog 3179357 times!The fox is now dead.--MORE--</pre></blockquote></p><h3 class="sect2">14.4.1. Filehandle-Tying Methods</h3><p><a name="INDEX-2740"></a><a name="INDEX-2741"></a>For our extended example, we'll create a filehandle that uppercasesstrings printed to it. Just for kicks, we'll begin the file with<tt class="literal"><SHOUT></tt> when it's opened and end with <tt class="literal"></SHOUT></tt> whenit's closed. That way we can rant in well-formed XML.</p><p>Here's the top of our <em class="emphasis">Shout.pm</em> file that will implement the class:<blockquote><pre class="programlisting">package Shout;use Carp; # So we can croak our errors</pre></blockquote>We'll now list the method definitions in <em class="emphasis">Shout.pm</em>.</p><dl><dt><b><em class="replaceable">CLASSNAME</em><tt class="literal">->TIEHANDLE(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p>This is the constructor for the class, which as usual should return ablessed reference.<blockquote><pre class="programlisting">sub TIEHANDLE { my $class = shift; my $form = shift; open my $self, $form, @_ or croak "can't open $form@_: $!"; if ($form =~ />/) { print $self "<SHOUT>\n"; $$self->{WRITING} = 1; # Remember to do end tag } return bless $self, $class; # $self is a glob ref}</pre></blockquote><a name="INDEX-"></a><a name="INDEX-"></a>Here, we open a new filehandle according to the mode and filenamepassed to the <tt class="literal">tie</tt> operator, write<tt class="literal"><SHOUT></tt> to the file, and return a blessedreference to it. There's a lot of stuff going on in that<tt class="literal">open</tt> statement, but we'll just point out that, inaddition to the usual "open or die" idiom, the <tt class="literal">my$self</tt> furnishes an undefined scalar to<tt class="literal">open</tt>, which knows to autovivify it into a typeglob. The fact that it's a typeglob is also significant, because not only does the typeglob contain the real I/O object of the file,but it also contains various other handy data structures that comealong for free, like a scalar (<tt class="literal">$$$self</tt>), an array(<tt class="literal">@$$self</tt>), and a hash (<tt class="literal">%$$self</tt>).(We won't mention the subroutine, <tt class="literal">&$$self</tt>.)</p><p>The <tt class="literal">$form</tt> is the filename-or-mode argument. Ifit's a filename, <tt class="literal">@_</tt> is empty, so it behaves as atwo-argument open. Otherwise, <tt class="literal">$form</tt> is the modefor the rest of the arguments.</p><p>After the open, we test to see whether we should write the beginningtag. If so, we do. And right away, we use one of those glob datastructures we mentioned. That <tt class="literal">$$self->{WRITING}</tt>is an example of using the glob to store interesting information. Inthis case, we remember whether we did the beginning tag so we knowwhether to do the corresponding end tag. We're using the<tt class="literal">%$$self</tt> hash, so we can give the field a decentname. We could have used the scalar as <tt class="literal">$$$self</tt>,but that wouldn't be self-documenting. (Or it would<em class="emphasis">only</em> be self-documenting, depending on how youlook at it.)</p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->PRINT(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p><a name="INDEX-"></a>This method implements a <tt class="literal">print</tt> to the tied handle.The <em class="replaceable">LIST</em> is whatever was passed to<tt class="literal">print</tt>. Our method below uppercases each element of<em class="replaceable">LIST</em>:<blockquote><pre class="programlisting">sub PRINT { my $self = shift; print $self map {uc} @_;}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->READLINE</tt></b></dt><dd><p><a name="INDEX-"></a><a name="INDEX-"></a>This method supplies the data when the filehandle is read from via theangle operator (<tt class="literal"><FH></tt>) or<tt class="literal">readline</tt>. The method should return<tt class="literal">undef</tt> when there is no more data.<blockquote><pre class="programlisting">sub READLINE { my $self = shift; return <$self>;}</pre></blockquote>Here, we simply <tt class="literal">return <$self></tt> so that themethod will behave appropriately depending on whether it was called inscalar or list context.</p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->GETC</tt></b></dt><dd><p><a name="INDEX-"></a>This method runs whenever <tt class="literal">getc</tt> is used on the tiedfilehandle.<blockquote><pre class="programlisting">sub GETC { my $self = shift; return getc($self);}</pre></blockquote>Like several of the methods in our <tt class="literal">Shout</tt> class, the<tt class="literal">GETC</tt> method simply calls its corresponding Perlbuilt-in and returns the result.</p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->OPEN(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p> Our <tt class="literal">TIEHANDLE</tt> method itself opensa file, but a program using the <tt class="literal">Shout</tt> class thatcalls <tt class="literal">open</tt> afterward triggers this method.<blockquote><pre class="programlisting">sub OPEN { my $self = shift; my $form = shift; my $name = "$form@_"; $self->CLOSE; open($self, $form, @_) or croak "can't reopen $name: $!"; if ($form =~ />/) { print $self "<SHOUT>\n" or croak "can't start print: $!"; $$self->{WRITING} = 1; # Remember to do end tag } else { $$self->{WRITING} = 0; # Remember not to do end tag } return 1;}</pre></blockquote><a name="INDEX-"></a>We invoke our own <tt class="literal">CLOSE</tt> method to explicitly close the file in casethe user didn't bother to. Then we open a new file with whateverfilename was specified in the <tt class="literal">open</tt> and shout at it.</p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->CLOSE</tt></b></dt><dd><p>This method deals with the request to close the handle.Here, we seek to the end of the file and, if that was successful, print<tt class="literal"></SHOUT></tt> before using Perl's built-in <tt class="literal">close</tt>.<blockquote><pre class="programlisting">sub CLOSE { my $self = shift; if ($$self->{WRITING}) { $self->SEEK(0, 2) or return; $self->PRINT("</SHOUT>\n") or return; } return close $self;}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->SEEK(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p><a name="INDEX-"></a>When you <tt class="literal">seek</tt> on a tied filehandle, the <tt class="literal">SEEK</tt> method gets called.<blockquote><pre class="programlisting">sub SEEK { my $self = shift; my ($offset, $whence) = @_; return seek($self, $offset, $whence);}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->TELL</tt></b></dt><dd><p><a name="INDEX-"></a>This method is invoked when <tt class="literal">tell</tt> is used on the tied handle.<blockquote><pre class="programlisting">sub TELL { my $self = shift; return tell $self;}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->PRINTF(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p><a name="INDEX-"></a>This method is run whenever <tt class="literal">printf</tt> is used on the tiedhandle. The <em class="replaceable">LIST</em> will contain the format and the items to be printed.<blockquote><pre class="programlisting">sub PRINTF { my $self = shift; my $template = shift; return $self->PRINT(sprintf $template, @_);}</pre></blockquote>Here, we use <tt class="literal">sprintf</tt> to generate the formatted string and pass itto <tt class="literal">PRINT</tt> for uppercasing. There's nothing that requiresyou to use the built-in <tt class="literal">sprintf</tt> function though. You couldinterpret the percent escapes to suit your own purpose.<a name="INDEX-"></a></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->READ(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p><a name="INDEX-"></a><a name="INDEX-"></a>This method responds when the handle is read using <tt class="literal">read</tt> or<tt class="literal">sysread</tt>. Note that we modify the first argumentof <em class="replaceable">LIST</em> "in-place", mimicking <tt class="literal">read</tt>'s ability to fill in thescalar passed in as its second argument.<blockquote><pre class="programlisting">sub READ { my ($self, undef, $length, $offset) = @_; my $bufref = \$_[1]; return read($self, $$bufref, $length, $offset);}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->WRITE(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p><a name="INDEX-"></a>This method gets invoked when the handle is written to with<tt class="literal">syswrite</tt>. Here, we uppercase the string to be written.<blockquote><pre class="programlisting">sub WRITE { my $self = shift; my $string = uc(shift); my $length = shift || length $string; my $offset = shift || 0; return syswrite $self, $string, $length, $offset;}</pre></blockquote></p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->EOF</tt></b></dt><dd><p><a name="INDEX-"></a>This method returns a Boolean value when a filehandle tied to the<tt class="literal">Shout</tt> class is tested for its end-of-file status using <tt class="literal">eof</tt>.<blockquote><pre class="programlisting">sub EOF { my $self = shift;⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -