home *** CD-ROM | disk | FTP | other *** search
- Newsgroups: comp.lang.perl
- Path: sparky!uunet!cs.utexas.edu!hermes.chpc.utexas.edu!news.utdallas.edu!convex!tchrist
- From: Tom Christiansen <tchrist@convex.COM>
- Subject: Re: array of file descriptors
- Originator: tchrist@pixel.convex.com
- Sender: usenet@news.eng.convex.com (news access account)
- Message-ID: <1992Dec18.113728.14210@news.eng.convex.com>
- Date: Fri, 18 Dec 1992 11:37:28 GMT
- Reply-To: tchrist@convex.COM (Tom Christiansen)
- References: <1992Dec17.171242.22639@ans.net>
- Nntp-Posting-Host: pixel.convex.com
- Organization: Convex Computer Corporation, Colorado Springs, CO
- X-Disclaimer: This message was written by a user at CONVEX Computer
- Corp. The opinions expressed are those of the user and
- not necessarily those of CONVEX.
- Lines: 109
-
- From the keyboard of fuat@news.ans.net (Fuat C. Baran):
- :Is there a way to store file descriptors (from an open()) in an array?
- :I would like to open a set of files, store the open file descriptors
- :in an associative array keyed by filename and be able to multiplex
- :output to one of the files in a loop where for each line of output I'm
- :given a filename. I'd like to check if $filehandles{$filename} is
- :defined and if not first open the file.
-
- Here's one thing that I use. Just call
-
- &'cachein($filename);
-
- and now you can say
-
- while (<$filename>) {
-
- }
-
-
- It also gives nice error message for warn and die this way.
- Here are the routines; beware that Suns lies about what NOFILE
- really is. Thanks for helping us write portable code, Sun.
-
- --tom
-
- sub init_filecache {
- package filecache;
-
- if (defined &'NOFILE) {
- $maxopen = &'NOFILE - 12;
- return;
- }
-
- $seq = 0;
- $numopen = 0;
-
- if (open(PARAM,'/usr/include/sys/param.h')) {
- local($.);
- while (<PARAM>) {
- $maxopen = $1 - 12 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
- $'NOFILE = $1;
- }
- close PARAM;
- }
- $maxopen = 6 unless $maxopen;
- }
-
-
- sub filecache'open {
- # open in their package
- open($_[0], $_[1]);
- }
- # but they only get to see this one
-
- sub main'cachein {
- package filecache;
- ($file) = @_;
- ($package) = caller;
- if (!$isopen{$file}) {
- if (++$numopen > $maxopen) {
- sub byseq {$isopen{$a} <=> $isopen{$b};}
- local(@lru) = sort byseq keys(%isopen);
- splice(@lru, $maxopen / 3);
- $numopen -= @lru;
- for (@lru) { close $_; delete $isopen{$_}; }
- }
- &open($file, "< " . $file) || return undef;
- } elsif ($'U{'debug'}) {
- #
- }
- seek($file,0,0);
- $isopen{$file} = ++$seq;
- }
-
- sub main'uncache {
- package filecache;
- local($file);
- for $file (@_) {
- if ($isopen{$file}) {
- close $file;
- delete $isopen{$file};
- $numopen--;
- }
- }
- }
-
- sub main'clear_filecache { # (DIRECTORY)
- #%%#
- #%%# Close anything cached open in this directory.
- #%%#
- package filecache;
- local($dir) = @_;
- for $file (keys %isopen) {
- if (index($file,$dir) == 0 &&
- substr($file, length($dir), 1) eq '/')
- {
- close $file;
- delete $isopen{$file};
- $numopen--;
- }
- }
- }
-
- __END__
- --
- Tom Christiansen tchrist@convex.com convex!tchrist
-
- echo "Your stdio isn't very std."
- --Larry Wall in Configure from the perl distribution
-