7 FileCache - keep more files open than the system permits
13 use FileCache maxopen => 16;
15 cacheout $mode, $path;
20 $fh = cacheout $mode, $path;
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>.
36 The 1-argument form of cacheout will open a file for writing (C<< '>' >>)
37 on it's first use, and appending (C<<< '>>' >>>) thereafter.
39 Returns EXPR on success for convenience. You may neglect the
40 return value and manipulate EXPR as the filehandle directly if you prefer.
42 =item cacheout MODE, EXPR
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< '-|' >
49 Returns EXPR on success for convenience. You may neglect the
50 return value and manipulate EXPR as the filehandle directly if you prefer.
54 While it is permissible to C<close> a FileCache managed file,
55 do not do so if you are calling C<FileCache::cacheout> from a package other
56 than which it was imported, or with another module which overrides C<close>.
57 If you must, use C<FileCache::cacheout_close>.
61 F<sys/param.h> lies with its C<NOFILE> define on some systems,
62 so you may have to set I<maxopen> yourself.
66 FileCache installs signal handlers for CHLD (a.k.a. CLD) and PIPE in the
67 calling package to handle deceased children from 2-arg C<cacheout> with C<'|-'>
68 or C<'-|'> I<expediently>. The children would otherwise be reaped eventually,
69 unless you terminated before repeatedly calling cacheout.
78 # These are not C<my> for legacy reasons.
79 # Previous versions requested the user set $cacheout_maxopen by hand.
80 # Some authors fiddled with %saw to overcome the clobber on initial open.
81 use vars qw(%saw $cacheout_maxopen);
88 *{$pkg.'::cacheout'} = \&cacheout;
89 *{$pkg.'::close'} = \&cacheout_close;
92 ${"$pkg\::SIG"}{'CLD'} = 'IGNORE' if $Config{sig_name} =~ /\bCLD\b/;
93 ${"$pkg\::SIG"}{'CHLD'} = 'IGNORE' if $Config{sig_name} =~ /\bCHLD\b/;
94 ${"$pkg\::SIG"}{'PIPE'} = 'IGNORE' if $Config{sig_name} =~ /\bPIPE\b/;
96 # Truth is okay here because setting maxopen to 0 would be bad
97 return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
98 foreach my $param ( '/usr/include/sys/param.h' ){
99 if (open($param, '<', $param)) {
102 if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
103 $cacheout_maxopen = $1 - 4;
111 $cacheout_maxopen ||= 16;
114 # Open in their package.
116 return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
119 # Close in their package.
121 # Short-circuit in case the filehandle disappeared
122 my $pkg = caller($_[1]||0);
123 fileno(*{$pkg . '::' . $_[0]}) &&
124 CORE::close(*{$pkg . '::' . $_[0]});
125 delete $isopen{$_[0]};
128 # But only this sub name is visible to them.
130 my($mode, $file, $class, $ret, $ref, $narg);
131 croak "Not enough arguments for cacheout" unless $narg = scalar @_;
132 croak "Too many arguments for cacheout" if $narg > 2;
135 ($file, $mode) = ($mode, $file) if $narg == 1;
136 croak "Invalid mode for cacheout" if $mode &&
137 ( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
140 if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[2] ){
141 &cacheout_close($file, 1);
144 if( $isopen{$file}) {
146 $isopen{$file}->[0]++;
149 if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
150 my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
152 $isopen{$_}->[0] = $cacheout_seq++ for
153 splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
154 &cacheout_close($_, 1) for @lru;
158 $mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
160 #XXX should we just return the value from cacheout_open, no croak?
161 $ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
163 $isopen{$file} = [++$cacheout_seq, $mode];