#! /usr/bin/perl

# ex:ts=8 sw=4:
# $OpenBSD: dpb,v 1.11 2010/12/29 12:28:23 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");
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 OpenBSD::State;
use DPB::Heuristics;
use DPB::Locks;
use DPB::Logger;
use DPB::Job;
use DPB::Grabber;

use OpenBSD::Paths;
my $make = $ENV{MAKE} || OpenBSD::Paths->make;

our ($opt_t, $opt_d, $opt_e, $opt_T, $opt_c, $opt_h, $opt_A, $opt_j, $opt_a,
    $opt_q, $opt_r, $opt_R, $opt_s, $opt_u, $opt_U,
    $opt_L, $opt_m, $opt_f, $opt_x);
my @subdirlist;

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

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

sub parse_build_file
{
	my ($fname, @consumers) = @_;
	open my $fh, '<', $fname or die "Couldn't open build file $fname\n";
	my $_;
	while (<$fh>) {
		chomp;
		my ($pkgpath, $host, $time, $sz, @rest) = parse_build_line($_);
		next if (!defined $sz) || $sz =~ m/!$/;
		my $o = DPB::PkgPath->new_hidden($pkgpath);
		for my $c (@consumers) {
			$c->add_build_info($o, $host, $time, $sz);
		}
	}
}

my @build_files = ();
my $heuristics = DPB::Heuristics->new;
my $ui = OpenBSD::State->new('dpb3');
$ui->{opt} = {
	P => sub {
	    my $file = shift;
	    open my $fh, '<', $file or die "Can't open $file\n";
	    my $_;
	    while (<$fh>) {
		    chomp;
		    next if m/^\#/;
		    unshift @ARGV, $_;
	    }
	},
	b => sub {
	    push(@build_files, shift);
	},
	S => sub {
	    parse_size_file(shift, $heuristics);
	}
    };
$ui->handle_options('aceqrRsuUh:xA:f:j:m:P:b:d:L:S:t:T:', 
    "[-acerRsuUx] [-A arch] [-j N] [-P plist] [-h hosts] [-L logdir]",
    "[-b log] [-t ctimeout] [-T dtimeout] [-m threshold] [path ...]");

if ($opt_r) {
	$heuristics->random;
}
if ($opt_m) {
	$heuristics->set_threshold($opt_m);
}

my $dpb = $opt_f ? "fetch" : "normal";

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

my ($ports, $repo, $localarch, $distdir) = DPB::Vars->get($make,
    "PORTSDIR", "PACKAGE_REPOSITORY", "MACHINE_ARCH", "DISTDIR");

my $arch = $opt_A // $localarch;
my $logdir = $opt_L // $ENV{LOGDIR} // "$ports/logs/$arch";
my $lockdir = "$logdir/locks";

my $logger = DPB::Logger->new($logdir, $opt_c);
$heuristics->set_logger($logger);

if (defined $opt_j && $localarch ne $arch) {
	$ui->usage("Can't use -j if -A arch is not local architecture");
}

if (defined $opt_j && $opt_j !~ m/^\d+$/) {
	$ui->usage("-j takes a numerical argument");
}

my $fullrepo = "$repo/$arch/all";
if ($opt_h) {
	DPB::Core->parse_hosts_file($opt_h, $arch, $opt_t, $logger, $heuristics);
}

my $prop = {};
if ($opt_j) {
	$prop->{jobs} = $opt_j;
}

if ($opt_j || !$opt_h) {
	DPB::Core::Factory->new('localhost', $prop);
}

if (@build_files > 0) {
	for my $file (@build_files) {
	    parse_build_file($file, $heuristics, "DPB::Job::Port");
	}
	$heuristics->finished_parsing;
}

DPB::Core::Factory->init_cores($logger);

my $builder = DPB::PortBuilder->new(
    $opt_c, $opt_s, $opt_u, $opt_U, $opt_R, $fullrepo, $logger, $ports, $make,
    $heuristics);

my $locker = DPB::Locks->new($lockdir);
my $engine = DPB::Engine->new($builder, $heuristics, $logger, $locker);
my $reporter = DPB::Reporter->new($opt_x, $heuristics, "DPB::Core", $engine);
while (!DPB::Core->avail) {
	DPB::Core->reap;
	sleep 1;
}
my $core = DPB::Core->get;
#my $dump = DPB::Util->make_hot($logger->open('dump'));

my $keep_going = 1;
$opt_T //= 10;
my $last_time = time() - $opt_T;

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

my $grabber = DPB::Grabber->new($ports, $make, $logger, $engine, $dpb,
	sub { handle_non_waiting_jobs(1) });

if ($opt_a) {
	# when restarting interrupted dpb,
	# find the most important paths first
	my $list = $engine->find_best($logger->logfile("dependencies"), 10);
	# if we have them, list them before the full ports tree walk.
	if (@$list > 0) {
		$grabber->grab_subdirs($core, $list);
	}
}

if (@subdirlist > 0) {
	$grabber->grab_subdirs($core, \@subdirlist);
}

$grabber->complete_subdirs($core);

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


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

if (!$opt_e) {
	$core->mark_ready;
}
# and let's wait for all jobs now.

if ($opt_a) {
	$engine->dump_dependencies;
}
#$engine->dump($dump);
$engine->check_buildable;
#$engine->dump($dump);

DPB::Core->start_clock($opt_T);
while (1) {
	while (1) {
		handle_non_waiting_jobs(0);
		if (!DPB::Core->running && 
		    (!$keep_going || !$engine->can_build)) {
			$engine->check_buildable;
			if (!$engine->can_build) {
				last;
			}
		}
		if (DPB::Core->running) {
			DPB::Core->reap_wait;
		}
	}
	if (!$opt_q || !$engine->recheck_errors) {
		last;
	}
}

$reporter->reset;
DPB::Core->cleanup;
print $engine->report;
$engine->dump_category('tobuild', $logger->open('dump'));
