perlfaq5.html

《Perl 5教程》及《perl常问问题集》

<P>

<P>
<HR>
<H3><A NAME="How_can_I_write_into_a_string_">How can I write() into a string?

</A></H3>
See <A HREF="../../tppmsgs/msgs1.htm#111" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlform.html">the perlform manpage</A> for an <CODE>swrite()</CODE> function.

<P>

<P>
<HR>
<H3><A NAME="How_can_I_output_my_numbers_with">How can I output my numbers with commas added?

</A></H3>
This one will do it for you:

<P>

<PRE>    sub commify {
        local $_  = shift;
        1 while s/^(-?\d+)(\d{3})/$1,$2/;
        return $_;
    }
</PRE>

<P>

<PRE>    $n = 23659019423.2331;
    print &quot;GOT: &quot;, commify($n), &quot;\n&quot;;
</PRE>

<P>

<PRE>    GOT: 23,659,019,423.2331
</PRE>

<P>

You can't just:

<P>

<PRE>    s/^(-?\d+)(\d{3})/$1,$2/g;
</PRE>

<P>

because you have to put the comma in and then recalculate your position.

<P>

Alternatively, this commifies all numbers in a line regardless of whether
they have decimal portions, are preceded by + or -, or whatever:

<P>

<PRE>    # from Andrew Johnson &lt;[e-mail]&gt;
    sub commify {
       my $input = shift;
        $input = reverse $input;
        $input =~ s&lt;(\d\d\d)(?=\d)(?!\d*\.)&gt;&lt;$1,&gt;g;
        return reverse $input;
    }
</PRE>

<P>

<P>
<HR>
<H3><A NAME="How_can_I_translate_tildes_i">How can I translate tildes (~) in a filename?

</A></H3>
Use the &lt;&gt; (glob()) operator, documented in <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html">the perlfunc manpage</A>. This requires that you have a shell installed that groks tildes, meaning csh or tcsh or (some versions of) ksh, and thus may have portability problems. The Glob::KGlob module (available from 
<FONT SIZE=-1>CPAN)</FONT> gives more portable glob functionality.

<P>

Within Perl, you may use this directly:

<P>

<PRE>        $filename =~ s{
          ^ ~             # find a leading tilde
          (               # save this in $1
              [^/]        # a non-slash character
                    *     # repeated 0 or more times (0 means me)
          )
        }{
          $1
              ? (getpwnam($1))[7]
              : ( $ENV{HOME} || $ENV{LOGDIR} )
        }ex;
</PRE>

<P>

<P>
<HR>
<H3><A NAME="How_come_when_I_open_the_file_re">How come when I open the file read-write it wipes it out?

</A></H3>
Because you're using something like this, which truncates the file and
<EM>then</EM> gives you read-write access:

<P>

<PRE>    open(FH, &quot;+&gt; /path/name&quot;);  # WRONG
</PRE>

<P>

Whoops. You should instead use this, which will fail if the file doesn't
exist.

<P>

<PRE>    open(FH, &quot;+&lt; /path/name&quot;);  # open for update
</PRE>

<P>

If this is an issue, try:

<P>

<PRE>    sysopen(FH, &quot;/path/name&quot;, O_RDWR|O_CREAT, 0644);
</PRE>

<P>

Error checking is left as an exercise for the reader.

<P>

<P>
<HR>
<H3><A NAME="Why_do_I_sometimes_get_an_Argum">Why do I sometimes get an "Argument list too long" when I use <*>?

</A></H3>
The <CODE>&lt;&gt;</CODE> operator performs a globbing operation (see above). By default
<CODE>glob()</CODE> forks <CODE>csh(1)</CODE> to do the actual glob
expansion, but csh can't handle more than 127 items and so gives the error
message
<CODE>Argument list too long</CODE>. People who installed tcsh as csh won't have this problem, but their users
may be surprised by it.

<P>

To get around this, either do the glob yourself with <CODE>Dirhandle</CODE>s and patterns, or use a module like Glob::KGlob, one that doesn't use the
shell to do globbing.

<P>

<P>
<HR>
<H3><A NAME="Is_there_a_leak_bug_in_glob_">Is there a leak/bug in glob()?

</A></H3>
Due to the current implementation on some operating systems, when you use
the <CODE>glob()</CODE> function or its angle-bracket alias in a scalar
context, you may cause a leak and/or unpredictable behavior. It's best
therefore to use <CODE>glob()</CODE> only in list context.

<P>

<P>
<HR>
<H3><A NAME="How_can_I_open_a_file_with_a_lea">How can I open a file with a leading "&gt;" or trailing blanks?

</A></H3>
Normally perl ignores trailing blanks in filenames, and interprets certain
leading characters (or a trailing ``|'') to mean something special. To
avoid this, you might want to use a routine like this. It makes incomplete
pathnames into explicit relative ones, and tacks a trailing null byte on
the name to make perl leave it alone:

<P>

<PRE>    sub safe_filename {
        local $_  = shift;
        return m#^/#
                ? &quot;$_\0&quot;
                : &quot;./$_\0&quot;;
    }
</PRE>

<P>

<PRE>    $fn = safe_filename(&quot;&lt;&lt;&lt;something really wicked   &quot;);
    open(FH, &quot;&gt; $fn&quot;) or &quot;couldn't open $fn: $!&quot;;
</PRE>

<P>

You could also use the <CODE>sysopen()</CODE> function (see <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html#sysopen">sysopen</A>).

<P>

<P>
<HR>
<H3><A NAME="How_can_I_reliably_rename_a_file">How can I reliably rename a file?

</A></H3>
Well, usually you just use Perl's <CODE>rename()</CODE> function. But that
may not work everywhere, in particular, renaming files across file systems.
If your operating system supports a <CODE>mv(1)</CODE> program or its moral
equivalent, this works:

<P>

<PRE>    rename($old, $new) or system(&quot;mv&quot;, $old, $new);
</PRE>

<P>

It may be more compelling to use the File::Copy module instead. You just
copy to the new file to the new name (checking return values), then delete
the old one. This isn't really the same semantics as a real
<CODE>rename(),</CODE> though, which preserves metainformation like
permissions, timestamps, inode info, etc.

<P>

<P>
<HR>
<H3><A NAME="How_can_I_lock_a_file_">How can I lock a file?

</A></H3>
Perl's builtin <CODE>flock()</CODE> function (see <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html">the perlfunc manpage</A> for details) will call <CODE>flock(2)</CODE> if that exists,
<CODE>fcntl(2)</CODE> if it doesn't (on perl version 5.004 and later), and
<CODE>lockf(3)</CODE> if neither of the two previous system calls exists.
On some systems, it may even use a different form of native locking. Here
are some gotchas with Perl's <CODE>flock():</CODE>

<P>

<OL>
<LI><STRONG><A NAME="item_">

</A></STRONG>
Produces a fatal error if none of the three system calls (or their close
equivalent) exists.

<P>

<LI><STRONG><A NAME="item_">

</A></STRONG>
<CODE>lockf(3)</CODE> does not provide shared locking, and requires that
the filehandle be open for writing (or appending, or read/writing).

<P>

<LI><STRONG><A NAME="item_">

</A></STRONG>
Some versions of <CODE>flock()</CODE> can't lock files over a network (e.g. on 
<FONT SIZE=-1>NFS</FONT> file systems), so you'd need to force the use of <CODE>fcntl(2)</CODE> when you build Perl. See the flock entry of
 <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html">the perlfunc manpage</A>, and the <EM>INSTALL</EM>
file in the source distribution for information on building Perl to do
this.

<P>

</OL>
The 
<FONT SIZE=-1>CPAN</FONT> module File::Lock offers similar functionality
and (if you have dynamic loading) won't require you to rebuild perl if your
<CODE>flock()</CODE> can't lock network files.

<P>

<P>
<HR>
<H3><A NAME="What_can_t_I_just_open_FH_fil">What can't I just open(FH, ">file.lock")?

</A></H3>

<FONT SIZE=-1>A</FONT> common bit of code <STRONG>NOT TO USE</STRONG> is this:

<P>

<PRE>    sleep(3) while -e &quot;file.lock&quot;;      # PLEASE DO NOT USE
    open(LCK, &quot;&gt; file.lock&quot;);           # THIS BROKEN CODE
</PRE>

<P>

This is a classic race condition: you take two steps to do something which
must be done in one. That's why computer hardware provides an atomic
test-and-set instruction. In theory, this ``ought'' to work:

<P>

<PRE>    sysopen(FH, &quot;file.lock&quot;, O_WRONLY|O_EXCL|O_CREAT, 0644)
                or die &quot;can't open  file.lock: $!&quot;:
</PRE>

<P>

except that lamentably, file creation (and deletion) is not atomic over 
<FONT SIZE=-1>NFS,</FONT> so this won't work (at least, not every time)
over the net. Various schemes involving involving <CODE>link()</CODE> have
been suggested, but these tend to involve busy-wait, which is also
subdesirable.

<P>

<P>
<HR>
<H3><A NAME="I_still_don_t_get_locking_I_jus">I still don't get locking.  I just want to increment the number in the file.  How can I do this?

</A></H3>
Didn't anyone ever tell you web-page hit counters were useless?

<P>

Anyway, this is what to do:

<P>

<PRE>    use Fcntl;
    sysopen(FH, &quot;numfile&quot;, O_RDWR|O_CREAT, 0644) or die &quot;can't open numfile: $!&quot;;
    flock(FH, 2)                                 or die &quot;can't flock numfile: $!&quot;;
    $num = &lt;FH&gt; || 0;
    seek(FH, 0, 0)                               or die &quot;can't rewind numfile: $!&quot;;
    truncate(FH, 0)                              or die &quot;can't truncate numfile: $!&quot;;
    (print FH $num+1, &quot;\n&quot;)                      or die &quot;can't write numfile: $!&quot;;
    # DO NOT UNLOCK THIS UNTIL YOU CLOSE
    close FH                                     or die &quot;can't close numfile: $!&quot;;
</PRE>

<P>

Here's a much better web-page hit counter:

<P>

<PRE>    $hits = int( (time() - 850_000_000) / rand(1_000) );
</PRE>

<P>

If the count doesn't impress your friends, then the code might. :-)

<P>

<P>
<HR>
<H3><A NAME="How_do_I_randomly_update_a_binar">How do I randomly update a binary file?

</A></H3>
If you're just trying to patch a binary, in many cases something as simple
as this works:

<P>

<PRE>    perl -i -pe 's{window manager}{window mangler}g' /usr/bin/emacs
</PRE>

<P>

However, if you have fixed sized records, then you might do something more
like this:

<P>

<PRE>    $RECSIZE = 220; # size of record, in bytes
    $recno   = 37;  # which record to update
    open(FH, &quot;+&lt;somewhere&quot;) || die &quot;can't update somewhere: $!&quot;;
    seek(FH, $recno * $RECSIZE, 0);
    read(FH, $record, $RECSIZE) == $RECSIZE || die &quot;can't read record $recno: $!&quot;;
    # munge the record
    seek(FH, $recno * $RECSIZE, 0);
    print FH $record;
    close FH;
</PRE>

<P>

Locking and error checking are left as an exercise for the reader. Don't
forget them, or you'll be quite sorry.

<P>

Don't forget to set <CODE>binmode()</CODE> under DOS-like platforms when
operating on files that have anything other than straight text in them. See
the docs on <CODE>open()</CODE> and on <CODE>binmode()</CODE> for more
details.

<P>

<P>
<HR>
<H3><A NAME="How_do_I_get_a_file_s_timestamp_">How do I get a file's timestamp in perl?

</A></H3>
If you want to retrieve the time at which the file was last read, written,
or had its meta-data (owner, etc) changed, you use the <STRONG>-M</STRONG>,
<STRONG>-A</STRONG>, or <STRONG>-C</STRONG> filetest operations as documented in <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html">the perlfunc manpage</A>. These retrieve the age of the file (measured against the start-time of
your program) in days as a floating point number. To retrieve the ``raw''
time in seconds since the epoch, you would call the stat function, then use
<CODE>localtime(),</CODE> <CODE>gmtime(),</CODE> or POSIX::strftime() to
convert this into human-readable form.

<P>

Here's an example:

<P>

<PRE>    $write_secs = (stat($file))[9];
    print &quot;file $file updated at &quot;, scalar(localtime($file)), &quot;\n&quot;;
</PRE>

<P>

If you prefer something more legible, use the File::stat module (part of
the standard distribution in version 5.004 and later):

<P>

<PRE>    use <A HREF="File::stat">File::stat</A>;
    use Time::localtime;
    $date_string = ctime(stat($file)-&gt;mtime);
    print &quot;file $file updated at $date_string\n&quot;;
</PRE>

<P>

Error checking is left as an exercise for the reader.

<P>

<P>
<HR>
<H3><A NAME="How_do_I_set_a_file_s_timestamp_">How do I set a file's timestamp in perl?

</A></H3>
You use the <CODE>utime()</CODE> function documented in <A HREF="../../tppmsgs/msgs0.htm#68" tppabs="http://www.perl.org/CPAN/doc/manual/html/pod/perlfunc.html#utime">utime</A>. By way of example, here's a little program that copies the read and write
times from its first argument to all the rest of them.

<P>

<PRE>    if (@ARGV &lt; 2) {
        die &quot;usage: cptimes timestamp_file other_files ...\n&quot;;
    }
    $timestamp = shift;
    ($atime, $mtime) = (stat($timestamp))[8,9];
    utime $atime, $mtime, @ARGV;
</PRE>

<P>

Error checking is left as an exercise for the reader.

<P>

Note that <CODE>utime()</CODE> currently doesn't work correctly with Win95/NT ports. 
<FONT SIZE=-1>A</FONT> bug has been reported. Check it carefully before using it on those platforms.

<P>

<P>
<HR>
<H3><A NAME="How_do_I_print_to_more_than_one_">How do I print to more than one file at once?

</A></H3>
If you only have to do this once, you can do this:

<P>

<PRE>    for $fh (FH1, FH2, FH3) { print $fh &quot;whatever\n&quot; }
</PRE>