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