Commit | Line | Data |
---|---|---|
c07a80fd | 1 | package FileCache; |
2 | ||
b75c8c73 MS |
3 | our $VERSION = '1.00'; |
4 | ||
c07a80fd | 5 | =head1 NAME |
6 | ||
7 | FileCache - keep more files open than the system permits | |
8 | ||
9 | =head1 SYNOPSIS | |
10 | ||
11 | cacheout $path; | |
12 | print $path @data; | |
13 | ||
14 | =head1 DESCRIPTION | |
15 | ||
16 | The C<cacheout> function will make sure that there's a filehandle open | |
17 | for writing available as the pathname you give it. It automatically | |
18 | closes and re-opens files if you exceed your system file descriptor | |
19 | maximum. | |
20 | ||
21 | =head1 BUGS | |
22 | ||
23 | F<sys/param.h> lies with its C<NOFILE> define on some systems, | |
687277c3 | 24 | so you may have to set $FileCache::cacheout_maxopen yourself. |
c07a80fd | 25 | |
26 | =cut | |
27 | ||
28 | require 5.000; | |
29 | use Carp; | |
30 | use Exporter; | |
31 | ||
32 | @ISA = qw(Exporter); | |
33 | @EXPORT = qw( | |
34 | cacheout | |
35 | ); | |
36 | ||
37 | # Open in their package. | |
38 | ||
39 | sub cacheout_open { | |
40 | my $pack = caller(1); | |
41 | open(*{$pack . '::' . $_[0]}, $_[1]); | |
42 | } | |
43 | ||
44 | sub cacheout_close { | |
45 | my $pack = caller(1); | |
46 | close(*{$pack . '::' . $_[0]}); | |
47 | } | |
48 | ||
49 | # But only this sub name is visible to them. | |
50 | ||
51 | $cacheout_seq = 0; | |
52 | $cacheout_numopen = 0; | |
53 | ||
54 | sub cacheout { | |
55 | ($file) = @_; | |
56 | unless (defined $cacheout_maxopen) { | |
57 | if (open(PARAM,'/usr/include/sys/param.h')) { | |
7adad424 | 58 | local ($_, $.); |
c07a80fd | 59 | while (<PARAM>) { |
60 | $cacheout_maxopen = $1 - 4 | |
61 | if /^\s*#\s*define\s+NOFILE\s+(\d+)/; | |
62 | } | |
63 | close PARAM; | |
64 | } | |
65 | $cacheout_maxopen = 16 unless $cacheout_maxopen; | |
66 | } | |
67 | if (!$isopen{$file}) { | |
68 | if (++$cacheout_numopen > $cacheout_maxopen) { | |
69 | my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); | |
70 | splice(@lru, $cacheout_maxopen / 3); | |
71 | $cacheout_numopen -= @lru; | |
72 | for (@lru) { &cacheout_close($_); delete $isopen{$_}; } | |
73 | } | |
74 | cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file) | |
75 | or croak("Can't create $file: $!"); | |
76 | } | |
77 | $isopen{$file} = ++$cacheout_seq; | |
78 | } | |
79 | ||
80 | 1; |