lib/FileCache.pm

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