#! /usr/bin/perl

# ex:ts=8 sw=4:
# $OpenBSD: dpb,v 1.40 2012/01/09 17:56:28 espie Exp $
#
# Copyright (c) 2010 Marc Espie <espie@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;
my $ports1;
use FindBin;
BEGIN {
	$ports1 = $ENV{PORTSDIR} || '/usr/ports';
}
use lib ("$ports1/infrastructure/lib", "$FindBin::Bin/../lib");


package DPB::State;
our @ISA = qw(OpenBSD::State);

use OpenBSD::State;
use OpenBSD::Paths;
use DPB::Heuristics;
use DPB::PkgPath;
use DPB::Logger;


sub init
{
	my $self = shift;
	$self->SUPER::init;
	$self->{no_exports} = 1;
	$self->{heuristics} = DPB::Heuristics->new($self);
	$self->{make} = $ENV{MAKE} || OpenBSD::Paths->make;
	($self->{ports}, $self->{repo}, $self->{localarch}, $self->{distdir}) =
	    DPB::Vars->get($self->make, 
	    "PORTSDIR", "PACKAGE_REPOSITORY", "MACHINE_ARCH", "DISTDIR");
	$self->{arch} = $self->{localarch};

	return $self;
}

sub handle_options
{
	my $state = shift;
	$state->{dontclean} = {};
	$state->{opt} = {
		a => sub {
			$state->{all} = 1;
		},
		A => sub {
			$state->{arch} = shift;
		},
		L => sub {
			$state->{logdir} = shift;
		},
		r => sub {
			$state->{random} = 1;
			$state->heuristics->random;
		},
		m => sub {
			$state->heuristics->set_threshold(shift)
		},
		P => sub {
			my $file = shift;
			open my $fh, '<', $file or die "Can't open $file\n";
			my $_;
			while (<$fh>) {
				chomp;
				next if m/^\#/;
				push @main::ARGV, $_;
			}
		},
		I => sub {
			my $file = shift;
			open my $fh, '<', $file or die "Can't open $file\n";
			my $_;
			while (<$fh>) {
				chomp;
				next if m/^\#/;
				push @main::ARGV, $_;
				s/\^=.*//;
				my $p = DPB::PkgPath->new($_);
				$p->{wantinstall} = 1;
			}
		},
		C => sub {
			my $file = shift;
			open my $fh, '<', $file or die "Can't open $file\n";
			my $_;
			while (<$fh>) {
				chomp;
				next if m/^\#/;
				s/\,.*//;
				$state->{dontclean}{$_} = 1;
			}
		},
		b => sub {
			push(@{$state->{build_files}}, shift);
		},
		S => sub {
			$state->parse_size_file(shift, $state->heuristics);
		},
	};

	$state->SUPER::handle_options('aceqrRstuUvh:xA:C:f:F:I:j:J:m:P:b:L:S:',
    "[-acerRsuUvx] [-A arch] [-C plist] [-f N] [-F N] [-I plist] [-J p] [-j N]",
    "[-P plist] [-h hosts] [-L logdir] [-b log] [-t ctimeout] [-m threshold]",
    "[path ...]");
    	$state->{fullrepo} = join("/", $state->{repo}, $state->arch, "all");
	$state->{logdir} //= $ENV{LOGDIR} // 
	    join("/", $state->ports, "logs", $state->arch);
	if (defined $state->{opt}{F}) {
		if (defined $state->{opt}{j} || defined $state->{opt}{f}) {
			$state->usage("Can't use -F with -f or -j");
		}
		$state->{fetch_only} = 1;
		$state->{opt}{f} = $state->{opt}{F};
		$state->{opt}{j} = 1;
		$state->{opt}{e} = 1;
	}
	$state->{opt}{f} //= 2;
	if (defined $state->opt('j')) {
		if ($state->localarch ne $state->arch) {
			$state->usage(
		    "Can't use -j if -A arch is not local architecture");
		}
		if ($state->opt('j') !~ m/^\d+$/) {
			$state->usage("-j takes a numerical argument");
		}
	}
	if ($state->opt('f') !~ m/^\d+$/) {
		$state->usage("-f takes a numerical argument");
	}
	$state->{logger} = DPB::Logger->new($state->logdir, $state->opt('c'));
	$state->heuristics->set_logger($state->logger);
	$state->{display_timeout} = 
	    $state->{subst}->value('DISPLAY_TIMEOUT') // $state->opt('T') // 10;
    	$state->{connection_timeout} =
	    $state->{subst}->value('CONNECTION_TIMEOUT') // $state->opt('t');
	$state->{stuck_timeout} = $state->{subst}->value('STUCK_TIMEOUT');
}

sub start_cores
{
	my $state = shift;

	if ($state->opt('h')) {
		DPB::Core->parse_hosts_file($state->opt('h'), $state);
	}

	my $prop = {};
	if ($state->opt('j')) {
		$prop->{jobs} = $state->opt('j');
	}
	if ($state->{stuck_timeout}) {
		$prop->{stuck} = $state->{stuck_timeout};
	}

	if ($state->opt('j') || !$state->opt('h')) {
		DPB::Core::Factory->new('localhost', $prop);
	}
	DPB::Core::Factory->init_cores($state);
}

sub logger
{
	return shift->{logger};
}

sub heuristics
{
	return shift->{heuristics};
}

sub locker
{
	return shift->{locker};
}

sub builder
{
	return shift->{builder};
}

sub engine
{
	return shift->{engine};
}

sub grabber
{
	return shift->{grabber};
}

sub make
{
	return shift->{make};
}

sub make_args
{
	my $self = shift;
	my @l = ($self->{make});
	if ($self->{all}) {
		push(@l, 'BUILD_ONCE=Yes');
	}
	return @l;
}

sub ports
{
	return shift->{ports};
}

sub fullrepo
{
	return shift->{fullrepo};
}

sub distdir
{
	return shift->{distdir};
}

sub localarch
{
	return shift->{localarch};
}

sub arch
{
	return shift->{arch};
}

sub logdir
{
	return shift->{logdir};
}

sub parse_build_line
{
	return split(/\s+/, shift);
}

sub parse_build_file
{
	my ($state, $fname, @consumers) = @_;
	if (!-f $fname) {
		my $arch = $state->arch;
		if (-f "$fname/$arch/build.log") {
			$fname = "$fname/$arch/build.log";
		} elsif (-f "$fname/build.log") {
			$fname = "$fname/build.log";
		}
	}
	open my $fh, '<', $fname or 
	    $state->fatal("Couldn't open build file #1: #2", $fname, $!);
	my $_;
	while (<$fh>) {
		chomp;
		next if $_ =~ m/!$/;
		my ($pkgpath, $host, $time, $sz, @rest) = parse_build_line($_);
		next if !defined $sz;
		my $o = DPB::PkgPath->new($pkgpath);
		for my $c (@consumers) {
			$c->add_build_info($o, $host, $time, $sz);
		}
	}
}

sub handle_build_files
{
	my $state = shift;
	return unless defined $state->{build_files};
	for my $file (@{$state->{build_files}}) {
		$state->parse_build_file($file, $state->heuristics, 
		    "DPB::Job::Port");
	}
	$state->heuristics->finished_parsing;
}

sub parse_size_file
{
	my ($state, $fname, @consumers) = @_;
	open my $fh, '<', $fname or 
	    $state->fatal("Couldn't open build file #1: #2", $fname, $!);
	my $_;
	while (<$fh>) {
		chomp;
		my ($pkgpath, $sz, $sz2) = split(/\s+/, $_);
		if (defined $sz2) {
			$sz += $sz2;
		}
		my $o = DPB::PkgPath->new($pkgpath);
		for my $c (@consumers) {
			$c->add_size_info($o, $sz);
		}
	}
}

package main;


use DPB::PkgPath;
use DPB::Core;
use DPB::Vars;
use DPB::PortInfo;
use DPB::Engine;
use DPB::PortBuilder;
use DPB::Reporter;
use OpenBSD::Error;
use DPB::Locks;
use DPB::Job;
use DPB::Grabber;

my $subdirlist = {};

my $state = DPB::State->new('dpb');
$state->handle_options;
$state->start_cores;

$state->handle_build_files;

if (@ARGV == 0) {
	$state->{all} = 1;
}
for my $arg (@ARGV) {
	$arg =~ s/\/+$//;
	my ($path, $weight) = ($arg, 5000);
	if ($arg =~ m/^(.*)\=(\d+)$/) {
		($path, $weight) = ($1, $2);
	}
	if ($arg =~ m/^\./) {
		$state->usage("Invalid pkgpath: #1",  $arg);
	}
	my $pkgpath = DPB::PkgPath->new($path);
	$state->heuristics->set_weight($pkgpath, $weight);
	$pkgpath->add_to_subdirlist($subdirlist);
}

$state->{builder} = DPB::PortBuilder->new($state);

$state->{locker} = DPB::Locks->new(join("/", $state->logdir, "locks"));
$state->{engine} = DPB::Engine->new($state);
my $reporter = DPB::Reporter->new($state->opt('x'),
    $state->heuristics, "DPB::Core", $state->engine);
while (!DPB::Core->avail) {
	DPB::Core->reap;
	sleep 1;
}
my $core = DPB::Core->get;
#my $dump = DPB::Util->make_hot($state->logger->open('dump'));
$SIG{INFO} = sub {
	$state->engine->info_dump($state->logger->open('info'));
	# perl status may spew some garbage on the display, 
	# remove it during next refresh
	$reporter->refresh;
};

my $keep_going = 1;
my $last_time = time() - $state->{display_timeout};

sub handle_non_waiting_jobs
{
	my $need_clock = shift;
	my $checked = !$need_clock; # XXX
	my $reaped = DPB::Core->reap;
	$keep_going = !-e $state->logdir."/stop";
	if (DPB::Core->avail > 1) {
		$state->engine->recheck_errors;
	}
	if (DPB::Core->avail) {
		$state->engine->check_buildable(0);
		$checked = 1;
	}
	while ($keep_going && DPB::Core->avail && $state->engine->can_build) {
		$state->engine->start_new_job;
	}
	while ($keep_going && DPB::Core::Fetcher->avail && 
	    $state->engine->can_fetch) {
	    	if (!$checked) {
			$state->engine->check_buildable(1);
			$checked = 1;
		}
		$state->engine->start_new_fetch;
	}
	if ($need_clock) {
		my $current = time();
		if ($current >= $last_time + $state->{display_timeout} ||
		    $reaped) {
			$reporter->report;
			$last_time = $current;
		}
	} else {
		$reporter->report;
	}
	return $keep_going;
}

sub main_loop
{
	while (1) {
		while (1) {
			handle_non_waiting_jobs(0);
			if (!DPB::Core->running &&
			    (!$keep_going || !$state->engine->can_build)) {
				$state->engine->check_buildable(0);
				if (!$state->engine->can_build) {
					last;
				}
			}
			if (DPB::Core->running) {
				DPB::Core->reap_wait;
			}
			if ($state->{fetch_only}) {
				if (!DPB::Core::Fetcher->running &&
				    (!$keep_going || !$state->engine->can_fetch)) {
					$state->engine->check_buildable(0);
					if (!$state->engine->can_fetch) {
						last;
					}
				}
			}
		}
		if (!$state->opt('q') || !$state->engine->recheck_errors) {
			last;
		}
	}
}

$state->{grabber} = DPB::Grabber->new($state, 
    sub { handle_non_waiting_jobs(1) });

if ($state->{all} && !$state->{random}) {
	# when restarting interrupted dpb,
	# find the most important paths first
	my $list = $state->engine->find_best($state->logger->logfile("dependencies"), 10);
	# if we have them, list them before the full ports tree walk.
	if (@$list > 0) {
		my $actual = {};
		for my $name (@$list) {
			DPB::PkgPath->new($name)->add_to_subdirlist($actual);
		}
		$state->grabber->grab_subdirs($core, $actual);
	}
}

if (keys %$subdirlist > 0) {
	$state->grabber->grab_subdirs($core, $subdirlist);
}

$state->grabber->complete_subdirs($core);

if ($state->{all}) {
	$state->grabber->grab_subdirs($core);
}


$state->grabber->complete_subdirs($core);
# give back "our" core to the pool.

my $occupied = 0;

if ($state->{all}) {
	$state->engine->dump_dependencies;
	if ($state->opt('f')) {
		DPB::Distfile->dump($state->{logger});
	}
	if ($state->grabber->expire_old_distfiles($core, $state->opt('e'))) {
		$occupied  = 1;
	}
}

if (!$state->opt('e') && !$occupied) {
	$core->mark_ready;
}

# and let's wait for all jobs now.
$state->engine->check_buildable(1);

DPB::Core->start_clock($state->{display_timeout});
main_loop();

$reporter->reset;
DPB::Core->cleanup;
print $state->engine->report;
$state->engine->end_dump($state->logger->open('dump'));