>From the keyboard of
[email protected] (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
[email protected] convex!tchrist
echo "Your stdio isn't very std."
--Larry Wall in Configure from the perl distribution