#!/usr/bin/perl
#
# check-old-build: check for packages which are in Building for extended time
# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

use strict;
use warnings;
use Time::Local;

my $HOME = $ENV{'HOME'}
  or die "HOME not defined in environment!\n";

sub check (@);
sub notify_mail (@);
sub parse_date ($);

my $reported_file = "$HOME/lib/reported-old-builds";
my $list_cmd      = "wanna-build --list=building -v";
my $report_days   = 10;
my $mailprog      = "/usr/sbin/sendmail";
chomp(my $mailname = `cat /etc/mailname` || `hostname`);
my $sender = $ENV{'LOGNAME'} || (getpwuid($<))[0];

my ($pkg, $builder, $date);
my %reported;
my %seen;
my $now         = time;
my $report_time = $report_days * 24 * 60 * 60;

my %monname = (
	'jan', 0, 'feb', 1, 'mar', 2, 'apr', 3, 'may', 4,  'jun', 5,
	'jul', 6, 'aug', 7, 'sep', 8, 'oct', 9, 'nov', 10, 'dec', 11
);

if (open(F, "<$reported_file")) {
	while (<F>) {
		next if !/^(\S+)\s+(\S+)\s+(\d+)$/;
		$reported{$2}->{$1} = $3;
	}
	close(F);
}

my $dist;
foreach $dist (qw(stable frozen unstable)) {
	open(PIPE, "$list_cmd --dist=$dist 2>&1 |")
	  or die "Cannot spawn $list_cmd: $!\n";
	while (<PIPE>) {
		next if /^wanna-build Revision/ || /^Total \d+ package/;
		if (/^Database for \S+ doesn't exist/i) {
			last;
		} elsif (m,^\S*/(\S+) by (\S+) \[.*\]$,) {
			($pkg, $builder) = ($1, $2);
			$seen{$dist}->{$pkg} = 1;
		} elsif (/^\s+Previous state was \S+ until (.*)$/) {
			$date = parse_date($1);
			check($dist, $pkg, $builder, $date);
		} elsif (/^Database locked by \S+ -- please wait/ || /^\s/) {
			# ignore
		} else {
			warn "Unexpected output from $list_cmd line $.:\n$_";
		}
	}
	close(PIPE);
}

open(F, ">$reported_file")
  or die "Cannot open $reported_file for writing: $!\n";
foreach $dist (qw(stable frozen unstable)) {
	foreach (keys %{ $reported{$dist} }) {
		print F "$_ $dist $reported{$dist}->{$_}\n"
		  if $seen{$dist}->{$_};
	}
}
close(F);

exit 0;

sub check (@) {
	my ($dist, $pkg, $builder, $bdate) = @_;
	my $date
	  = (exists $reported{$dist}->{$pkg}) ? $reported{$dist}->{$pkg} : $bdate;

	if ($now - $date > $report_time) {
		notify_mail($dist, $pkg, $builder, $bdate);
		$reported{$dist}->{$pkg} = $now;
	}
}

sub notify_mail (@) {
	my ($dist, $pkg, $to, $_date) = @_;
	my $date = localtime($date);
	local (*MAIL);

	local $SIG{'PIPE'} = 'IGNORE';
	open(MAIL, "| $mailprog -oem $to\@$mailname")
	  or die "Can't open pipe to $mailprog: $!\n";
	print MAIL <<"EOF";
From: $sender\@$mailname
To: $to\@$mailname
Subject: Old build of $pkg (dist=$dist)

The package $pkg has been taken by you for
building in distribution $dist at $date.
This is some time ago now, so it could be you have forgotten the build.
Can you please check this and --if this is the case-- give back the package
or finish it?
If you did not call wanna-build --uploaded, it might also be the case
that the package is not yet installed in the archive.

(This is an automated message.)
EOF
	close(MAIL);
}

sub parse_date ($) {
	my $text = shift;

	die "Cannot parse date: $text\n"
	  if $text !~ /^(\d{4}) (\w{3}) (\d+) (\d{2}):(\d{2}):(\d{2})$/;
	my ($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
	$mon =~ y/A-Z/a-z/;
	die "Invalid month name $mon" if !exists $monname{$mon};
	$mon = $monname{$mon};
	return timelocal($sec, $min, $hour, $day, $mon, $year);
}
