1 | package FileCache;
|
---|
2 |
|
---|
3 | our $VERSION = '1.06';
|
---|
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 Config;
|
---|
84 | use strict;
|
---|
85 | no strict 'refs';
|
---|
86 |
|
---|
87 | # These are not C<my> for legacy reasons.
|
---|
88 | # Previous versions requested the user set $cacheout_maxopen by hand.
|
---|
89 | # Some authors fiddled with %saw to overcome the clobber on initial open.
|
---|
90 | use vars qw(%saw $cacheout_maxopen);
|
---|
91 | $cacheout_maxopen = 16;
|
---|
92 |
|
---|
93 | use base 'Exporter';
|
---|
94 | our @EXPORT = qw[cacheout cacheout_close];
|
---|
95 |
|
---|
96 |
|
---|
97 | my %isopen;
|
---|
98 | my $cacheout_seq = 0;
|
---|
99 |
|
---|
100 | sub import {
|
---|
101 | my ($pkg,%args) = @_;
|
---|
102 |
|
---|
103 | # Use Exporter. %args are for us, not Exporter.
|
---|
104 | # Make sure to up export_to_level, or we will import into ourselves,
|
---|
105 | # rather than our calling package;
|
---|
106 |
|
---|
107 | __PACKAGE__->export_to_level(1);
|
---|
108 | Exporter::import( $pkg );
|
---|
109 |
|
---|
110 | # Truth is okay here because setting maxopen to 0 would be bad
|
---|
111 | return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
|
---|
112 |
|
---|
113 | # XXX This code is crazy. Why is it a one element foreach loop?
|
---|
114 | # Why is it using $param both as a filename and filehandle?
|
---|
115 | foreach my $param ( '/usr/include/sys/param.h' ){
|
---|
116 | if (open($param, '<', $param)) {
|
---|
117 | local ($_, $.);
|
---|
118 | while (<$param>) {
|
---|
119 | if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
|
---|
120 | $cacheout_maxopen = $1 - 4;
|
---|
121 | close($param);
|
---|
122 | last;
|
---|
123 | }
|
---|
124 | }
|
---|
125 | close $param;
|
---|
126 | }
|
---|
127 | }
|
---|
128 | $cacheout_maxopen ||= 16;
|
---|
129 | }
|
---|
130 |
|
---|
131 | # Open in their package.
|
---|
132 | sub cacheout_open {
|
---|
133 | return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
|
---|
134 | }
|
---|
135 |
|
---|
136 | # Close in their package.
|
---|
137 | sub cacheout_close {
|
---|
138 | # Short-circuit in case the filehandle disappeared
|
---|
139 | my $pkg = caller($_[1]||0);
|
---|
140 | fileno(*{$pkg . '::' . $_[0]}) &&
|
---|
141 | CORE::close(*{$pkg . '::' . $_[0]});
|
---|
142 | delete $isopen{$_[0]};
|
---|
143 | }
|
---|
144 |
|
---|
145 | # But only this sub name is visible to them.
|
---|
146 | sub cacheout {
|
---|
147 | my($mode, $file, $class, $ret, $ref, $narg);
|
---|
148 | croak "Not enough arguments for cacheout" unless $narg = scalar @_;
|
---|
149 | croak "Too many arguments for cacheout" if $narg > 2;
|
---|
150 |
|
---|
151 | ($mode, $file) = @_;
|
---|
152 | ($file, $mode) = ($mode, $file) if $narg == 1;
|
---|
153 | croak "Invalid mode for cacheout" if $mode &&
|
---|
154 | ( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
|
---|
155 |
|
---|
156 | # Mode changed?
|
---|
157 | if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[1] ){
|
---|
158 | &cacheout_close($file, 1);
|
---|
159 | }
|
---|
160 |
|
---|
161 | if( $isopen{$file}) {
|
---|
162 | $ret = $file;
|
---|
163 | $isopen{$file}->[0]++;
|
---|
164 | }
|
---|
165 | else{
|
---|
166 | if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
|
---|
167 | my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
|
---|
168 | $cacheout_seq = 0;
|
---|
169 | $isopen{$_}->[0] = $cacheout_seq++ for
|
---|
170 | splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
|
---|
171 | &cacheout_close($_, 1) for @lru;
|
---|
172 | }
|
---|
173 |
|
---|
174 | unless( $ref ){
|
---|
175 | $mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
|
---|
176 | }
|
---|
177 | #XXX should we just return the value from cacheout_open, no croak?
|
---|
178 | $ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
|
---|
179 |
|
---|
180 | $isopen{$file} = [++$cacheout_seq, $mode];
|
---|
181 | }
|
---|
182 | return $ret;
|
---|
183 | }
|
---|
184 | 1;
|
---|