| 1 |
package FileCache; |
| 2 |
|
| 3 |
our $VERSION = '1.05'; |
| 4 |
|
| 5 |
=head1 NAME |
| 6 |
|
| 7 |
FileCache - keep more files open than the system permits |
| 8 |
|
| 9 |
=head1 SYNOPSIS |
| 10 |
|
| 11 |
use FileCache; |
| 12 |
# or |
| 13 |
use FileCache maxopen => 16; |
| 14 |
|
| 15 |
cacheout $mode, $path; |
| 16 |
# or |
| 17 |
cacheout $path; |
| 18 |
print $path @data; |
| 19 |
|
| 20 |
$fh = cacheout $mode, $path; |
| 21 |
# or |
| 22 |
$fh = cacheout $path; |
| 23 |
print $fh @data; |
| 24 |
|
| 25 |
=head1 DESCRIPTION |
| 26 |
|
| 27 |
The C<cacheout> function will make sure that there's a filehandle open |
| 28 |
for reading or writing available as the pathname you give it. It |
| 29 |
automatically closes and re-opens files if you exceed your system's |
| 30 |
maximum number of file descriptors, or the suggested maximum I<maxopen>. |
| 31 |
|
| 32 |
=over |
| 33 |
|
| 34 |
=item cacheout EXPR |
| 35 |
|
| 36 |
The 1-argument form of cacheout will open a file for writing (C<< '>' >>) |
| 37 |
on it's first use, and appending (C<<< '>>' >>>) thereafter. |
| 38 |
|
| 39 |
Returns EXPR on success for convenience. You may neglect the |
| 40 |
return value and manipulate EXPR as the filehandle directly if you prefer. |
| 41 |
|
| 42 |
=item cacheout MODE, EXPR |
| 43 |
|
| 44 |
The 2-argument form of cacheout will use the supplied mode for the initial |
| 45 |
and subsequent openings. Most valid modes for 3-argument C<open> are supported |
| 46 |
namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>, |
| 47 |
C< '|-' > and C< '-|' > |
| 48 |
|
| 49 |
To pass supplemental arguments to a program opened with C< '|-' > or C< '-|' > |
| 50 |
append them to the command string as you would system EXPR. |
| 51 |
|
| 52 |
Returns EXPR on success for convenience. You may neglect the |
| 53 |
return value and manipulate EXPR as the filehandle directly if you prefer. |
| 54 |
|
| 55 |
=head1 CAVEATS |
| 56 |
|
| 57 |
While it is permissible to C<close> a FileCache managed file, |
| 58 |
do not do so if you are calling C<FileCache::cacheout> from a package other |
| 59 |
than which it was imported, or with another module which overrides C<close>. |
| 60 |
If you must, use C<FileCache::cacheout_close>. |
| 61 |
|
| 62 |
Although FileCache can be used with piped opens ('-|' or '|-') doing so is |
| 63 |
strongly discouraged. If FileCache finds it necessary to close and then reopen |
| 64 |
a pipe, the command at the far end of the pipe will be reexecuted - the results |
| 65 |
of performing IO on FileCache'd pipes is unlikely to be what you expect. The |
| 66 |
ability to use FileCache on pipes may be removed in a future release. |
| 67 |
|
| 68 |
FileCache does not store the current file offset if it finds it necessary to |
| 69 |
close a file. When the file is reopened, the offset will be as specified by the |
| 70 |
original C<open> file mode. This could be construed to be a bug. |
| 71 |
|
| 72 |
=head1 BUGS |
| 73 |
|
| 74 |
F<sys/param.h> lies with its C<NOFILE> define on some systems, |
| 75 |
so you may have to set I<maxopen> yourself. |
| 76 |
|
| 77 |
=cut |
| 78 |
|
| 79 |
require 5.006; |
| 80 |
use Carp; |
| 81 |
use Config; |
| 82 |
use strict; |
| 83 |
no strict 'refs'; |
| 84 |
|
| 85 |
# These are not C<my> for legacy reasons. |
| 86 |
# Previous versions requested the user set $cacheout_maxopen by hand. |
| 87 |
# Some authors fiddled with %saw to overcome the clobber on initial open. |
| 88 |
use vars qw(%saw $cacheout_maxopen); |
| 89 |
$cacheout_maxopen = 16; |
| 90 |
|
| 91 |
use base 'Exporter'; |
| 92 |
our @EXPORT = qw[cacheout cacheout_close]; |
| 93 |
|
| 94 |
|
| 95 |
my %isopen; |
| 96 |
my $cacheout_seq = 0; |
| 97 |
|
| 98 |
sub import { |
| 99 |
my ($pkg,%args) = @_; |
| 100 |
|
| 101 |
# Use Exporter. %args are for us, not Exporter. |
| 102 |
# Make sure to up export_to_level, or we will import into ourselves, |
| 103 |
# rather than our calling package; |
| 104 |
|
| 105 |
__PACKAGE__->export_to_level(1); |
| 106 |
Exporter::import( $pkg ); |
| 107 |
|
| 108 |
# Truth is okay here because setting maxopen to 0 would be bad |
| 109 |
return $cacheout_maxopen = $args{maxopen} if $args{maxopen}; |
| 110 |
|
| 111 |
# XXX This code is crazy. Why is it a one element foreach loop? |
| 112 |
# Why is it using $param both as a filename and filehandle? |
| 113 |
foreach my $param ( '/usr/include/sys/param.h' ){ |
| 114 |
if (open($param, '<', $param)) { |
| 115 |
local ($_, $.); |
| 116 |
while (<$param>) { |
| 117 |
if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){ |
| 118 |
$cacheout_maxopen = $1 - 4; |
| 119 |
close($param); |
| 120 |
last; |
| 121 |
} |
| 122 |
} |
| 123 |
close $param; |
| 124 |
} |
| 125 |
} |
| 126 |
$cacheout_maxopen ||= 16; |
| 127 |
} |
| 128 |
|
| 129 |
# Open in their package. |
| 130 |
sub cacheout_open { |
| 131 |
return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1]; |
| 132 |
} |
| 133 |
|
| 134 |
# Close in their package. |
| 135 |
sub cacheout_close { |
| 136 |
# Short-circuit in case the filehandle disappeared |
| 137 |
my $pkg = caller($_[1]||0); |
| 138 |
fileno(*{$pkg . '::' . $_[0]}) && |
| 139 |
CORE::close(*{$pkg . '::' . $_[0]}); |
| 140 |
delete $isopen{$_[0]}; |
| 141 |
} |
| 142 |
|
| 143 |
# But only this sub name is visible to them. |
| 144 |
sub cacheout { |
| 145 |
my($mode, $file, $class, $ret, $ref, $narg); |
| 146 |
croak "Not enough arguments for cacheout" unless $narg = scalar @_; |
| 147 |
croak "Too many arguments for cacheout" if $narg > 2; |
| 148 |
|
| 149 |
($mode, $file) = @_; |
| 150 |
($file, $mode) = ($mode, $file) if $narg == 1; |
| 151 |
croak "Invalid mode for cacheout" if $mode && |
| 152 |
( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ ); |
| 153 |
|
| 154 |
# Mode changed? |
| 155 |
if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[1] ){ |
| 156 |
&cacheout_close($file, 1); |
| 157 |
} |
| 158 |
|
| 159 |
if( $isopen{$file}) { |
| 160 |
$ret = $file; |
| 161 |
$isopen{$file}->[0]++; |
| 162 |
} |
| 163 |
else{ |
| 164 |
if( scalar keys(%isopen) > $cacheout_maxopen -1 ) { |
| 165 |
my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen); |
| 166 |
$cacheout_seq = 0; |
| 167 |
$isopen{$_}->[0] = $cacheout_seq++ for |
| 168 |
splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen); |
| 169 |
&cacheout_close($_, 1) for @lru; |
| 170 |
} |
| 171 |
|
| 172 |
unless( $ref ){ |
| 173 |
$mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>'); |
| 174 |
} |
| 175 |
#XXX should we just return the value from cacheout_open, no croak? |
| 176 |
$ret = cacheout_open($mode, $file) or croak("Can't create $file: $!"); |
| 177 |
|
| 178 |
$isopen{$file} = [++$cacheout_seq, $mode]; |
| 179 |
} |
| 180 |
return $ret; |
| 181 |
} |
| 182 |
1; |
