home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Topware / activeperl / ActivePerl / Perl / lib / FileCache.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-19  |  3.7 KB  |  127 lines
  1. package FileCache;
  2.  
  3. our $VERSION = '1.021';
  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 $path;
  16.     print $path @data;
  17.  
  18.     cacheout $mode, $path;
  19.     print $path @data;
  20.  
  21. =head1 DESCRIPTION
  22.  
  23. The C<cacheout> function will make sure that there's a filehandle open
  24. for reading or writing available as the pathname you give it. It
  25. automatically closes and re-opens files if you exceed  your system's
  26. maximum number of file descriptors, or the suggested maximum.
  27.  
  28. =over
  29.  
  30. =item cacheout EXPR
  31.  
  32. The 1-argument form of cacheout will open a file for writing (C<< '>' >>)
  33. on it's first use, and appending (C<<< '>>' >>>) thereafter.
  34.  
  35. =item cacheout MODE, EXPR
  36.  
  37. The 2-argument form of cacheout will use the supplied mode for the initial
  38. and subsequent openings. Most valid modes for 3-argument C<open> are supported
  39. namely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
  40. C< '|-' > and C< '-|' >
  41.  
  42. =head1 CAVEATS
  43.  
  44. If you use cacheout with C<'|-'> or C<'-|'> you should catch SIGPIPE
  45. and explicitly close the filehandle., when it is closed from the
  46. other end some cleanup needs to be done.
  47.  
  48. While it is permissible to C<close> a FileCache managed file,
  49. do not do so if you are calling C<FileCache::cacheout> from a package other
  50. than which it was imported, or with another module which overrides C<close>.
  51. If you must, use C<FileCache::cacheout_close>.
  52.  
  53. =head1 BUGS
  54.  
  55. F<sys/param.h> lies with its C<NOFILE> define on some systems,
  56. so you may have to set maxopen (I<$FileCache::cacheout_maxopen>) yourself.
  57.  
  58. =cut
  59.  
  60. require 5.006;
  61. use Carp;
  62. use strict;
  63. no strict 'refs';
  64. use vars qw(%saw $cacheout_maxopen);
  65. # These are not C<my> for legacy reasons.
  66. # Previous versions requested the user set $cacheout_maxopen by hand.
  67. # Some authors fiddled with %saw to overcome the clobber on initial open.
  68. my %isopen;
  69. my $cacheout_seq = 0;
  70.  
  71. sub import {
  72.     my ($pkg,%args) = @_;
  73.     *{caller(1).'::cacheout'} = \&cacheout;
  74.     *{caller(1).'::close'}    = \&cacheout_close;
  75.  
  76.     # Truth is okay here because setting maxopen to 0 would be bad
  77.     return $cacheout_maxopen = $args{maxopen} if $args{maxopen} ;
  78.     if (open(PARAM,'/usr/include/sys/param.h')) {
  79.       local ($_, $.);
  80.       while (<PARAM>) {
  81.     $cacheout_maxopen = $1 - 4
  82.       if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  83.       }
  84.       close PARAM;
  85.     }
  86.     $cacheout_maxopen ||= 16;
  87. }
  88.  
  89. # Open in their package.
  90.  
  91. sub cacheout_open {
  92.     open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]);
  93. }
  94.  
  95. # Close in their package.
  96.  
  97. sub cacheout_close {
  98.     fileno(*{caller(1) . '::' . $_[0]}) &&
  99.       CORE::close(*{caller(1) . '::' . $_[0]});
  100.     delete $isopen{$_[0]};
  101. }
  102.  
  103. # But only this sub name is visible to them.
  104.  
  105. sub cacheout {
  106.     croak "Not enough arguments for cacheout"  unless @_;
  107.     croak "Too many arguments for cacheout" if scalar @_ > 2;
  108.     my($mode, $file)=@_;
  109.     ($file, $mode) = ($mode, $file) if scalar @_ == 1;
  110.     # We don't want children
  111.     croak "Invalid file for cacheout" if $file =~ /^\s*(?:\|\-)|(?:\-\|)\s*$/;
  112.     croak "Invalid mode for cacheout" if $mode &&
  113.       ( $mode !~ /^\s*(?:>>)|(?:\+?>)|(?:\+?<)|(?:\|\-)|(?:\-\|)\s*$/ );
  114.  
  115.     unless( $isopen{$file}) {
  116.       if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
  117.     my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
  118.     &cacheout_close($_) for splice(@lru, $cacheout_maxopen / 3);
  119.       }
  120.       $mode ||=  ( $saw{$file} = ! $saw{$file} ) ? '>': '>>';
  121.       cacheout_open($mode, $file) or croak("Can't create $file: $!");
  122.     }
  123.     $isopen{$file} = ++$cacheout_seq;
  124. }
  125.  
  126. 1;
  127.