home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / perl / 7516 < prev    next >
Encoding:
Text File  |  1992-12-21  |  3.1 KB  |  127 lines

  1. Newsgroups: comp.lang.perl
  2. Path: sparky!uunet!cs.utexas.edu!hermes.chpc.utexas.edu!news.utdallas.edu!convex!tchrist
  3. From: Tom Christiansen <tchrist@convex.COM>
  4. Subject: Re: array of file descriptors
  5. Originator: tchrist@pixel.convex.com
  6. Sender: usenet@news.eng.convex.com (news access account)
  7. Message-ID: <1992Dec18.113728.14210@news.eng.convex.com>
  8. Date: Fri, 18 Dec 1992 11:37:28 GMT
  9. Reply-To: tchrist@convex.COM (Tom Christiansen)
  10. References: <1992Dec17.171242.22639@ans.net>
  11. Nntp-Posting-Host: pixel.convex.com
  12. Organization: Convex Computer Corporation, Colorado Springs, CO
  13. X-Disclaimer: This message was written by a user at CONVEX Computer
  14.               Corp. The opinions expressed are those of the user and
  15.               not necessarily those of CONVEX.
  16. Lines: 109
  17.  
  18. From the keyboard of fuat@news.ans.net (Fuat C. Baran):
  19. :Is there a way to store file descriptors (from an open()) in an array?
  20. :I would like to open a set of files, store the open file descriptors
  21. :in an associative array keyed by filename and be able to multiplex
  22. :output to one of the files in a loop where for each line of output I'm
  23. :given a filename.  I'd like to check if $filehandles{$filename} is
  24. :defined and if not first open the file.
  25.  
  26. Here's one thing that I use.  Just call
  27.     
  28.     &'cachein($filename);
  29.  
  30. and now you can say
  31.  
  32.     while (<$filename>) {
  33.     
  34.     } 
  35.  
  36.  
  37. It also gives nice error message for warn and die this way.
  38. Here are the routines; beware that Suns lies about what NOFILE
  39. really is.  Thanks for helping us write portable code, Sun.
  40.  
  41. --tom
  42.  
  43.     sub init_filecache {
  44.     package filecache;
  45.  
  46.     if (defined &'NOFILE) {
  47.         $maxopen = &'NOFILE - 12;
  48.         return;
  49.     } 
  50.  
  51.     $seq = 0;
  52.     $numopen = 0;
  53.  
  54.     if (open(PARAM,'/usr/include/sys/param.h')) {
  55.         local($.);
  56.         while (<PARAM>) {
  57.         $maxopen = $1 - 12 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  58.         $'NOFILE = $1;
  59.         }
  60.         close PARAM;
  61.     }
  62.     $maxopen = 6 unless $maxopen;
  63.     } 
  64.  
  65.  
  66.     sub filecache'open {
  67.     # open in their package
  68.     open($_[0], $_[1]);
  69.     } 
  70.     # but they only get to see this one
  71.  
  72.     sub main'cachein {
  73.     package filecache;
  74.     ($file) = @_;
  75.     ($package) = caller;
  76.     if (!$isopen{$file}) {
  77.         if (++$numopen > $maxopen) {
  78.         sub byseq {$isopen{$a} <=> $isopen{$b};}
  79.         local(@lru) = sort byseq keys(%isopen);
  80.         splice(@lru, $maxopen / 3);
  81.         $numopen -= @lru;
  82.         for (@lru) { close $_; delete $isopen{$_}; }
  83.         }
  84.         &open($file, "< " . $file) || return undef;
  85.     } elsif ($'U{'debug'}) {
  86.         # 
  87.     } 
  88.     seek($file,0,0);
  89.     $isopen{$file} = ++$seq;
  90.     } 
  91.  
  92.     sub main'uncache {
  93.     package filecache;
  94.     local($file);
  95.     for $file (@_) {
  96.         if ($isopen{$file}) {
  97.         close $file;
  98.         delete $isopen{$file};
  99.         $numopen--;
  100.         } 
  101.     } 
  102.     } 
  103.  
  104.     sub main'clear_filecache { # (DIRECTORY)
  105.     #%%#
  106.     #%%# Close anything cached open in this directory.
  107.     #%%#
  108.     package filecache;
  109.     local($dir) = @_;
  110.     for $file (keys %isopen) {
  111.         if (index($file,$dir) == 0 && 
  112.         substr($file, length($dir), 1) eq '/')
  113.         {
  114.         close $file;
  115.         delete $isopen{$file};
  116.         $numopen--;
  117.         } 
  118.     } 
  119.     } 
  120.  
  121. __END__
  122. -- 
  123.     Tom Christiansen      tchrist@convex.com      convex!tchrist
  124.  
  125.     echo "Your stdio isn't very std."
  126.             --Larry Wall in Configure from the perl distribution
  127.