#!/usr/bin/perl -w

package Chkworld;

use sort "_quicksort";
use warnings;
no warnings qw( uninitialized );
use File::Find;
use IO::File;

use Data::Dumper;

sub contents {
    my $sfh = IO::File->new( "< $_" );
    local $/ = undef;
    my $cont = $sfh->getline;
    $sfh->close;
    return $cont;
}

sub getpids{
    my @pids = @_;
    my @allpids;
    for my $pid (@pids){
        my @childs = qx/pgrep -P $pid/;
        chomp @childs;
        push @allpids, $pid, getpids(@childs);
    }
    @allpids;
}

sub timeout{ #time, command
    my ($time, $comm) = @_;
    my $output;
    my $pid;

    eval{                                                     
	local $SIG{ALRM} = sub {die "alarm\n" };
	alarm $time;            
	$pid = open(COMM, "$comm|");
	$output = scalar <COMM>;
	close COMM;                                                                 
    };                                                                              
    if ($@) {                
	do{                                 
	    my @chldpids = getpids($pid);
	    for my $chldpid (@chldpids) {
		kill TERM => $chldpid;
	    }          
	    return 'TIMEOUTED';
	} if $@ eq "alarm\n";
	#	die $@ unless $@ && $@ eq "alarm\n";                                        
    }                    
    return $output;
}


#IN:   dirs*, time*, devel* sort* output preoutput postoutput
#OUT:#
sub init_chk { #generate the iterator
    
    
    my %input = @_;
    
    $input{dirs} = (@{$input{dirs}}) ? $input{dirs} : ['.',];
    $input{time} = $input{time} || 30;

    $input{output} = $input{output} || sub {print "@_\n";};
    $input{preoutput} = $input{preoutput} || sub {};
    $input{postoutput} = $input{postoutput} || sub {};
    
    my @blacklist = @{$input{blacklist}};
    my %m8rs;
    my $dev = $input{devel};
    my ($m8r,$pkgname,$pkgver,$group,$up2date,$signal);    
    my $prog;

    if ($input{sort}){
	find sub{
	    if (/^FrugalBuild\z/) {
		do {next if $File::Find::dir =~ /$blacklist[$_]/} for 0..scalar @blacklist-1;
		my $buildscript = contents $_;
		my ($m8r) = $buildscript =~ /^# Maintainer: (.*?) </m;
		$m8r =~ s/^\s+//;
                $m8r =~ s/\s+$//;
		$m8rs{$m8r}++;
	    }
	}, @{$input{dirs}};
    } else { if ($input{devel}) {$m8rs{$input{devel}}++;} else { $m8rs{all}++ }}
    
    return sub {
	$input{preoutput}->();
	for $dev (sort m8r_sort keys(%m8rs)){
	    find sub{
		if (/^FrugalBuild\z/){
		    do {goto OUT if $File::Find::dir =~ /$blacklist[$_]/} for 0..scalar @blacklist-1;
		    my $buildscript = contents $_;
		    ($m8r) = $buildscript =~ /^# Maintainer: (.*?) </m;
		    $m8r =~ s/^\s+//;
                    $m8r =~ s/\s+$//;
		    do {next unless $m8r =~ /\Q$dev\E/i } if $input{devel} || $input{sort};
		    ($pkgname) = qx'source /usr/lib/frugalware/fwmakepkg;source ./FrugalBuild; echo -n $pkgname';
		    ($pkgver) = qx'source /usr/lib/frugalware/fwmakepkg;source ./FrugalBuild; echo -n $pkgver';
		    ($group) = qx'source /usr/lib/frugalware/fwmakepkg;source ./FrugalBuild; echo -n $groups';
		    $group = '?' unless $group;
		
		    $up2date = timeout $input{time}, 'source /usr/lib/frugalware/fwmakepkg;source ./FrugalBuild;if ( `echo $up2date|grep -q " "` ); then eval $up2date; else echo $up2date; fi';
		    chomp $up2date unless $up2date eq 'TIMEOUTED';
		
		    if ($up2date eq 'TIMEOUTED') {	
			$signal = -1;
		    } elsif ($pkgver ne $up2date){
			$signal = 0;
		    } else {
			$signal = 1;
		    }
		    $input{output}->($m8r,$pkgname,$pkgver,$up2date,$group,$signal);
	      OUT: next;
	        }
	     }, @{$input{dirs}};
    
        }
        $input{postoutput}->();
    }
}

sub m8r_sort {
	return lc($a) cmp lc($b);
}

package main;

use strict;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;

our $VERSION = "0.9";

#my %opts;
#getopts('svcmhet:d:b:', \%opts);

my ($sort,$devel,$html,$time,$error,$verbose,$color,$help,@bl,@dirs);

GetOptions(
    's|sort' => \$sort, 'd|devel:s' => \$devel, 'm|html' => \$html,
    't|time:i' => \$time, 'b|blacklist:s{,}' => \@bl, 'e|error' => \$error,
    'v|verbose' => \$verbose, 'c|color' => \$color, 'h|help' => \$help,
    'r|dirs:s{,}' => \@dirs,
    ) || pod2usage(0);

sub HELP_MESSAGE(){
    pod2usage(1);
}
    
HELP_MESSAGE && exit if $help;

# better be in a module!!!!!!!!!!!!!! 
my $count = 0;
my $needupdate = 0;
my $maybebroken = 0;
my $timeouted = 0;
my $passed = 0;
my ($preout, $out, $postout);

sub std_preout {open STDERR, "/dev/null" unless $error; }
sub std_out {
    my ($m8r,$pkgname,$pkgver,$up2date,$group,$signal) = @_;

    $count++;
    my $info = "Checking for $group/$pkgname-$pkgver... ";
    print $info if $verbose;
    if ($signal == -1) {	
        $timeouted++; #$noout = 0;
	print $info unless $verbose;
	if ($color){
	    print "\033[1;33mTimed out!\033[1;0m $m8r\n";
	} else {
	    print "Timed out! $m8r\n";
	}
    } elsif ($signal == 0){
#        $noout = 0;
	print $info unless $verbose;
	if ($color){
	    print ($up2date ? ("!= \033[1;31m" . substr($up2date, 0, 12)."\033[1;0m" )  : "\033[1;33mThere was no output!\033[1;0m");
	} else {
	    print ($up2date ? ("!= " . substr($up2date, 0, 12)) : "There was no output!");
	}
	($up2date ? ($needupdate++) : ($maybebroken++));
	print " $m8r\n";
    } else {
	$passed++;
	print "Passed $m8r\n" if $verbose && !$color;
	print "\033[1;32mPassed\033[1;0m\n" if $verbose && $color;
    }
}

sub std_postout {
    print "\nTotal packages checked: $count\n";
    print "Passed                : $passed\n";
    print "Need to update        : $needupdate\n";
    print "Timed out             : $timeouted\n";
    print "Maybe broken up2date  : $maybebroken\n";
}

sub htmlinfo{ #info
	my ($info) = @_;

	return "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\t$info\n\t\t\t\t</td>\n";
}

sub htmlres{ #status, res
	my ($status, $res) = @_;

	if($status) {
		return "\t\t\t\t<td>\n\t\t\t\t\t<font color=\"green\">$res</font>\n\t\t\t\t</td>\n\t\t\t</tr>\n";
	} else {
		return "\t\t\t\t<td>\n\t\t\t\t\t<font color=\"red\">$res</font>\n\t\t\t\t</td>\n\t\t\t</tr>\n";
	}
}

sub html_preout {
    open STDERR, "/dev/null" unless $error;
    print "<html>\n\t<head>\n\t\t<title>\n\t\t\tChkworld status\n\t\t</title>\n\t</head>\n\t<body>\n";
    print "\t\t<i>Last updated: " . localtime() . "</i>\n";
    print "\t\t<table>\n";
}

sub html_out{
    my ($m8r,$pkgname,$pkgver,$up2date,$group,$signal) = @_;

    $count++;
    my $info = "Checking for $group/$pkgname-$pkgver... ";
    print htmlinfo $info if $verbose;
    if ($signal == -1) {	
        $timeouted++; #$noout = 0;
	print htmlinfo $info unless $verbose;
	print htmlres(0, "Timed out! $m8r");
    } elsif ($signal == 0){
#        $noout = 0;
	print htmlinfo $info unless $verbose;
	print (htmlres(0, $up2date ? ("!= " . substr($up2date, 0, 12)) . " $m8r": "There was no output! $m8r"));
	($up2date ? ($needupdate++) : ($maybebroken++));
    } else {
	$passed++;
	print htmlres(1, "Passed $m8r") if $verbose;
    }
}

sub html_postout{
    print "\t\t</table>\n";
    print "\t\t<table>\n";
    print "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\tTotal packages checked:\n\t\t\t\t</td>\n";
    print "\t\t\t\t<td>\n\t\t\t\t\t$count\n\t\t\t\t</td>\n\t\t\t</tr>\n";
    print "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\tPassed\n\t\t\t\t</td>\n";
    print "\t\t\t\t<td>\n\t\t\t\t\t$passed\n\t\t\t\t</td>\n\t\t\t</tr>\n";
    print "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\tNeed to update:\n\t\t\t\t</td>\n";
    print "\t\t\t\t<td>\n\t\t\t\t\t$needupdate\n\t\t\t\t</td>\n\t\t\t</tr>\n";
    print "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\tTimed out:\n\t\t\t\t</td>\n";
    print "\t\t\t\t<td>\n\t\t\t\t\t$timeouted\n\t\t\t\t</td>\n\t\t\t</tr>\n";
    print "\t\t\t<tr>\n\t\t\t\t<td>\n\t\t\t\t\tMaybe broken up2date:\n\t\t\t\t</td>\n";
    print "\t\t\t\t<td>\n\t\t\t\t\t$maybebroken\n\t\t\t\t</td>\n\t\t\t</tr>\n";
    print "\t\t</table>\n";
    print "\t</body>\n</html>\n";
}


$preout = $html ? \&html_preout : \&std_preout;
$out = $html ? \&html_out : \&std_out;
$postout = $html ? \&html_postout : \&std_postout;

my $chkw = Chkworld::init_chk(
			      dirs => \@dirs,
			      time => $time,
			      devel => $devel,
			      sort => $sort,
			      blacklist => \@bl,
			      preoutput => $preout,
			      output => $out,
			      postoutput => $postout,
);

$chkw->();