package FileCache;
-our $VERSION = '1.021';
+our $VERSION = 1.03;
=head1 NAME
# or
use FileCache maxopen => 16;
+ cacheout $mode, $path;
+ # or
cacheout $path;
print $path @data;
- cacheout $mode, $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.
+automatically closes and re-opens files if you exceed your system's
+maximum number of file descriptors, or the suggested maximum I<maxopen>.
=over
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
namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
C< '|-' > and C< '-|' >
-=head1 CAVEATS
+Returns EXPR on success for convenience. You may neglect the
+return value and manipulate EXPR as the filehandle directly if you prefer.
-If you use cacheout with C<'|-'> or C<'-|'> you should catch SIGPIPE
-and explicitly close the filehandle., when it is closed from the
-other end some cleanup needs to be done.
+=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
=head1 BUGS
F<sys/param.h> lies with its C<NOFILE> define on some systems,
-so you may have to set maxopen (I<$FileCache::cacheout_maxopen>) yourself.
+so you may have to set I<maxopen> yourself.
+
+=head1 NOTES
+
+FileCache installs signal handlers for CHLD (a.k.a. CLD) and PIPE in the
+calling package to handle deceased children from 2-arg C<cacheout> with C<'|-'>
+or C<'-|'> I<expediently>. The children would otherwise be reaped eventually,
+unless you terminated before repeatedly calling cacheout.
=cut
use Carp;
use strict;
no strict 'refs';
-use vars qw(%saw $cacheout_maxopen);
# 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.
+use vars qw(%saw $cacheout_maxopen);
my %isopen;
my $cacheout_seq = 0;
sub import {
my ($pkg,%args) = @_;
- *{caller(1).'::cacheout'} = \&cacheout;
- *{caller(1).'::close'} = \&cacheout_close;
+ $pkg = caller(1);
+ *{$pkg.'::cacheout'} = \&cacheout;
+ *{$pkg.'::close'} = \&cacheout_close;
+
+ # Reap our children
+ @{"$pkg\::SIG"}{'CLD', 'CHLD', 'PIPE'} = ('IGNORE')x3;
# Truth is okay here because setting maxopen to 0 would be bad
- return $cacheout_maxopen = $args{maxopen} if $args{maxopen} ;
- if (open(PARAM,'/usr/include/sys/param.h')) {
- local ($_, $.);
- while (<PARAM>) {
- $cacheout_maxopen = $1 - 4
- if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+ return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
+ 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;
}
- close PARAM;
}
$cacheout_maxopen ||= 16;
}
# Open in their package.
-
sub cacheout_open {
- open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]);
+ return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
}
# Close in their package.
-
sub cacheout_close {
- fileno(*{caller(1) . '::' . $_[0]}) &&
- CORE::close(*{caller(1) . '::' . $_[0]});
- delete $isopen{$_[0]};
+ # Short-circuit in case the filehandle disappeared
+ my $pkg = caller($_[1]||0);
+ fileno(*{$pkg . '::' . $_[0]}) &&
+ CORE::close(*{$pkg . '::' . $_[0]});
+ delete $isopen{$_[0]};
}
# But only this sub name is visible to them.
-
sub cacheout {
- croak "Not enough arguments for cacheout" unless @_;
- croak "Too many arguments for cacheout" if scalar @_ > 2;
- my($mode, $file)=@_;
- ($file, $mode) = ($mode, $file) if scalar @_ == 1;
- # We don't want children
- croak "Invalid file for cacheout" if $file =~ /^\s*(?:\|\-)|(?:\-\|)\s*$/;
- croak "Invalid mode for cacheout" if $mode &&
- ( $mode !~ /^\s*(?:>>)|(?:\+?>)|(?:\+?<)|(?:\|\-)|(?:\-\|)\s*$/ );
+ 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;
- unless( $isopen{$file}) {
+ ($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}->[2] ){
+ &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} <=> $isopen{$b};} keys(%isopen);
- &cacheout_close($_) for splice(@lru, $cacheout_maxopen / 3);
+ 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;
}
- $mode ||= ( $saw{$file} = ! $saw{$file} ) ? '>': '>>';
- cacheout_open($mode, $file) or croak("Can't create $file: $!");
+
+ 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];
}
- $isopen{$file} = ++$cacheout_seq;
+ return $ret;
}
-
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff