Commit | Line | Data |
c07a80fd |
1 | package FileCache; |
2 | |
c14fc35a |
3 | our $VERSION = '1.02'; |
b75c8c73 |
4 | |
c07a80fd |
5 | =head1 NAME |
6 | |
7 | FileCache - keep more files open than the system permits |
8 | |
9 | =head1 SYNOPSIS |
10 | |
c14fc35a |
11 | use FileCache; |
12 | # or |
13 | use FileCache maxopen => 16; |
14 | |
c07a80fd |
15 | cacheout $path; |
16 | print $path @data; |
17 | |
c14fc35a |
18 | cacheout $mode, $path; |
19 | print $path @data; |
20 | |
c07a80fd |
21 | =head1 DESCRIPTION |
22 | |
23 | The C<cacheout> function will make sure that there's a filehandle open |
c14fc35a |
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. |
c07a80fd |
27 | |
c14fc35a |
28 | =over |
7c21b9ea |
29 | |
c14fc35a |
30 | =item cacheout EXPR |
7c21b9ea |
31 | |
c14fc35a |
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 |
7c21b9ea |
43 | |
c14fc35a |
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. |
7c21b9ea |
47 | |
c07a80fd |
48 | =head1 BUGS |
49 | |
50 | F<sys/param.h> lies with its C<NOFILE> define on some systems, |
c14fc35a |
51 | so you may have to set maxopen (I<$FileCache::cacheout_maxopen>) yourself. |
c07a80fd |
52 | |
53 | =cut |
54 | |
55 | require 5.000; |
56 | use Carp; |
7c21b9ea |
57 | use strict; |
c14fc35a |
58 | no strict 'refs'; |
59 | use vars qw(%saw $cacheout_maxopen); |
60 | # These are not C<my> for legacy reasons. |
61 | # Previous versions requested the user set $cacheout_maxopen by hand. |
62 | # Some authors fiddled with %saw to overcome the clobber on initial open. |
7c21b9ea |
63 | my %isopen; |
64 | my $cacheout_seq = 0; |
65 | |
c14fc35a |
66 | sub import { |
67 | my ($pkg,%args) = @_; |
68 | *{caller(1).'::cacheout'} = \&cacheout; |
69 | *{caller(1).'::close'} = \&cacheout_close; |
70 | |
71 | # Truth is okay here because setting maxopen to 0 would be bad |
72 | return $cacheout_maxopen = $args{maxopen} if $args{maxopen} ; |
73 | if (open(PARAM,'/usr/include/sys/param.h')) { |
74 | local ($_, $.); |
75 | while (<PARAM>) { |
76 | $cacheout_maxopen = $1 - 4 |
77 | if /^\s*#\s*define\s+NOFILE\s+(\d+)/; |
78 | } |
79 | close PARAM; |
80 | } |
81 | $cacheout_maxopen ||= 16; |
82 | } |
83 | |
c07a80fd |
84 | # Open in their package. |
85 | |
86 | sub cacheout_open { |
c14fc35a |
87 | open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]); |
c07a80fd |
88 | } |
89 | |
c14fc35a |
90 | # Close in their package. |
91 | |
c07a80fd |
92 | sub cacheout_close { |
c14fc35a |
93 | fileno(*{caller(1) . '::' . $_[0]}) && |
94 | CORE::close(*{caller(1) . '::' . $_[0]}); |
95 | delete $isopen{$_[0]}; |
c07a80fd |
96 | } |
97 | |
98 | # But only this sub name is visible to them. |
c14fc35a |
99 | |
c07a80fd |
100 | sub cacheout { |
c14fc35a |
101 | croak "Not enough arguments for cacheout" unless @_; |
102 | croak "Too many arguments for cacheout" if scalar @_ > 2; |
103 | my($mode, $file)=@_; |
104 | ($file, $mode) = ($mode, $file) if scalar @_ == 1; |
105 | # We don't want children |
106 | croak "Invalid file for cacheout" if $file =~ /^\s*(?:\|\-)|(?:\-\|)\s*$/; |
107 | croak "Invalid mode for cacheout" if $mode && |
108 | ( $mode !~ /^\s*(?:>>)|(?:\+?>)|(?:\+?<)|(?:\|\-)|(?:\-\|)\s*$/ ); |
109 | |
110 | unless( $isopen{$file}) { |
111 | if( scalar keys(%isopen) > $cacheout_maxopen -1 ) { |
112 | my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); |
113 | &cacheout_close($_) for splice(@lru, $cacheout_maxopen / 3); |
114 | } |
115 | $mode ||= ( $saw{$file} = ! $saw{$file} ) ? '>': '>>'; |
116 | cacheout_open($mode, $file) or croak("Can't create $file: $!"); |
c07a80fd |
117 | } |
118 | $isopen{$file} = ++$cacheout_seq; |
119 | } |
120 | |
121 | 1; |