#!/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);
}