#!/usr/bin/perl

use strict;
use HTTP::Lite;

my ($nick_base, @channels) = @ARGV;
my $svn = ((-e '.svn') ? 'svn' : 'svk');

my $refresh_dir  = '/tmp/autopugs'; # XXX: move this to a config file?
my $have_refresh = -d $refresh_dir;
my $refresh_file = "$refresh_dir/refresh";

#TODO: warn about permissions if above dir is not setgid and g+w

unless (`$svn info` =~ /\/pugs$/m) {
    die "This should be run from the root directory of a pugs $svn checkout\n";
}

chomp(my $PUGSHOME = `pwd`);

$nick_base ||= "evalbot";
@channels = ('#perl6') unless @channels;

my $pid = 0;

$ENV{PUGS_EMBED} = 'perl5';
$ENV{PERL6LIB} = "$PUGSHOME/blib6/lib";

my $pipe = "evalbot_nick";

sub update_pugs {
    print STDERR "*** Updating repository...\n";
    system "$svn update";
    my $revision;
    if ($svn eq 'svn') {
        my $info = `$svn info`;
        ($revision) = $info =~ /^Revision: (\d+)/m;
    }
    else { # SVK here
        my @info = qx/svk info/;
        if (my ($line) = grep /(?:file|svn|https?)\b/, @info) {
            ($revision) = $line =~ / (\d+)$/;
        } elsif (my ($source_line) = grep /^(Copied|Merged) From/, @info) {
            if (my ($source_depot) = $source_line =~ /From: (.*?), Rev\. \d+/) {
                $source_depot = '/'.$source_depot; # convert /svk/trunk to //svk/trunk
                if (my @info = qx/svk info $source_depot/ and $? == 0) {
                    if (my ($line) = grep /(?:file|svn|https?)\b/, @info) {
                        ($revision) = $line =~ / (\d+)$/;
                    }
                }
            }
        }
    }

    print STDERR "*** Updated to revision $revision\n";
    return $revision;
}

my $rev;
my $hasfailed = 0;

sub build_pugs {
    print STDERR "*** Rebuilding pugs\n";
    if ($have_refresh && -f $refresh_file) {
        unlink $refresh_file;
        unlink $_ for glob "$ENV{PERL6LIB}/*yml"; # XXX: should probably clean more..
    }
    unlink 'src/Pugs/pugs_version.h';
	
	my $failed = 0;
	my $report = "";
	open my $fh, 'perl Makefile.PL 2>&1 |';
	while (<$fh>) {
		print;
		$report .= $_;
	}
	close $fh;
	if ($?) { 
		$failed = 1;
	}
	else {
		open my $fh, 'make 2>&1 |';
		while (<$fh>) {
			print;
			$report .= $_;
		}
		close $fh;
		if ($?) { $failed = 1; }
	}

	if ($failed && !$hasfailed) {
		$hasfailed = 1;
		print STDERR "*** Build failed, pasting to nopaste\n";
		my $http = HTTP::Lite->new;
		$http->prepare_post({
				channel => '#perl6',
				nick    => "$nick_base\_r$rev",
				summary => "Pugs build failure",
				paste   => $report,
		});
		$http->request('http://sial.org/pbot/perl6/paste');
	}
	else {
		$hasfailed = 0;
	}
}

sub start_pugs {
    my ($nick) = @_;
    
    print STDERR "*** Starting $nick\n";
    set_nick($nick);

    if ($pid = fork) {
        return;
    }
    else {
        exec "./pugs examples/network/evalbot/evalbot.pl " .
             "'=$pipe' chat.freenode.net 900 " . join(' ', map { "'$_'" } @channels)
                or exit;
    }
}

sub set_nick {
    my ($nick) = @_;

    print STDERR "*** Resetting $nick\n";
    open my $fh, '>', $pipe;
    print $fh $nick;
}

$rev = update_pugs;
build_pugs;
start_pugs "$nick_base\_r$rev";
while (1) {
    sleep 300;
    my $newrev = update_pugs;
    if ($newrev > $rev || ($have_refresh && -f $refresh_file)) {
        build_pugs;
        $rev = $newrev;
        set_nick "$nick_base\_r$rev";
    }
}