📄 ch14_03.htm
字号:
<html><head><title>Tying Hashes (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 Hashes"><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_02.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_04.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.3. Tying Hashes</h2><p><a name="INDEX-2720"></a><a name="INDEX-2721"></a><a name="INDEX-2722"></a><a name="INDEX-2723"></a><a name="INDEX-2724"></a><a name="INDEX-2725"></a>A class implementing a tied hash should define eight methods.<tt class="literal">TIEHASH</tt> constructs new objects. <tt class="literal">FETCH</tt> and <tt class="literal">STORE</tt> access thekey/value pairs. <tt class="literal">EXISTS</tt> reports whether a key is present in thehash, and <tt class="literal">DELETE</tt> removes a key along with its associated value.<a href="#FOOTNOTE-2">[2]</a><tt class="literal">CLEAR</tt> empties the hash by deleting allkey/value pairs. <tt class="literal">FIRSTKEY</tt> and <tt class="literal">NEXTKEY</tt> iterate over the key/valuepairs when you call <tt class="literal">keys</tt>, <tt class="literal">values</tt>, or <tt class="literal">each</tt>. And as usual, ifyou want to perform particular actions when the object is deallocated,you may define a <tt class="literal">DESTROY</tt> method. (If this seems like a lot ofmethods, you didn't read the last section on arrays attentively.In any event, feel free to inherit the default methods from thestandard <tt class="literal">Tie::Hash</tt> module, redefining only the interesting ones.Again, <tt class="literal">Tie::StdHash</tt> assumes the implementation is also a hash.)<a name="INDEX-2726"></a><a name="INDEX-2727"></a></p><blockquote class="footnote"><a name="FOOTNOTE-2"></a><p>[2] Remember that Perldistinguishes between a key not existing in the hash and a keyexisting in the hash but having a corresponding value of <tt class="literal">undef</tt>. Thetwo possibilities can be tested with <tt class="literal">exists</tt> and <tt class="literal">defined</tt>,respectively.</p></blockquote><p>For example, suppose you want to create a hash where everytime you assign a value to a key, instead of overwritingthe previous contents, the new value is appended to an arrayof values. That way when you say:<blockquote><pre class="programlisting">$h{$k} = "one";$h{$k} = "two";</pre></blockquote>It really does:<blockquote><pre class="programlisting">push @{ $h{$k} }, "one";push @{ $h{$k} }, "two";</pre></blockquote>That's not a very complicated idea, so you should be able to use apretty simple module. Using <tt class="literal">Tie::StdHash</tt> as a base class, itis. Here's a <tt class="literal">Tie::AppendHash</tt> that does just that:<blockquote><pre class="programlisting">package Tie::AppendHash;use Tie::Hash;our @ISA = ("Tie::StdHash");sub STORE { my ($self, $key, $value) = @_; push @{$self->{key}}, $value;}1;</pre></blockquote></p><h3 class="sect2">14.3.1. Hash-Tying Methods</h3><p><a name="INDEX-2728"></a><a name="INDEX-2729"></a>Here's an example of an interesting tied-hash class: it gives you ahash representing a particular user's dot files (that is, files whosenames begin with a period, which is a naming convention forinitialization files under Unix). You index into the hash with thename of the file (minus the period) and get back that dot file'scontents. For example:<blockquote><pre class="programlisting">use DotFiles;tie %dot, "DotFiles";if ( $dot{profile} =~ /MANPATH/ or $dot{login} =~ /MANPATH/ or $dot{cshrc} =~ /MANPATH/ ) { print "you seem to set your MANPATH\n";}</pre></blockquote>Here's another way to use our tied class:<blockquote><pre class="programlisting"># Third argument is the name of a user whose dot files we will tie to.tie %him, "DotFiles", "daemon";foreach $f (keys %him) { printf "daemon dot file %s is size %d\n", $f, length $him{$f};}</pre></blockquote>In our <tt class="literal">DotFiles</tt> example we implement the object as a regular hashcontaining several important fields, of which only the <tt class="literal">{CONTENTS}</tt>field will contain what the user thinks of as the hash. Here are theobject's actual fields:</p><a name="perl3-tab-dotfilehash"></a><table border="1"><tr><th>Field</th><th>Contents</th></tr><tr><td><tt class="literal">USER</tt></td><td>Whose dot files this object represents.</td></tr><tr><td><tt class="literal">HOME</tt></td><td>Where those dot files live.</td></tr><tr><td><tt class="literal">CLOBBER</tt></td><td>Whether we are allowed to change or remove those dot files.</td></tr><tr><td><tt class="literal">CONTENTS</tt></td><td>The hash of dot file names and content mappings.</td></tr></table><p>Here's the start of <em class="emphasis">DotFiles.pm</em>:<blockquote><pre class="programlisting">package DotFiles;use Carp;sub whowasi { (caller(1))[3] . "()" }my $DEBUG = 0;sub debug { $DEBUG = @_ ? shift : 1 }</pre></blockquote>For our example, we want to be able to turn on debugging output tohelp in tracing during development, so we set up <tt class="literal">$DEBUG</tt> for that. We also keep one conveniencefunction around internally to help print out warnings: <tt class="literal">whowasi</tt>returns the name of the function that called the current function(<tt class="literal">whowasi</tt>'s "grandparent" function).</p><p>Here are the methods for the <tt class="literal">DotFiles</tt> tied hash:</p><dl><dt><b><em class="replaceable">CLASSNAME</em><tt class="literal">->TIEHASH(</tt><em class="replaceable">LIST</em><tt class="literal">)</tt></b></dt><dd><p>Here's the <tt class="literal">DotFiles</tt> constructor:<blockquote><pre class="programlisting">sub TIEHASH { my $self = shift; my $user = shift || $>; my $dotdir = shift || ""; croak "usage: @{[ &whowasi ]} [USER [DOTDIR]]" if @_; $user = getpwuid($user) if $user =~ /^\d+$/; my $dir = (getpwnam($user))[7] or croak "@{ [&whowasi] }: no user $user"; $dir .= "/$dotdir" if $dotdir; my $node = { USER => $user, HOME => $dir, CONTENTS => {}, CLOBBER => 0, }; opendir DIR, $dir or croak "@{[&whowasi]}: can't opendir $dir: $!"; for my $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) { $dot =~ s/^\.//; $node->{CONTENTS}{$dot} = undef; } closedir DIR; return bless $node, $self;}</pre></blockquote>It's probably worth mentioning that if you're going to apply filetests to the values returned by the above <tt class="literal">readdir</tt>, you'd betterprepend the directory in question (as we do). Otherwise, since no<tt class="literal">chdir</tt> was done, you'd likely be testing the wrong file.</p></dd><dt><b><em class="replaceable">SELF</em><tt class="literal">->FETCH(</tt><em class="replaceable">KEY</em><tt class="literal">)</tt></b></dt><dd><p>This method implements reading an element from the tied hash. It takes one argument after the object: the keywhose value we're trying to fetch. The key is a string, and you cando anything you like with it (consistent with its being a string).</p><p>Here's the fetch for our <tt class="literal">DotFiles</tt> example:<blockquote><pre class="programlisting">sub FETCH { carp &whowasi if $DEBUG; my $self = shift;⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -