7 FileCache - keep more files open than the system permits
16 The C<cacheout> function will make sure that there's a filehandle open
17 for writing available as the pathname you give it. It automatically
18 closes and re-opens files if you exceed your system file descriptor
23 If the argument passed to cacheout does not begin with a valid mode
24 (>, +>, <, +<, >>, |) then the file will be clobbered the first time
27 cacheout '>>' . $path;
30 If $path includes the filemode the filehandle will not be accessible
35 F<sys/param.h> lies with its C<NOFILE> define on some systems,
36 so you may have to set $FileCache::cacheout_maxopen yourself.
44 use vars qw(@ISA @EXPORT %saw $cacheout_maxopen);
54 # Open in their package.
59 open(*{$pack . '::' . $_[0]}, $_[1]);
64 close(*{$pack . '::' . $_[0]});
67 # But only this sub name is visible to them.
71 unless (defined $cacheout_maxopen) {
72 if (open(PARAM,'/usr/include/sys/param.h')) {
75 $cacheout_maxopen = $1 - 4
76 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
80 $cacheout_maxopen = 16 unless $cacheout_maxopen;
82 if (!$isopen{$file}) {
83 if ( scalar keys(%isopen) + 1 > $cacheout_maxopen) {
84 my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
85 splice(@lru, $cacheout_maxopen / 3);
86 for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
89 unless( $symbol =~ s/^(\s?(?:>>)|(?:\+?>)|(?:\+?<)|\|)// ){
90 $file = ($saw{$file}++ ? '>>' : '>') . $file;
92 cacheout_open($symbol, $file)
93 or croak("Can't create $file: $!");
95 $isopen{$file} = ++$cacheout_seq;