use strict;
use warnings;
# ----------------------------------------------------------------------------
# simple file cache to handle more "open" files than the system allows
# the cache gets created with an explicit limit, which gets automatically
# decreased if a file open fails
# handles only files for writing, which gets opened the first time with '>'
# and later with '>>'
# ----------------------------------------------------------------------------
package privFileCache;
use fields qw(open closed max n);
sub new {
my ($class,$max) = @_;
my $self = fields::new($class);
$self->{n} = 0;
$self->{max} = $max||128;
$self->{open} = {};
$self->{closed} = {};
return $self;
}
sub add {
my ($self,$fname) = @_;
return $self->get($fname,1);
}
sub del {
my ($self,$fname) = @_;
delete $self->{open}{$fname};
delete $self->{closed}{$fname};
}
sub get {
my ($self,$fname,$create) = @_;
my $fh = $self->{open}{$fname};
$fh = $fh && $fh->[0];
if ( $create ) {
_expire($self) if ! $fh;
$fh = _open($self,'>',$fname) or return;
}
if ( ! $fh ) {
$self->{closed}{$fname} or die "$fname not in pool";
$fh = _open($self,'>>',$fname) or return;
delete $self->{closed}{$fname};
}
$self->{open}{$fname} = [ $fh,$self->{n}++ ];
return $fh;
}
sub _open {
my ($self,$what,$fname) = @_;
my $fh;
while ( ! open( $fh,$what,$fname )) {
if ( $!{ENFILE} || $!{EMFILE} || $!{ENOMEM} ) {
$self->{max}-- >1 or die "pool to small";
_expire($self);
} else {
return;
}
}
return $fh;
}
sub _expire {
my ($self) = @_;
my @fn = keys %{$self->{open}};
@fn > $self->{max} or return;
@fn = sort { $self->{open}{$a}[1] <=> $self->{open}{$b}[1] } @fn;
while (@fn > $self->{max}) {
my $fn = shift(@fn);
delete $self->{open}{$fn};
$self->{closed}{$fn} = 1;
}
}
1;