Commit | Line | Data |
68dc0745 |
1 | =head1 NAME |
2 | |
fc36a67e |
3 | perlfaq5 - Files and Formats ($Revision: 1.22 $, $Date: 1997/04/24 22:44:02 $) |
68dc0745 |
4 | |
5 | =head1 DESCRIPTION |
6 | |
7 | This section deals with I/O and the "f" issues: filehandles, flushing, |
8 | formats, and footers. |
9 | |
10 | =head2 How do I flush/unbuffer a filehandle? Why must I do this? |
11 | |
12 | The C standard I/O library (stdio) normally buffers characters sent to |
13 | devices. This is done for efficiency reasons, so that there isn't a |
14 | system call for each byte. Any time you use print() or write() in |
15 | Perl, you go though this buffering. syswrite() circumvents stdio and |
16 | buffering. |
17 | |
18 | In most stdio implementations, the type of buffering and the size of |
19 | the buffer varies according to the type of device. Disk files are block |
20 | buffered, often with a buffer size of more than 2k. Pipes and sockets |
21 | are often buffered with a buffer size between 1/2 and 2k. Serial devices |
22 | (e.g. modems, terminals) are normally line-buffered, and stdio sends |
23 | the entire line when it gets the newline. |
24 | |
25 | Perl does not support truly unbuffered output (except insofar as you can |
26 | C<syswrite(OUT, $char, 1)>). What it does instead support is "command |
27 | buffering", in which a physical write is performed after every output |
28 | command. This isn't as hard on your system as unbuffering, but does |
29 | get the output where you want it when you want it. |
30 | |
31 | If you expect characters to get to your device when you print them there, |
32 | you'll want to autoflush its handle, as in the older: |
33 | |
34 | use FileHandle; |
35 | open(DEV, "<+/dev/tty"); # ceci n'est pas une pipe |
36 | DEV->autoflush(1); |
37 | |
38 | or the newer IO::* modules: |
39 | |
40 | use IO::Handle; |
41 | open(DEV, ">/dev/printer"); # but is this? |
42 | DEV->autoflush(1); |
43 | |
44 | or even this: |
45 | |
46 | use IO::Socket; # this one is kinda a pipe? |
47 | $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.com', |
48 | PeerPort => 'http(80)', |
49 | Proto => 'tcp'); |
50 | die "$!" unless $sock; |
51 | |
52 | $sock->autoflush(); |
53 | $sock->print("GET /\015\012"); |
54 | $document = join('', $sock->getlines()); |
55 | print "DOC IS: $document\n"; |
56 | |
57 | Note the hardcoded carriage return and newline in their octal |
58 | equivalents. This is the ONLY way (currently) to assure a proper |
59 | flush on all platforms, including Macintosh. |
60 | |
61 | You can use select() and the C<$|> variable to control autoflushing |
62 | (see L<perlvar/$|> and L<perlfunc/select>): |
63 | |
64 | $oldh = select(DEV); |
65 | $| = 1; |
66 | select($oldh); |
67 | |
68 | You'll also see code that does this without a temporary variable, as in |
69 | |
70 | select((select(DEV), $| = 1)[0]); |
71 | |
72 | =head2 How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file? |
73 | |
74 | Although humans have an easy time thinking of a text file as being a |
75 | sequence of lines that operates much like a stack of playing cards -- |
76 | or punch cards -- computers usually see the text file as a sequence of |
77 | bytes. In general, there's no direct way for Perl to seek to a |
78 | particular line of a file, insert text into a file, or remove text |
79 | from a file. |
80 | |
81 | (There are exceptions in special circumstances. Replacing a sequence |
82 | of bytes with another sequence of the same length is one. Another is |
83 | using the C<$DB_RECNO> array bindings as documented in L<DB_File>. |
84 | Yet another is manipulating files with all lines the same length.) |
85 | |
86 | The general solution is to create a temporary copy of the text file with |
87 | the changes you want, then copy that over the original. |
88 | |
89 | $old = $file; |
90 | $new = "$file.tmp.$$"; |
91 | $bak = "$file.bak"; |
92 | |
93 | open(OLD, "< $old") or die "can't open $old: $!"; |
94 | open(NEW, "> $new") or die "can't open $new: $!"; |
95 | |
96 | # Correct typos, preserving case |
97 | while (<OLD>) { |
98 | s/\b(p)earl\b/${1}erl/i; |
99 | (print NEW $_) or die "can't write to $new: $!"; |
100 | } |
101 | |
102 | close(OLD) or die "can't close $old: $!"; |
103 | close(NEW) or die "can't close $new: $!"; |
104 | |
105 | rename($old, $bak) or die "can't rename $old to $bak: $!"; |
106 | rename($new, $old) or die "can't rename $new to $old: $!"; |
107 | |
108 | Perl can do this sort of thing for you automatically with the C<-i> |
46fc3d4c |
109 | command-line switch or the closely-related C<$^I> variable (see |
68dc0745 |
110 | L<perlrun> for more details). Note that |
111 | C<-i> may require a suffix on some non-Unix systems; see the |
112 | platform-specific documentation that came with your port. |
113 | |
114 | # Renumber a series of tests from the command line |
115 | perl -pi -e 's/(^\s+test\s+)\d+/ $1 . ++$count /e' t/op/taint.t |
116 | |
117 | # form a script |
118 | local($^I, @ARGV) = ('.bak', glob("*.c")); |
119 | while (<>) { |
120 | if ($. == 1) { |
121 | print "This line should appear at the top of each file\n"; |
122 | } |
123 | s/\b(p)earl\b/${1}erl/i; # Correct typos, preserving case |
124 | print; |
125 | close ARGV if eof; # Reset $. |
126 | } |
127 | |
128 | If you need to seek to an arbitrary line of a file that changes |
129 | infrequently, you could build up an index of byte positions of where |
130 | the line ends are in the file. If the file is large, an index of |
131 | every tenth or hundredth line end would allow you to seek and read |
132 | fairly efficiently. If the file is sorted, try the look.pl library |
133 | (part of the standard perl distribution). |
134 | |
135 | In the unique case of deleting lines at the end of a file, you |
136 | can use tell() and truncate(). The following code snippet deletes |
137 | the last line of a file without making a copy or reading the |
138 | whole file into memory: |
139 | |
140 | open (FH, "+< $file"); |
54310121 |
141 | while ( <FH> ) { $addr = tell(FH) unless eof(FH) } |
68dc0745 |
142 | truncate(FH, $addr); |
143 | |
144 | Error checking is left as an exercise for the reader. |
145 | |
146 | =head2 How do I count the number of lines in a file? |
147 | |
148 | One fairly efficient way is to count newlines in the file. The |
149 | following program uses a feature of tr///, as documented in L<perlop>. |
150 | If your text file doesn't end with a newline, then it's not really a |
151 | proper text file, so this may report one fewer line than you expect. |
152 | |
153 | $lines = 0; |
154 | open(FILE, $filename) or die "Can't open `$filename': $!"; |
155 | while (sysread FILE, $buffer, 4096) { |
156 | $lines += ($buffer =~ tr/\n//); |
157 | } |
158 | close FILE; |
159 | |
160 | =head2 How do I make a temporary file name? |
161 | |
162 | Use the process ID and/or the current time-value. If you need to have |
163 | many temporary files in one process, use a counter: |
164 | |
165 | BEGIN { |
166 | use IO::File; |
167 | use Fcntl; |
168 | my $temp_dir = -d '/tmp' ? '/tmp' : $ENV{TMP} || $ENV{TEMP}; |
169 | my $base_name = sprintf("%s/%d-%d-0000", $temp_dir, $$, time()); |
170 | sub temp_file { |
171 | my $fh = undef; |
172 | my $count = 0; |
173 | until (defined($fh) || $count > 100) { |
174 | $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e; |
175 | $fh = IO::File->new($base_name, O_WRONLY|O_EXCL|O_CREAT, 0644) |
176 | } |
177 | if (defined($fh)) { |
178 | return ($fh, $base_name); |
179 | } else { |
180 | return (); |
181 | } |
182 | } |
183 | } |
184 | |
185 | Or you could simply use IO::Handle::new_tmpfile. |
186 | |
187 | =head2 How can I manipulate fixed-record-length files? |
188 | |
189 | The most efficient way is using pack() and unpack(). This is faster |
190 | than using substr(). Here is a sample chunk of code to break up and |
191 | put back together again some fixed-format input lines, in this case |
192 | from the output of a normal, Berkeley-style ps: |
193 | |
194 | # sample input line: |
195 | # 15158 p5 T 0:00 perl /home/tchrist/scripts/now-what |
196 | $PS_T = 'A6 A4 A7 A5 A*'; |
197 | open(PS, "ps|"); |
198 | $_ = <PS>; print; |
199 | while (<PS>) { |
200 | ($pid, $tt, $stat, $time, $command) = unpack($PS_T, $_); |
201 | for $var (qw!pid tt stat time command!) { |
202 | print "$var: <$$var>\n"; |
203 | } |
204 | print 'line=', pack($PS_T, $pid, $tt, $stat, $time, $command), |
205 | "\n"; |
206 | } |
207 | |
208 | =head2 How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles? |
209 | |
210 | You may have some success with typeglobs, as we always had to use |
211 | in days of old: |
212 | |
213 | local(*FH); |
214 | |
215 | But while still supported, that isn't the best to go about getting |
216 | local filehandles. Typeglobs have their drawbacks. You may well want |
217 | to use the C<FileHandle> module, which creates new filehandles for you |
218 | (see L<FileHandle>): |
219 | |
220 | use FileHandle; |
221 | sub findme { |
222 | my $fh = FileHandle->new(); |
223 | open($fh, "</etc/hosts") or die "no /etc/hosts: $!"; |
224 | while (<$fh>) { |
225 | print if /\b127\.(0\.0\.)?1\b/; |
226 | } |
227 | # $fh automatically closes/disappears here |
228 | } |
229 | |
230 | Internally, Perl believes filehandles to be of class IO::Handle. You |
231 | may use that module directly if you'd like (see L<IO::Handle>), or |
232 | one of its more specific derived classes. |
233 | |
46fc3d4c |
234 | Once you have IO::File or FileHandle objects, you can pass them |
235 | between subroutines or store them in hashes as you would any other |
236 | scalar values: |
237 | |
238 | use FileHandle; |
239 | |
240 | # Storing filehandles in a hash and array |
241 | foreach $filename (@names) { |
242 | my $fh = new FileHandle($filename) or die; |
243 | $file{$filename} = $fh; |
244 | push(@files, $fh); |
245 | } |
246 | |
247 | # Using the filehandles in the array |
248 | foreach $file (@files) { |
249 | print $file "Testing\n"; |
250 | } |
251 | |
252 | # You have to do the { } ugliness when you're specifying the |
253 | # filehandle by anything other than a simple scalar variable. |
254 | print { $files[2] } "Testing\n"; |
255 | |
256 | # Passing filehandles to subroutines |
257 | sub debug { |
258 | my $filehandle = shift; |
259 | printf $filehandle "DEBUG: ", @_; |
260 | } |
261 | |
262 | debug($fh, "Testing\n"); |
263 | |
68dc0745 |
264 | =head2 How can I set up a footer format to be used with write()? |
265 | |
54310121 |
266 | There's no builtin way to do this, but L<perlform> has a couple of |
68dc0745 |
267 | techniques to make it possible for the intrepid hacker. |
268 | |
269 | =head2 How can I write() into a string? |
270 | |
271 | See L<perlform> for an swrite() function. |
272 | |
273 | =head2 How can I output my numbers with commas added? |
274 | |
275 | This one will do it for you: |
276 | |
277 | sub commify { |
278 | local $_ = shift; |
279 | 1 while s/^(-?\d+)(\d{3})/$1,$2/; |
280 | return $_; |
281 | } |
282 | |
283 | $n = 23659019423.2331; |
284 | print "GOT: ", commify($n), "\n"; |
285 | |
286 | GOT: 23,659,019,423.2331 |
287 | |
288 | You can't just: |
289 | |
290 | s/^(-?\d+)(\d{3})/$1,$2/g; |
291 | |
292 | because you have to put the comma in and then recalculate your |
293 | position. |
294 | |
46fc3d4c |
295 | Alternatively, this commifies all numbers in a line regardless of |
296 | whether they have decimal portions, are preceded by + or -, or |
297 | whatever: |
298 | |
299 | # from Andrew Johnson <ajohnson@gpu.srv.ualberta.ca> |
300 | sub commify { |
301 | my $input = shift; |
302 | $input = reverse $input; |
303 | $input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g; |
304 | return reverse $input; |
305 | } |
306 | |
68dc0745 |
307 | =head2 How can I translate tildes (~) in a filename? |
308 | |
309 | Use the E<lt>E<gt> (glob()) operator, documented in L<perlfunc>. This |
310 | requires that you have a shell installed that groks tildes, meaning |
311 | csh or tcsh or (some versions of) ksh, and thus may have portability |
312 | problems. The Glob::KGlob module (available from CPAN) gives more |
313 | portable glob functionality. |
314 | |
315 | Within Perl, you may use this directly: |
316 | |
317 | $filename =~ s{ |
318 | ^ ~ # find a leading tilde |
319 | ( # save this in $1 |
320 | [^/] # a non-slash character |
321 | * # repeated 0 or more times (0 means me) |
322 | ) |
323 | }{ |
324 | $1 |
325 | ? (getpwnam($1))[7] |
326 | : ( $ENV{HOME} || $ENV{LOGDIR} ) |
327 | }ex; |
328 | |
329 | =head2 How come when I open the file read-write it wipes it out? |
330 | |
331 | Because you're using something like this, which truncates the file and |
332 | I<then> gives you read-write access: |
333 | |
334 | open(FH, "+> /path/name"); # WRONG |
335 | |
336 | Whoops. You should instead use this, which will fail if the file |
337 | doesn't exist. |
338 | |
339 | open(FH, "+< /path/name"); # open for update |
340 | |
341 | If this is an issue, try: |
342 | |
343 | sysopen(FH, "/path/name", O_RDWR|O_CREAT, 0644); |
344 | |
345 | Error checking is left as an exercise for the reader. |
346 | |
347 | =head2 Why do I sometimes get an "Argument list too long" when I use <*>? |
348 | |
349 | The C<E<lt>E<gt>> operator performs a globbing operation (see above). |
350 | By default glob() forks csh(1) to do the actual glob expansion, but |
351 | csh can't handle more than 127 items and so gives the error message |
352 | C<Argument list too long>. People who installed tcsh as csh won't |
353 | have this problem, but their users may be surprised by it. |
354 | |
355 | To get around this, either do the glob yourself with C<Dirhandle>s and |
356 | patterns, or use a module like Glob::KGlob, one that doesn't use the |
357 | shell to do globbing. |
358 | |
359 | =head2 Is there a leak/bug in glob()? |
360 | |
361 | Due to the current implementation on some operating systems, when you |
362 | use the glob() function or its angle-bracket alias in a scalar |
363 | context, you may cause a leak and/or unpredictable behavior. It's |
364 | best therefore to use glob() only in list context. |
365 | |
366 | =head2 How can I open a file with a leading "E<gt>" or trailing blanks? |
367 | |
368 | Normally perl ignores trailing blanks in filenames, and interprets |
369 | certain leading characters (or a trailing "|") to mean something |
370 | special. To avoid this, you might want to use a routine like this. |
371 | It makes incomplete pathnames into explicit relative ones, and tacks a |
372 | trailing null byte on the name to make perl leave it alone: |
373 | |
374 | sub safe_filename { |
375 | local $_ = shift; |
376 | return m#^/# |
377 | ? "$_\0" |
378 | : "./$_\0"; |
379 | } |
380 | |
381 | $fn = safe_filename("<<<something really wicked "); |
382 | open(FH, "> $fn") or "couldn't open $fn: $!"; |
383 | |
384 | You could also use the sysopen() function (see L<perlfunc/sysopen>). |
385 | |
386 | =head2 How can I reliably rename a file? |
387 | |
388 | Well, usually you just use Perl's rename() function. But that may |
389 | not work everywhere, in particular, renaming files across file systems. |
390 | If your operating system supports a mv(1) program or its moral equivalent, |
391 | this works: |
392 | |
393 | rename($old, $new) or system("mv", $old, $new); |
394 | |
395 | It may be more compelling to use the File::Copy module instead. You |
396 | just copy to the new file to the new name (checking return values), |
397 | then delete the old one. This isn't really the same semantics as a |
398 | real rename(), though, which preserves metainformation like |
399 | permissions, timestamps, inode info, etc. |
400 | |
401 | =head2 How can I lock a file? |
402 | |
54310121 |
403 | Perl's builtin flock() function (see L<perlfunc> for details) will call |
68dc0745 |
404 | flock(2) if that exists, fcntl(2) if it doesn't (on perl version 5.004 and |
405 | later), and lockf(3) if neither of the two previous system calls exists. |
406 | On some systems, it may even use a different form of native locking. |
407 | Here are some gotchas with Perl's flock(): |
408 | |
409 | =over 4 |
410 | |
411 | =item 1 |
412 | |
413 | Produces a fatal error if none of the three system calls (or their |
414 | close equivalent) exists. |
415 | |
416 | =item 2 |
417 | |
418 | lockf(3) does not provide shared locking, and requires that the |
419 | filehandle be open for writing (or appending, or read/writing). |
420 | |
421 | =item 3 |
422 | |
423 | Some versions of flock() can't lock files over a network (e.g. on NFS |
424 | file systems), so you'd need to force the use of fcntl(2) when you |
425 | build Perl. See the flock entry of L<perlfunc>, and the F<INSTALL> |
426 | file in the source distribution for information on building Perl to do |
427 | this. |
428 | |
429 | =back |
430 | |
431 | The CPAN module File::Lock offers similar functionality and (if you |
432 | have dynamic loading) won't require you to rebuild perl if your |
433 | flock() can't lock network files. |
434 | |
435 | =head2 What can't I just open(FH, ">file.lock")? |
436 | |
437 | A common bit of code B<NOT TO USE> is this: |
438 | |
439 | sleep(3) while -e "file.lock"; # PLEASE DO NOT USE |
440 | open(LCK, "> file.lock"); # THIS BROKEN CODE |
441 | |
442 | This is a classic race condition: you take two steps to do something |
443 | which must be done in one. That's why computer hardware provides an |
444 | atomic test-and-set instruction. In theory, this "ought" to work: |
445 | |
446 | sysopen(FH, "file.lock", O_WRONLY|O_EXCL|O_CREAT, 0644) |
447 | or die "can't open file.lock: $!": |
448 | |
449 | except that lamentably, file creation (and deletion) is not atomic |
450 | over NFS, so this won't work (at least, not every time) over the net. |
46fc3d4c |
451 | Various schemes involving involving link() have been suggested, but |
452 | these tend to involve busy-wait, which is also subdesirable. |
68dc0745 |
453 | |
fc36a67e |
454 | =head2 I still don't get locking. I just want to increment the number in the file. How can I do this? |
68dc0745 |
455 | |
46fc3d4c |
456 | Didn't anyone ever tell you web-page hit counters were useless? |
68dc0745 |
457 | |
458 | Anyway, this is what to do: |
459 | |
460 | use Fcntl; |
461 | sysopen(FH, "numfile", O_RDWR|O_CREAT, 0644) or die "can't open numfile: $!"; |
462 | flock(FH, 2) or die "can't flock numfile: $!"; |
463 | $num = <FH> || 0; |
464 | seek(FH, 0, 0) or die "can't rewind numfile: $!"; |
465 | truncate(FH, 0) or die "can't truncate numfile: $!"; |
466 | (print FH $num+1, "\n") or die "can't write numfile: $!"; |
467 | # DO NOT UNLOCK THIS UNTIL YOU CLOSE |
468 | close FH or die "can't close numfile: $!"; |
469 | |
46fc3d4c |
470 | Here's a much better web-page hit counter: |
68dc0745 |
471 | |
472 | $hits = int( (time() - 850_000_000) / rand(1_000) ); |
473 | |
474 | If the count doesn't impress your friends, then the code might. :-) |
475 | |
476 | =head2 How do I randomly update a binary file? |
477 | |
478 | If you're just trying to patch a binary, in many cases something as |
479 | simple as this works: |
480 | |
481 | perl -i -pe 's{window manager}{window mangler}g' /usr/bin/emacs |
482 | |
483 | However, if you have fixed sized records, then you might do something more |
484 | like this: |
485 | |
486 | $RECSIZE = 220; # size of record, in bytes |
487 | $recno = 37; # which record to update |
488 | open(FH, "+<somewhere") || die "can't update somewhere: $!"; |
489 | seek(FH, $recno * $RECSIZE, 0); |
490 | read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!"; |
491 | # munge the record |
492 | seek(FH, $recno * $RECSIZE, 0); |
493 | print FH $record; |
494 | close FH; |
495 | |
496 | Locking and error checking are left as an exercise for the reader. |
497 | Don't forget them, or you'll be quite sorry. |
498 | |
46fc3d4c |
499 | Don't forget to set binmode() under DOS-like platforms when operating |
68dc0745 |
500 | on files that have anything other than straight text in them. See the |
501 | docs on open() and on binmode() for more details. |
502 | |
503 | =head2 How do I get a file's timestamp in perl? |
504 | |
505 | If you want to retrieve the time at which the file was last read, |
46fc3d4c |
506 | written, or had its meta-data (owner, etc) changed, you use the B<-M>, |
68dc0745 |
507 | B<-A>, or B<-C> filetest operations as documented in L<perlfunc>. These |
508 | retrieve the age of the file (measured against the start-time of your |
509 | program) in days as a floating point number. To retrieve the "raw" |
510 | time in seconds since the epoch, you would call the stat function, |
511 | then use localtime(), gmtime(), or POSIX::strftime() to convert this |
512 | into human-readable form. |
513 | |
514 | Here's an example: |
515 | |
516 | $write_secs = (stat($file))[9]; |
517 | print "file $file updated at ", scalar(localtime($file)), "\n"; |
518 | |
519 | If you prefer something more legible, use the File::stat module |
520 | (part of the standard distribution in version 5.004 and later): |
521 | |
522 | use File::stat; |
523 | use Time::localtime; |
524 | $date_string = ctime(stat($file)->mtime); |
525 | print "file $file updated at $date_string\n"; |
526 | |
527 | Error checking is left as an exercise for the reader. |
528 | |
529 | =head2 How do I set a file's timestamp in perl? |
530 | |
531 | You use the utime() function documented in L<perlfunc/utime>. |
532 | By way of example, here's a little program that copies the |
533 | read and write times from its first argument to all the rest |
534 | of them. |
535 | |
536 | if (@ARGV < 2) { |
537 | die "usage: cptimes timestamp_file other_files ...\n"; |
538 | } |
539 | $timestamp = shift; |
540 | ($atime, $mtime) = (stat($timestamp))[8,9]; |
541 | utime $atime, $mtime, @ARGV; |
542 | |
543 | Error checking is left as an exercise for the reader. |
544 | |
545 | Note that utime() currently doesn't work correctly with Win95/NT |
546 | ports. A bug has been reported. Check it carefully before using |
547 | it on those platforms. |
548 | |
549 | =head2 How do I print to more than one file at once? |
550 | |
551 | If you only have to do this once, you can do this: |
552 | |
553 | for $fh (FH1, FH2, FH3) { print $fh "whatever\n" } |
554 | |
555 | To connect up to one filehandle to several output filehandles, it's |
556 | easiest to use the tee(1) program if you have it, and let it take care |
557 | of the multiplexing: |
558 | |
559 | open (FH, "| tee file1 file2 file3"); |
560 | |
561 | Otherwise you'll have to write your own multiplexing print function -- |
562 | or your own tee program -- or use Tom Christiansen's, at |
563 | http://www.perl.com/CPAN/authors/id/TOMC/scripts/tct.gz, which is |
564 | written in Perl. |
565 | |
566 | In theory a IO::Tee class could be written, but to date we haven't |
567 | seen such. |
568 | |
569 | =head2 How can I read in a file by paragraphs? |
570 | |
571 | Use the C<$\> variable (see L<perlvar> for details). You can either |
572 | set it to C<""> to eliminate empty paragraphs (C<"abc\n\n\n\ndef">, |
573 | for instance, gets treated as two paragraphs and not three), or |
574 | C<"\n\n"> to accept empty paragraphs. |
575 | |
576 | =head2 How can I read a single character from a file? From the keyboard? |
577 | |
578 | You can use the builtin C<getc()> function for most filehandles, but |
579 | it won't (easily) work on a terminal device. For STDIN, either use |
580 | the Term::ReadKey module from CPAN, or use the sample code in |
581 | L<perlfunc/getc>. |
582 | |
583 | If your system supports POSIX, you can use the following code, which |
584 | you'll note turns off echo processing as well. |
585 | |
586 | #!/usr/bin/perl -w |
587 | use strict; |
588 | $| = 1; |
589 | for (1..4) { |
590 | my $got; |
591 | print "gimme: "; |
592 | $got = getone(); |
593 | print "--> $got\n"; |
594 | } |
595 | exit; |
596 | |
597 | BEGIN { |
598 | use POSIX qw(:termios_h); |
599 | |
600 | my ($term, $oterm, $echo, $noecho, $fd_stdin); |
601 | |
602 | $fd_stdin = fileno(STDIN); |
603 | |
604 | $term = POSIX::Termios->new(); |
605 | $term->getattr($fd_stdin); |
606 | $oterm = $term->getlflag(); |
607 | |
608 | $echo = ECHO | ECHOK | ICANON; |
609 | $noecho = $oterm & ~$echo; |
610 | |
611 | sub cbreak { |
612 | $term->setlflag($noecho); |
613 | $term->setcc(VTIME, 1); |
614 | $term->setattr($fd_stdin, TCSANOW); |
615 | } |
616 | |
617 | sub cooked { |
618 | $term->setlflag($oterm); |
619 | $term->setcc(VTIME, 0); |
620 | $term->setattr($fd_stdin, TCSANOW); |
621 | } |
622 | |
623 | sub getone { |
624 | my $key = ''; |
625 | cbreak(); |
626 | sysread(STDIN, $key, 1); |
627 | cooked(); |
628 | return $key; |
629 | } |
630 | |
631 | } |
632 | |
633 | END { cooked() } |
634 | |
635 | The Term::ReadKey module from CPAN may be easier to use: |
636 | |
637 | use Term::ReadKey; |
638 | open(TTY, "</dev/tty"); |
639 | print "Gimme a char: "; |
640 | ReadMode "raw"; |
641 | $key = ReadKey 0, *TTY; |
642 | ReadMode "normal"; |
643 | printf "\nYou said %s, char number %03d\n", |
644 | $key, ord $key; |
645 | |
46fc3d4c |
646 | For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following: |
68dc0745 |
647 | |
648 | To put the PC in "raw" mode, use ioctl with some magic numbers gleaned |
649 | from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes |
650 | across the net every so often): |
651 | |
652 | $old_ioctl = ioctl(STDIN,0,0); # Gets device info |
653 | $old_ioctl &= 0xff; |
654 | ioctl(STDIN,1,$old_ioctl | 32); # Writes it back, setting bit 5 |
655 | |
656 | Then to read a single character: |
657 | |
658 | sysread(STDIN,$c,1); # Read a single character |
659 | |
660 | And to put the PC back to "cooked" mode: |
661 | |
662 | ioctl(STDIN,1,$old_ioctl); # Sets it back to cooked mode. |
663 | |
664 | So now you have $c. If C<ord($c) == 0>, you have a two byte code, which |
665 | means you hit a special key. Read another byte with C<sysread(STDIN,$c,1)>, |
666 | and that value tells you what combination it was according to this |
667 | table: |
668 | |
669 | # PC 2-byte keycodes = ^@ + the following: |
670 | |
671 | # HEX KEYS |
672 | # --- ---- |
673 | # 0F SHF TAB |
674 | # 10-19 ALT QWERTYUIOP |
675 | # 1E-26 ALT ASDFGHJKL |
676 | # 2C-32 ALT ZXCVBNM |
677 | # 3B-44 F1-F10 |
678 | # 47-49 HOME,UP,PgUp |
679 | # 4B LEFT |
680 | # 4D RIGHT |
681 | # 4F-53 END,DOWN,PgDn,Ins,Del |
682 | # 54-5D SHF F1-F10 |
683 | # 5E-67 CTR F1-F10 |
684 | # 68-71 ALT F1-F10 |
685 | # 73-77 CTR LEFT,RIGHT,END,PgDn,HOME |
686 | # 78-83 ALT 1234567890-= |
687 | # 84 CTR PgUp |
688 | |
689 | This is all trial and error I did a long time ago, I hope I'm reading the |
690 | file that worked. |
691 | |
692 | =head2 How can I tell if there's a character waiting on a filehandle? |
693 | |
694 | You should check out the Frequently Asked Questions list in |
695 | comp.unix.* for things like this: the answer is essentially the same. |
696 | It's very system dependent. Here's one solution that works on BSD |
697 | systems: |
698 | |
699 | sub key_ready { |
700 | my($rin, $nfd); |
701 | vec($rin, fileno(STDIN), 1) = 1; |
702 | return $nfd = select($rin,undef,undef,0); |
703 | } |
704 | |
705 | You should look into getting the Term::ReadKey extension from CPAN. |
706 | |
707 | =head2 How do I open a file without blocking? |
708 | |
709 | You need to use the O_NDELAY or O_NONBLOCK flag from the Fcntl module |
710 | in conjunction with sysopen(): |
711 | |
712 | use Fcntl; |
713 | sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644) |
714 | or die "can't open /tmp/somefile: $!": |
715 | |
716 | =head2 How do I create a file only if it doesn't exist? |
717 | |
718 | You need to use the O_CREAT and O_EXCL flags from the Fcntl module in |
719 | conjunction with sysopen(): |
720 | |
721 | use Fcntl; |
722 | sysopen(FH, "/tmp/somefile", O_WRONLY|O_EXCL|O_CREAT, 0644) |
723 | or die "can't open /tmp/somefile: $!": |
724 | |
725 | Be warned that neither creation nor deletion of files is guaranteed to |
726 | be an atomic operation over NFS. That is, two processes might both |
727 | successful create or unlink the same file! |
728 | |
729 | =head2 How do I do a C<tail -f> in perl? |
730 | |
731 | First try |
732 | |
733 | seek(GWFILE, 0, 1); |
734 | |
735 | The statement C<seek(GWFILE, 0, 1)> doesn't change the current position, |
736 | but it does clear the end-of-file condition on the handle, so that the |
737 | next <GWFILE> makes Perl try again to read something. |
738 | |
739 | If that doesn't work (it relies on features of your stdio implementation), |
740 | then you need something more like this: |
741 | |
742 | for (;;) { |
743 | for ($curpos = tell(GWFILE); <GWFILE>; $curpos = tell(GWFILE)) { |
744 | # search for some stuff and put it into files |
745 | } |
746 | # sleep for a while |
747 | seek(GWFILE, $curpos, 0); # seek to where we had been |
748 | } |
749 | |
750 | If this still doesn't work, look into the POSIX module. POSIX defines |
751 | the clearerr() method, which can remove the end of file condition on a |
752 | filehandle. The method: read until end of file, clearerr(), read some |
753 | more. Lather, rinse, repeat. |
754 | |
755 | =head2 How do I dup() a filehandle in Perl? |
756 | |
757 | If you check L<perlfunc/open>, you'll see that several of the ways |
758 | to call open() should do the trick. For example: |
759 | |
760 | open(LOG, ">>/tmp/logfile"); |
761 | open(STDERR, ">&LOG"); |
762 | |
763 | Or even with a literal numeric descriptor: |
764 | |
765 | $fd = $ENV{MHCONTEXTFD}; |
766 | open(MHCONTEXT, "<&=$fd"); # like fdopen(3S) |
767 | |
768 | Error checking has been left as an exercise for the reader. |
769 | |
770 | =head2 How do I close a file descriptor by number? |
771 | |
772 | This should rarely be necessary, as the Perl close() function is to be |
773 | used for things that Perl opened itself, even if it was a dup of a |
774 | numeric descriptor, as with MHCONTEXT above. But if you really have |
775 | to, you may be able to do this: |
776 | |
777 | require 'sys/syscall.ph'; |
778 | $rc = syscall(&SYS_close, $fd + 0); # must force numeric |
779 | die "can't sysclose $fd: $!" unless $rc == -1; |
780 | |
46fc3d4c |
781 | =head2 Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work? |
68dc0745 |
782 | |
783 | Whoops! You just put a tab and a formfeed into that filename! |
784 | Remember that within double quoted strings ("like\this"), the |
785 | backslash is an escape character. The full list of these is in |
786 | L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't |
787 | have a file called "c:(tab)emp(formfeed)oo" or |
46fc3d4c |
788 | "c:(tab)emp(formfeed)oo.exe" on your DOS filesystem. |
68dc0745 |
789 | |
790 | Either single-quote your strings, or (preferably) use forward slashes. |
46fc3d4c |
791 | Since all DOS and Windows versions since something like MS-DOS 2.0 or so |
68dc0745 |
792 | have treated C</> and C<\> the same in a path, you might as well use the |
793 | one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++, |
794 | awk, Tcl, Java, or Python, just to mention a few. |
795 | |
796 | =head2 Why doesn't glob("*.*") get all the files? |
797 | |
798 | Because even on non-Unix ports, Perl's glob function follows standard |
46fc3d4c |
799 | Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden) |
68dc0745 |
800 | files. |
801 | |
802 | =head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl? |
803 | |
804 | This is elaborately and painstakingly described in the "Far More Than |
805 | You Every Wanted To Know" in |
806 | http://www.perl.com/CPAN/doc/FMTEYEWTK/file-dir-perms . |
807 | |
808 | The executive summary: learn how your filesystem works. The |
809 | permissions on a file say what can happen to the data in that file. |
810 | The permissions on a directory say what can happen to the list of |
811 | files in that directory. If you delete a file, you're removing its |
812 | name from the directory (so the operation depends on the permissions |
813 | of the directory, not of the file). If you try to write to the file, |
814 | the permissions of the file govern whether you're allowed to. |
815 | |
816 | =head2 How do I select a random line from a file? |
817 | |
818 | Here's an algorithm from the Camel Book: |
819 | |
820 | srand; |
821 | rand($.) < 1 && ($line = $_) while <>; |
822 | |
823 | This has a significant advantage in space over reading the whole |
824 | file in. |
825 | |
826 | =head1 AUTHOR AND COPYRIGHT |
827 | |
828 | Copyright (c) 1997 Tom Christiansen and Nathan Torkington. |
829 | All rights reserved. See L<perlfaq> for distribution information. |
46fc3d4c |
830 | |