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