xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/FileCache.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gatepackage FileCache;
2*0Sstevel@tonic-gate
3*0Sstevel@tonic-gateour $VERSION = '1.04_01';
4*0Sstevel@tonic-gate
5*0Sstevel@tonic-gate=head1 NAME
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gateFileCache - keep more files open than the system permits
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gate=head1 SYNOPSIS
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gate    use FileCache;
12*0Sstevel@tonic-gate    # or
13*0Sstevel@tonic-gate    use FileCache maxopen => 16;
14*0Sstevel@tonic-gate
15*0Sstevel@tonic-gate    cacheout $mode, $path;
16*0Sstevel@tonic-gate    # or
17*0Sstevel@tonic-gate    cacheout $path;
18*0Sstevel@tonic-gate    print $path @data;
19*0Sstevel@tonic-gate
20*0Sstevel@tonic-gate    $fh = cacheout $mode, $path;
21*0Sstevel@tonic-gate    # or
22*0Sstevel@tonic-gate    $fh = cacheout $path;
23*0Sstevel@tonic-gate    print $fh @data;
24*0Sstevel@tonic-gate
25*0Sstevel@tonic-gate=head1 DESCRIPTION
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gateThe C<cacheout> function will make sure that there's a filehandle open
28*0Sstevel@tonic-gatefor reading or writing available as the pathname you give it. It
29*0Sstevel@tonic-gateautomatically closes and re-opens files if you exceed your system's
30*0Sstevel@tonic-gatemaximum number of file descriptors, or the suggested maximum I<maxopen>.
31*0Sstevel@tonic-gate
32*0Sstevel@tonic-gate=over
33*0Sstevel@tonic-gate
34*0Sstevel@tonic-gate=item cacheout EXPR
35*0Sstevel@tonic-gate
36*0Sstevel@tonic-gateThe 1-argument form of cacheout will open a file for writing (C<< '>' >>)
37*0Sstevel@tonic-gateon it's first use, and appending (C<<< '>>' >>>) thereafter.
38*0Sstevel@tonic-gate
39*0Sstevel@tonic-gateReturns EXPR on success for convenience. You may neglect the
40*0Sstevel@tonic-gatereturn value and manipulate EXPR as the filehandle directly if you prefer.
41*0Sstevel@tonic-gate
42*0Sstevel@tonic-gate=item cacheout MODE, EXPR
43*0Sstevel@tonic-gate
44*0Sstevel@tonic-gateThe 2-argument form of cacheout will use the supplied mode for the initial
45*0Sstevel@tonic-gateand subsequent openings. Most valid modes for 3-argument C<open> are supported
46*0Sstevel@tonic-gatenamely; C<< '>' >>, C<< '+>' >>, C<< '<' >>, C<< '<+' >>, C<<< '>>' >>>,
47*0Sstevel@tonic-gateC< '|-' > and C< '-|' >
48*0Sstevel@tonic-gate
49*0Sstevel@tonic-gateTo pass supplemental arguments to a program opened with C< '|-' > or C< '-|' >
50*0Sstevel@tonic-gateappend them to the command string as you would system EXPR.
51*0Sstevel@tonic-gate
52*0Sstevel@tonic-gateReturns EXPR on success for convenience. You may neglect the
53*0Sstevel@tonic-gatereturn value and manipulate EXPR as the filehandle directly if you prefer.
54*0Sstevel@tonic-gate
55*0Sstevel@tonic-gate=head1 CAVEATS
56*0Sstevel@tonic-gate
57*0Sstevel@tonic-gateWhile it is permissible to C<close> a FileCache managed file,
58*0Sstevel@tonic-gatedo not do so if you are calling C<FileCache::cacheout> from a package other
59*0Sstevel@tonic-gatethan which it was imported, or with another module which overrides C<close>.
60*0Sstevel@tonic-gateIf you must, use C<FileCache::cacheout_close>.
61*0Sstevel@tonic-gate
62*0Sstevel@tonic-gateAlthough FileCache can be used with piped opens ('-|' or '|-') doing so is
63*0Sstevel@tonic-gatestrongly discouraged.  If FileCache finds it necessary to close and then reopen
64*0Sstevel@tonic-gatea pipe, the command at the far end of the pipe will be reexecuted - the results
65*0Sstevel@tonic-gateof performing IO on FileCache'd pipes is unlikely to be what you expect.  The
66*0Sstevel@tonic-gateability to use FileCache on pipes may be removed in a future release.
67*0Sstevel@tonic-gate
68*0Sstevel@tonic-gateFileCache does not store the current file offset if it finds it necessary to
69*0Sstevel@tonic-gateclose a file.  When the file is reopened, the offset will be as specified by the
70*0Sstevel@tonic-gateoriginal C<open> file mode.  This could be construed to be a bug.
71*0Sstevel@tonic-gate
72*0Sstevel@tonic-gate=head1 BUGS
73*0Sstevel@tonic-gate
74*0Sstevel@tonic-gateF<sys/param.h> lies with its C<NOFILE> define on some systems,
75*0Sstevel@tonic-gateso you may have to set I<maxopen> yourself.
76*0Sstevel@tonic-gate
77*0Sstevel@tonic-gate=cut
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gaterequire 5.006;
80*0Sstevel@tonic-gateuse Carp;
81*0Sstevel@tonic-gateuse Config;
82*0Sstevel@tonic-gateuse strict;
83*0Sstevel@tonic-gateno strict 'refs';
84*0Sstevel@tonic-gate# These are not C<my> for legacy reasons.
85*0Sstevel@tonic-gate# Previous versions requested the user set $cacheout_maxopen by hand.
86*0Sstevel@tonic-gate# Some authors fiddled with %saw to overcome the clobber on initial open.
87*0Sstevel@tonic-gateuse vars qw(%saw $cacheout_maxopen);
88*0Sstevel@tonic-gatemy %isopen;
89*0Sstevel@tonic-gatemy $cacheout_seq = 0;
90*0Sstevel@tonic-gate
91*0Sstevel@tonic-gatesub import {
92*0Sstevel@tonic-gate    my ($pkg,%args) = @_;
93*0Sstevel@tonic-gate    $pkg = caller(1);
94*0Sstevel@tonic-gate    *{$pkg.'::cacheout'} = \&cacheout;
95*0Sstevel@tonic-gate    *{$pkg.'::close'}    = \&cacheout_close;
96*0Sstevel@tonic-gate
97*0Sstevel@tonic-gate    # Truth is okay here because setting maxopen to 0 would be bad
98*0Sstevel@tonic-gate    return $cacheout_maxopen = $args{maxopen} if $args{maxopen};
99*0Sstevel@tonic-gate    foreach my $param ( '/usr/include/sys/param.h' ){
100*0Sstevel@tonic-gate      if (open($param, '<', $param)) {
101*0Sstevel@tonic-gate	local ($_, $.);
102*0Sstevel@tonic-gate	while (<$param>) {
103*0Sstevel@tonic-gate	  if( /^\s*#\s*define\s+NOFILE\s+(\d+)/ ){
104*0Sstevel@tonic-gate	    $cacheout_maxopen = $1 - 4;
105*0Sstevel@tonic-gate	    close($param);
106*0Sstevel@tonic-gate	    last;
107*0Sstevel@tonic-gate	  }
108*0Sstevel@tonic-gate	}
109*0Sstevel@tonic-gate	close $param;
110*0Sstevel@tonic-gate      }
111*0Sstevel@tonic-gate    }
112*0Sstevel@tonic-gate    $cacheout_maxopen ||= 16;
113*0Sstevel@tonic-gate}
114*0Sstevel@tonic-gate
115*0Sstevel@tonic-gate# Open in their package.
116*0Sstevel@tonic-gatesub cacheout_open {
117*0Sstevel@tonic-gate  return open(*{caller(1) . '::' . $_[1]}, $_[0], $_[1]) && $_[1];
118*0Sstevel@tonic-gate}
119*0Sstevel@tonic-gate
120*0Sstevel@tonic-gate# Close in their package.
121*0Sstevel@tonic-gatesub cacheout_close {
122*0Sstevel@tonic-gate  # Short-circuit in case the filehandle disappeared
123*0Sstevel@tonic-gate  my $pkg = caller($_[1]||0);
124*0Sstevel@tonic-gate  fileno(*{$pkg . '::' . $_[0]}) &&
125*0Sstevel@tonic-gate    CORE::close(*{$pkg . '::' . $_[0]});
126*0Sstevel@tonic-gate  delete $isopen{$_[0]};
127*0Sstevel@tonic-gate}
128*0Sstevel@tonic-gate
129*0Sstevel@tonic-gate# But only this sub name is visible to them.
130*0Sstevel@tonic-gatesub cacheout {
131*0Sstevel@tonic-gate    my($mode, $file, $class, $ret, $ref, $narg);
132*0Sstevel@tonic-gate    croak "Not enough arguments for cacheout"  unless $narg = scalar @_;
133*0Sstevel@tonic-gate    croak "Too many arguments for cacheout"    if $narg > 2;
134*0Sstevel@tonic-gate
135*0Sstevel@tonic-gate    ($mode, $file) = @_;
136*0Sstevel@tonic-gate    ($file, $mode) = ($mode, $file) if $narg == 1;
137*0Sstevel@tonic-gate    croak "Invalid mode for cacheout" if $mode &&
138*0Sstevel@tonic-gate      ( $mode !~ /^\s*(?:>>|\+?>|\+?<|\|\-|)|\-\|\s*$/ );
139*0Sstevel@tonic-gate
140*0Sstevel@tonic-gate    # Mode changed?
141*0Sstevel@tonic-gate    if( $isopen{$file} && ($mode||'>') ne $isopen{$file}->[2] ){
142*0Sstevel@tonic-gate      &cacheout_close($file, 1);
143*0Sstevel@tonic-gate    }
144*0Sstevel@tonic-gate
145*0Sstevel@tonic-gate    if( $isopen{$file}) {
146*0Sstevel@tonic-gate      $ret = $file;
147*0Sstevel@tonic-gate      $isopen{$file}->[0]++;
148*0Sstevel@tonic-gate    }
149*0Sstevel@tonic-gate    else{
150*0Sstevel@tonic-gate      if( scalar keys(%isopen) > $cacheout_maxopen -1 ) {
151*0Sstevel@tonic-gate	my @lru = sort{ $isopen{$a}->[0] <=> $isopen{$b}->[0] } keys(%isopen);
152*0Sstevel@tonic-gate	$cacheout_seq = 0;
153*0Sstevel@tonic-gate	$isopen{$_}->[0] = $cacheout_seq++ for
154*0Sstevel@tonic-gate	  splice(@lru, int($cacheout_maxopen / 3)||$cacheout_maxopen);
155*0Sstevel@tonic-gate	&cacheout_close($_, 1) for @lru;
156*0Sstevel@tonic-gate      }
157*0Sstevel@tonic-gate
158*0Sstevel@tonic-gate      unless( $ref ){
159*0Sstevel@tonic-gate	$mode ||= $saw{$file} ? '>>' : ($saw{$file}=1, '>');
160*0Sstevel@tonic-gate      }
161*0Sstevel@tonic-gate      #XXX should we just return the value from cacheout_open, no croak?
162*0Sstevel@tonic-gate      $ret = cacheout_open($mode, $file) or croak("Can't create $file: $!");
163*0Sstevel@tonic-gate
164*0Sstevel@tonic-gate      $isopen{$file} = [++$cacheout_seq, $mode];
165*0Sstevel@tonic-gate    }
166*0Sstevel@tonic-gate    return $ret;
167*0Sstevel@tonic-gate}
168*0Sstevel@tonic-gate1;
169