X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFileCache.pm;h=8e1fe446a52df51ba31dd4da57fd8740823dd111;hb=2c227d667bcf910e7fef2feea02fec7046f3cb13;hp=2f8f1a6986705d30d5fa7f34d5e1b3efe533cb09;hpb=c14fc35a124901bb0a7c6981001dbcf00006611d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/FileCache.pm b/lib/FileCache.pm index 2f8f1a6..8e1fe44 100644 --- a/lib/FileCache.pm +++ b/lib/FileCache.pm @@ -1,6 +1,6 @@ package FileCache; -our $VERSION = '1.02'; +our $VERSION = 1.03; =head1 NAME @@ -12,18 +12,22 @@ FileCache - keep more files open than the system permits # 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 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. =over @@ -32,6 +36,9 @@ maximum number of file descriptors, or the suggested maximum. 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 @@ -39,83 +46,122 @@ and subsequent openings. Most valid modes for 3-argument C are supported namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>, C< '|-' > and C< '-|' > +Returns EXPR on success for convenience. You may neglect the +return value and manipulate EXPR as the filehandle directly if you prefer. + =head1 CAVEATS -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. +While it is permissible to C a FileCache managed file, +do not do so if you are calling C from a package other +than which it was imported, or with another module which overrides C. +If you must, use C. =head1 BUGS F lies with its C define on some systems, -so you may have to set maxopen (I<$FileCache::cacheout_maxopen>) yourself. +so you may have to set I 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 with C<'|-'> +or C<'-|'> I. The children would otherwise be reaped eventually, +unless you terminated before repeatedly calling cacheout. =cut -require 5.000; +require 5.006; use Carp; +use Config; use strict; no strict 'refs'; -use vars qw(%saw $cacheout_maxopen); # These are not C 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'} = 'IGNORE' if $Config{sig_name} =~ /\bCLD\b/; + ${"$pkg\::SIG"}{'CHLD'} = 'IGNORE' if $Config{sig_name} =~ /\bCHLD\b/; + ${"$pkg\::SIG"}{'PIPE'} = 'IGNORE' if $Config{sig_name} =~ /\bPIPE\b/; # 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 () { - $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;