[Summary view] [Print] [Text view]

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