ch24_04.htm

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

<blockquote>
<pre class="programlisting">sub bark {
    my DOG $spot = shift;
    my %parm = @_;
    my $quality  = $parm{QUALITY}  || "yapping";
    my $quantity = $parm{QUANTITY} || "nonstop"; 
    ...
}

$fido-&gt;bark( QUANTITY =&gt; "once",
              QUALITY =&gt; "woof" );</pre>
</blockquote>

Named parameters are often an affordable luxury.  And with Perl, you
get them for free, if you don't count the cost of the hash assignment.</p>
</li>
<li>
<p>Repeat Boolean expressions until false.</p>
</li>
<li>
<p>Use minimal matching when appropriate.</p>
</li>
<li>
<p>Use the <tt class="literal">/e</tt> modifier to evaluate a replacement expression:
<blockquote>
<pre class="programlisting">#!/usr/bin/perl -p
1 while s/^(.*?)(\t+)/$1 . ' ' x (length($2) * 4 - length($1) % 4)/e;</pre>
</blockquote>

This program fixes any file you receive from someone who mistakenly
thinks they can redefine hardware tabs to occupy 4 spaces instead
of 8.  It makes use of several important idioms.  First, the <tt class="literal">1 while</tt> idiom
is handy when all the work you want to do in the loop is actually done
by the conditional.  (Perl is smart enough not to warn you that you're
using <tt class="literal">1</tt> in a void context.) We have to repeat this substitution because
each time we substitute some number of spaces in for tabs, we have to
recalculate the column position of the next tab from the beginning.</p>

<p>The <tt class="literal">(.*?)</tt> matches the smallest string it can up until the first tab,
using the minimal matching modifier (the question mark).  In this case,
we could have used an ordinary greedy <tt class="literal">*</tt> like this: <tt class="literal">([^\t]*)</tt>.  But
that only works because a tab is a single character, so we can use a
negated character class to avoid running past the first tab.  In general,
the minimal matcher is much more elegant, and doesn't break if the next
thing that must match happens to be longer than one character.</p>

<p>The <tt class="literal">/e</tt> modifier does a substitution using an expression rather than
a mere string.  This lets us do the calculations we need right when
we need them.</p>
</li>
<li>
<p>Use creative formatting and comments on complex substitutions:
<blockquote>
<pre class="programlisting">#!/usr/bin/perl -p
1 while s{
    ^               # anchor to beginning
    (               # start first subgroup
        .*?         # match minimal number of characters
    )               # end first subgroup
    (               # start second subgroup
        \t+         # match one or more tabs
    )               # end second subgroup
}
{
    my $spacelen = length($2) * 4;  # account for full tabs
    $spacelen -= length($1) % 4;    # account for the uneven tab
    $1 . ' ' x $spacelen;           # make correct number of spaces
}ex;</pre>
</blockquote>

This is probably overkill, but some people find it more impressive
than the previous one-liner.  Go figure.</p>
</li>
<li>
<p>Go ahead and use <tt class="literal">$`</tt> if you feel like it:
<blockquote>
<pre class="programlisting">1 while s/(\t+)/' ' x (length($1) * 4 - length($`) % 4)/e;</pre>
</blockquote>

Here's the shorter version, which uses <tt class="literal">$`</tt>, which is
known to impact performance.  Except that we're only using the length
of it, so it doesn't really count as bad.</p>
</li>
<li>
<p>Use the offsets directly from the <tt class="literal">@-</tt>
(<tt class="literal">@LAST_MATCH_START</tt>) and <tt class="literal">@+</tt>
(<tt class="literal">@LAST_MATCH_END</tt>) arrays:
<blockquote>
<pre class="programlisting">1 while s/\t+/' ' x (($+[0] - $-[0]) * 4 - $-[0] % 4)/e;</pre>
</blockquote>

This one's even shorter.  (If you don't see any arrays there, try looking for array elements instead.) See <tt class="literal">@-</tt> and <tt class="literal">@+</tt> in <a href="ch28_01.htm">Chapter 28, "Special Names"</a>.</p>
</li>
<li>
<p>Use <tt class="literal">eval</tt> with a constant return value:
<blockquote>
<pre class="programlisting">sub is_valid_pattern {
    my $pat = shift;
    return eval { "" =~ /$pat/; 1 } || 0;
}</pre>
</blockquote>

You don't have to use the <tt class="literal">eval {}</tt> operator to return a real value. Here we always return <tt class="literal">1</tt> if it gets to the end.  However, if the pattern
contained in <tt class="literal">$pat</tt> blows up, the <tt class="literal">eval</tt> catches it and returns <tt class="literal">undef</tt>
to the Boolean conditional of the <tt class="literal">||</tt> operator, which turns it into
a defined <tt class="literal">0</tt> (just to be polite, since <tt class="literal">undef</tt> is also false but might
lead someone to believe that the <tt class="literal">is_valid_pattern</tt> subroutine is
misbehaving, and we wouldn't want that, now would we?).</p>
</li>
<li>
<p>Use modules to do all the dirty work.</p>
</li>
<li>
<p>Use object factories.</p>
</li>
<li>
<p>Use callbacks.</p>
</li>
<li>
<p>Use stacks to keep track of context.</p>
</li>
<li>
<p>Use negative subscripts to access the end of an array or string:
<blockquote>
<pre class="programlisting">use XML::Parser;

$p = new XML::Parser Style =&gt; 'subs';
setHandlers $p Char =&gt; sub { $out[-1] .= $_[1] };

push @out, "";

sub literal {
    $out[-1] .= "C&lt;";
    push @out, "";
}

sub literal_ {
    my $text = pop @out;
    $out[-1] .= $text . "&gt;";
}
...</pre>
</blockquote>

This is a snippet from the 250-line program we used to translate the
XML version of the old Camel book back into pod format so we could edit
it for this edition with a Real Text Editor.</p>

<p>The first thing you'll notice is that we rely on the <tt class="literal">XML::Parser</tt>
module (from CPAN) to parse our XML correctly, so we don't have to
figure out how.  That cuts a few thousand lines out of our program
right there (presuming we're reimplementing in Perl everything
<tt class="literal">XML::Parser</tt> does for us,<a href="#FOOTNOTE-2">[2]</a>
including translation from almost any character set into UTF-8).</p>
<blockquote class="footnote">

<a name="FOOTNOTE-2"></a>
<p>[2]Actually, <tt class="literal">XML::Parser</tt> is just a
fancy wrapper around James Clark's <em class="emphasis">expat</em> XML parser.</p>

</blockquote>

<p>
<tt class="literal">XML::Parser</tt> uses a high-level idiom called an <em class="emphasis">object factory</em>.  In
this case, it's a parser factory.  When we create an <tt class="literal">XML::Parser</tt>
object, we tell it which style of parser interface we want, and it
creates one for us.  This is an excellent way to build a testbed
application when you're not sure which kind of interface will turn out
to be the best in the long run.  The <tt class="literal">subs</tt> style is just one of
<tt class="literal">XML::Parser</tt>'s interfaces.  In fact, it's one of the oldest
interfaces, and probably not even the most popular one these days.</p>

<p>The <tt class="literal">setHandlers</tt> line shows a method call on the parser, not in arrow
notation, but in "indirect object" notation, which lets you omit the
parens on the arguments, among other things.  The line also uses the
named parameter idiom we saw earlier.</p>

<p>The line also shows another powerful concept, the notion of a
callback.  Instead of us calling the parser to get the next item, we
tell it to call us.  For named XML tags like <tt class="literal">&lt;literal&gt;</tt>, this
interface style will automatically call a subroutine of that name (or the name 
with an underline on the end for the corresponding end tag).  But the
data between tags doesn't have a name, so we set up a <tt class="literal">Char</tt> callback
with the <tt class="literal">setHandlers</tt> method.</p>

<p>Next we initialize the <tt class="literal">@out</tt> array, which is a stack of outputs.  We
put a null string into it to represent that we haven't collected any
text at the current tag embedding level (0 initially).</p>

<p>Now is when that callback comes back in.  Whenever we see text, it
automatically gets appended to the final element of the array, via the
<tt class="literal">$out[-1]</tt> idiom in the callback.  At the outer tag level, <tt class="literal">$out[-1]</tt>
is the same as <tt class="literal">$out[0]</tt>, so <tt class="literal">$out[0]</tt> ends up with our whole
output.  (Eventually.  But first we have to deal with tags.)</p>

<p>Suppose we see a <tt class="literal">&lt;literal&gt;</tt> tag.  Then the <tt class="literal">literal</tt> subroutine
gets called, appends some text to the current output, then pushes a new
context onto the <tt class="literal">@out</tt> stack.  Now any text up until the closing tag
gets appended to that new end of the stack.  When we hit the closing
tag, we pop the <tt class="literal">$text</tt> we've collected back off the <tt class="literal">@out</tt> stack,
and append the rest of the transmogrified data to the new (that is, the
old) end of stack, the result of which is to translate the XML string, <tt class="literal">&lt;literal&gt;</tt><em class="replaceable">text</em><tt class="literal">&lt;/literal&gt;</tt>, into the corresponding pod string, <tt class="literal">C&lt;</tt><em class="replaceable">text</em><tt class="literal">&gt;</tt>.</p>

<p>The subroutines for the other tags are just the same, only different.</p>
</li>
<li>
<p>Use <tt class="literal">my</tt> without assignment to create an empty array or hash.</p>
</li>
<li>
<p>Split the default string on whitespace.</p>
</li>
<li>
<p>Assign to lists of variables to collect however many you want.</p>
</li>
<li>
<p>Use autovivification of undefined references to create them.</p>
</li>
<li>
<p>Autoincrement undefined array and hash elements to create them.</p>
</li>
<li>
<p>Use autoincrement of a <tt class="literal">%seen</tt> array to determine uniqueness.</p>
</li>
<li>
<p>Assign to a handy <tt class="literal">my</tt> temporary in the conditional.</p>
</li>
<li>
<p>Use the autoquoting behavior of braces.</p>
</li>
<li>
<p>Use an alternate quoting mechanism to interpolate double quotes.</p>
</li>
<li>
<p>Use the <tt class="literal">?:</tt> operator to switch between two arguments to a <tt class="literal">printf</tt>.</p>
</li>
<li>
<p>Line up <tt class="literal">printf</tt> args with their <tt class="literal">%</tt> field:
<blockquote>
<pre class="programlisting">my %seen;
while (&lt;&gt;) {
    my ($a, $b, $c, $d) = split;
    print unless $seen{$a}{$b}{$c}{$d}++;
}
if (my $tmp = $seen{fee}{fie}{foe}{foo}) {
    printf qq(Saw "fee fie foe foo" [sic] %d time%s.\n"),
                                          $tmp,  $tmp == 1 ? "" : "s";
}</pre>
</blockquote>

These nine lines are just chock full of idioms.  The first line makes
an empty hash because we don't assign anything to it.  We iterate over
input lines setting "it", that is, <tt class="literal">$_</tt>, implicitly,
then using an argumentless <tt class="literal">split</tt> which splits "it"
on whitespace.  Then we pick off the four first words with a list
assignment, throwing any subsequent words away.  Then we remember the
first four words in a four-dimensional hash, which automatically
creates (if necessary) the first three reference elements and final
count element for the autoincrement to increment.  (Under <tt class="literal">use
warnings</tt>, the autoincrement will never warn that you're
using undefined values, because autoincrement is an accepted way to
define undefined values.) We then print out the line if we've never
seen a line starting with these four words before, because the
autoincrement is a postincrement, which, in addition to incrementing
the hash value, will return the old true value if there was one.</p>

<p>After the loop, we test <tt class="literal">%seen</tt> again to see if a
particular combination of four words was seen.  We make use of the
fact that we can put a literal identifier into braces and it will be
autoquoted.  Otherwise, we'd have to say
<tt class="literal">$seen{"fee"}{"fie"}{"foe"}{"foo"}</tt>, which is a drag
even when you're not running from a giant.</p>

<p>We assign the result of <tt class="literal">$seen{fee}{fie}{foe}{foo}</tt>
to a temporary variable even before testing it in the Boolean context
provided by the <tt class="literal">if</tt>. Because assignment returns its
left value, we can still test the value to see if it was true.  The
<tt class="literal">my</tt> tells your eye that it's a new variable, and
we're not testing for equality but doing an assignment.  It would also
work fine without the <tt class="literal">my</tt>, and an expert Perl
programmer would still immediately notice that we used one
<tt class="literal">=</tt> instead of two <tt class="literal">==</tt>.  (A
semiskilled Perl programmer might be fooled, however.  Pascal
programmers of any skill level will foam at the mouth.)</p>

<p>Moving on to the <tt class="literal">printf</tt> statement, you can see the
<tt class="literal">qq()</tt> form of double quotes we used so that we could
interpolate ordinary double quotes as well as a newline.  We could've
directly interpolated <tt class="literal">$tmp</tt> there as well, since
it's effectively a double-quoted string, but we chose to do further
interpolation via <tt class="literal">printf</tt>.  Our temporary
<tt class="literal">$tmp</tt> variable is now quite handy, particularly
since we don't just want to interpolate it, but also test it in the
conditional of a <tt class="literal">?:</tt> operator to see whether we
should pluralize the word "time".  Finally, note that we lined up the
two fields with their corresponding <tt class="literal">%</tt> markers in
the <tt class="literal">printf</tt> format.  If an argument is too long to
fit, you can always go to the next line for the next argument, though
we didn't have to in this case.</p>
</li>
</ul>
<p>Whew! Had enough?  There are many more idioms we could discuss, but
this book is already sufficiently heavy.  But we'd like to
talk about one more idiomatic use of Perl, the writing of program
generators.</p>

<a name="INDEX-4281"></a><a name="INDEX-4282"></a><a name="INDEX-4283"></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="ch24_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="ch24_05.htm"><img src="../gifs/txtnexta.gif" alt="Next" border="0"></a></td>
</tr>
<tr>
<td align="left" valign="top" width="172">24.3. Programming with Style</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">24.5. Program Generation</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>