}
sub _destroy {
- my ($self, $in, $out, $pid) = @_;
+ my ($self, $in, $out, $pid, $expire) = @_;
+ my $rfh = $self->{$in} or return;
+ if (defined $expire) {
+ # at least FreeBSD 11.2 and Linux 4.20 update mtime of the
+ # read end of a pipe when the pipe is written to; dunno
+ # about other OSes.
+ my $mtime = (stat($rfh))[9];
+ return if $mtime > $expire;
+ }
my $p = delete $self->{$pid} or return;
foreach my $f ($in, $out) {
delete $self->{$f};
<$fh>
}
+# returns true if there are pending "git cat-file" processes
sub cleanup {
- my ($self) = @_;
- _destroy($self, qw(in out pid));
- _destroy($self, qw(in_c out_c pid_c));
+ my ($self, $expire) = @_;
+ _destroy($self, qw(in out pid), $expire);
+ _destroy($self, qw(in_c out_c pid_c), $expire);
+ !!($self->{pid} || $self->{pid_c});
}
# assuming a well-maintained repo, this should be a somewhat
my $CLEANUP = {}; # string(inbox) -> inbox
sub cleanup_task () {
$cleanup_timer = undef;
+ my $next = {};
for my $ibx (values %$CLEANUP) {
- foreach my $f (qw(git mm search)) {
+ my $again;
+ foreach my $f (qw(mm search)) {
delete $ibx->{$f} if SvREFCNT($ibx->{$f}) == 1;
}
+ my $expire = time - 60;
+ if (my $git = $ibx->{git}) {
+ $again = $git->cleanup($expire);
+ }
+ if (my $gits = $ibx->{-repo_objs}) {
+ foreach my $git (@$gits) {
+ $again = 1 if $git->cleanup($expire);
+ }
+ }
+ $again ||= !!($ibx->{mm} || $ibx->{search});
+ $next->{"$ibx"} = $ibx if $again;
}
- $CLEANUP = {};
+ $CLEANUP = $next;
}
sub _cleanup_later ($) {
open $fh, '<', "$alt/config" or die "open failed: $!\n";
my $config = eval { local $/; <$fh> };
is($$found, $config, 'alternates reloaded');
+
+ ok($gcf->cleanup(time - 30), 'cleanup did not expire');
+ ok(!$gcf->cleanup(time + 30), 'cleanup can expire');
+ ok(!$gcf->cleanup, 'cleanup idempotent');
}
use_ok 'PublicInbox::Git', qw(git_unquote git_quote);