or warn "Unable to unlink lockfile $fl{file}: $!";
}
+=head2 lockpid
+
+ lockpid('/path/to/pidfile');
+
+Creates a pidfile '/path/to/pidfile' if one doesn't exist or if the
+pid in the file does not respond to kill 0.
+
+Returns 1 on success, false on failure; dies on unusual errors.
+
+=cut
+
+sub lockpid {
+ my ($pidfile) = @_;
+ if (-e $pidfile) {
+ my $pidfh = IO::File->new($pidfile, 'r') or
+ die "Unable to open pidfile $pidfile: $!"
+ local $/;
+ my $pid = <$pidfh>;
+ ($pid) = $pid =~ /(\d+)/;
+ if (defined $pid and kill(0,$pid)) {
+ return 0;
+ }
+ close $pidfh;
+ unlink $pidfile or
+ die "Unable to unlink stale pidfile $pidfile $!";
+ }
+ my $pidfh = IO::File->new($pidfile), 'w' or
+ die "Unable to open $pidfile for writing: $!";
+ print {$pidfh} $$ or die "Unable to write to $pidfile $!";
+ close $pidfh or die "Unable to close $pidfile $!";
+ return 1;
+}
=head1 QUIT
our $exit_now = 0;
$SIG{INT} = sub {$exit_now=1;};
#process each bug (ie, status file)
-while (length($bug=shift(@list))) {
+my @bugs_to_archive = ();
+for my $bug (@list))) {
# Weeeee.
print "Examining $bug\n" if $verbose;
next unless bug_archiveable(bug=>$bug);
+ push @bugs_to_archive,$bug;
+}
+
+# At this point we want to block control
+if (not lockpid($config{spool_dir}.'/lock/expire.pid')) {
+ exit 1;
+}
+# We'll also double check that the bug can be archived
+for my $bug (@bugs_to_archive) {
+ print "Reexamining $bug\n" if $verbose;
+ next unless bug_archiveable(bug=>$bug);
print "Bug $bug can be archived: " if $verbose;
eval {
- bug_archive(bug=>$bug);
+ bug_archive(bug=>$bug,
+ );
print "archived.\n" if $verbose;
};
if ($@) {
}
last if $exit_now;
}
+unlink($config{spool_dir}.'/lock/expire.pid')
+
exit $errors;