189 lines
5.4 KiB
Perl
189 lines
5.4 KiB
Perl
package FileCache;
|
|
|
|
our $VERSION = '1.10';
|
|
|
|
=head1 NAME
|
|
|
|
FileCache - keep more files open than the system permits
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
no strict 'refs';
|
|
|
|
use FileCache;
|
|
# or
|
|
use FileCache maxopen => 16;
|
|
|
|
cacheout $mode, $path;
|
|
# or
|
|
cacheout $path;
|
|
print $path @data;
|
|
|
|
$fh = cacheout $mode, $path;
|
|
# or
|
|
$fh = cacheout $path;
|
|
print $fh @data;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The C<cacheout> function will make sure that there's a filehandle open
|
|
for reading or writing available as the pathname you give it. It
|
|
automatically closes and re-opens files if you exceed your system's
|
|
maximum number of file descriptors, or the suggested maximum I<maxopen>.
|
|
|
|
=over
|
|
|
|
=item cacheout EXPR
|
|
|
|
The 1-argument form of cacheout will open a file for writing (C<< '>' >>)
|
|
on it's first use, and appending (C<<< '>>' >>>) thereafter.
|
|
|
|
Returns EXPR on success for convenience. You may neglect the
|
|
return value and manipulate EXPR as the filehandle directly if you prefer.
|
|
|
|
=item cacheout MODE, EXPR
|
|
|
|
The 2-argument form of cacheout will use the supplied mode for the initial
|
|
and subsequent openings. Most valid modes for 3-argument C<open> are supported
|
|
namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
|
|
C< '|-' > and C< '-|' >
|
|
|
|
To pass supplemental arguments to a program opened with C< '|-' > or C< '-|' >
|
|
append them to the command string as you would system EXPR.
|
|
|
|
Returns EXPR on success for convenience. You may neglect the
|
|
return value and manipulate EXPR as the filehandle directly if you prefer.
|
|
|
|
=back
|
|
|
|
=head1 CAVEATS
|
|
|
|
While it is permissible to C<close> a FileCache managed file,
|
|
do not do so if you are calling C<FileCache::cacheout> from a package other
|
|
than which it was imported, or with another module which overrides C<close>.
|
|
If you must, use C<FileCache::cacheout_close>.
|
|
|
|
Although FileCache can be used with piped opens ('-|' or '|-') doing so is
|
|
strongly discouraged. If FileCache finds it necessary to close and then reopen
|
|
a pipe, the command at the far end of the pipe will be reexecuted - the results
|
|
of performing IO on FileCache'd pipes is unlikely to be what you expect. The
|
|
ability to use FileCache on pipes may be removed in a future release.
|
|
|
|
FileCache does not store the current file offset if it finds it necessary to
|
|
close a file. When the file is reopened, the offset will be as specified by the
|
|
original C<open> file mode. This could be construed to be a bug.
|
|
|
|
The module functionality relies on symbolic references, so things will break
|
|
under 'use strict' unless 'no strict "refs"' is also specified.
|
|
|
|
=head1 BUGS
|
|
|
|
F<sys/param.h> lies with its C<NOFILE> define on some systems,
|
|
so you may have to set I<maxopen> yourself.
|
|
|
|
=cut
|
|
|
|
require 5.006;
|
|
use Carp;
|
|
use strict;
|
|
no strict 'refs';
|
|
|
|
# These are not C<my> for legacy reasons.
|
|
# Previous versions requested the user set $cacheout_maxopen by hand.
|
|
# Some authors fiddled with %saw to overcome the clobber on initial open.
|
|
our %saw;
|
|
our $cacheout_maxopen = 16;
|
|
|
|
use parent 'Exporter';
|
|
our @EXPORT = qw[cacheout cacheout_close];
|
|
|
|
|
|
my %isopen;
|
|
my $cacheout_seq = 0;
|
|
|
|
sub import {
|
|
my ($pkg,%args) = @_;
|
|
|
|
# Use Exporter. %args are for us, not Exporter.
|
|
# Make sure to up export_to_level, or we will import into ourselves,
|
|
# rather than our calling package;
|
|
|
|
__PACKAGE__->export_to_level(1);
|
|
Exporter::import( $pkg );
|
|
|
|
# Truth is okay here because setting maxopen to 0 would be bad
|
|
return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
|
|
|
|
# XXX This code is crazy. Why is it a one element foreach loop?
|
|
# Why is it using $param both as a filename and filehandle?
|
|
foreach my $param ( '/usr/include/sys/param.h' ){
|
|
if (open($param, '<', $param)) {
|
|
local ($_, $.);
|
|
while (<$param>) {
|
|
if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
|
|
$cacheout_maxopen = $1 - 4;
|
|
close($param);
|
|
last;
|
|
}
|
|
}
|
|
close $param;
|
|
}
|
|
}
|
|
$cacheout_maxopen ||= 16;
|
|
}
|
|
|
|
# Open in their package.
|
|
sub cacheout_open {
|
|
return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
|
|
}
|
|
|
|
# Close in their package.
|
|
sub cacheout_close {
|
|
# Short-circuit in case the filehandle disappeared
|
|
my $pkg = caller($_[1]||0);
|
|
defined fileno(*{$pkg . '::' . $_[0]}) &&
|
|
CORE::close(*{$pkg . '::' . $_[0]});
|
|
delete $isopen{$_[0]};
|
|
}
|
|
|
|
# But only this sub name is visible to them.
|
|
sub cacheout {
|
|
my($mode, $file, $class, $ret, $ref, $narg);
|
|
croak "Not enough arguments for cacheout" unless $narg = scalar @_;
|
|
croak "Too many arguments for cacheout" if $narg > 2;
|
|
|
|
($mode, $file) = @_;
|
|
($file, $mode) = ($mode, $file) if $narg == 1;
|
|
croak "Invalid mode for cacheout" if $mode &&
|
|
( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
|
|
|
|
# Mode changed?
|
|
if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[1] ){
|
|
&cacheout_close($file, 1);
|
|
}
|
|
|
|
if( $isopen{$file}) {
|
|
$ret = $file;
|
|
$isopen{$file}->[0]++;
|
|
}
|
|
else{
|
|
if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
|
|
my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
|
|
$cacheout_seq = 0;
|
|
$isopen{$_}->[0] = $cacheout_seq++ for
|
|
splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
|
|
&cacheout_close($_, 1) for @lru;
|
|
}
|
|
|
|
unless( $ref ){
|
|
$mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
|
|
}
|
|
#XXX should we just return the value from cacheout_open, no croak?
|
|
$ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
|
|
|
|
$isopen{$file} = [++$cacheout_seq, $mode];
|
|
}
|
|
return $ret;
|
|
}
|
|
1;
|