autoupdate/autoupdate.pl

#! /usr/bin/perl -w
# $Id: autoupdate.pl,v 1.36 2014/09/07 07:35:06 markus Exp $
# Copyright (c) 2007,2008,2009
#    Markus Hennecke <markus-hennecke@markus-hennecke.de>
#
# Permission to use, copy, modify, and/or 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;
use Cwd;
use File::Temp qw/tempfile tempdir/;
use List::Util qw/reduce/;
use OpenBSD::PackageName;
use Getopt::Long;
use FindBin;
use File::Spec;
use POSIX qw/uname :sys_wait_h/;

# Silence the warning that is issued because List::Util won't register
# $a and $b in a correct way for us
$a = $a;
$b = $b;

# Defaults to 1, can be set via the --verbose switch
my $verbose = 1;

# If set logs of the build are written under this directory
my $logdir = undef;

# If set it will show the usage information and exit afterwards
my $show_help = 0;

# If set to more than one it will try to build ports in parallel
my $num_jobs = 1;

# If set to 1 the make clean part of the ports build will use sudo
my $sudo_make_clean = 0;
my $sudo = $ENV{SUDO};
$sudo = `make -f /etc/mk.conf -V SUDO` if (not defined $sudo);
$sudo = '' if (not defined $sudo);
chomp $sudo;

# If defined via command line the script will use that file as input for
# out of date ports. If the filename is '-' it will use stdin.
my $out_of_date = undef;

# The default location of the ports tree and the path where we should look
# for ports. TODO: Read these variables from /etc/mk.conf and fall back
# to the default only if we do not find it either there or in the environment.
my $portsdir = $ENV{PORTSDIR} || '/usr/ports';
my $portsdir_path = $ENV{PORTSDIR_PATH} || "$portsdir:$portsdir/mystuff";

# Number of jobs currently active
my $jobs = 0;

# Number of concurrent jobs in a build
my $make_jobs = 1;

# This hash will hold the PIDs of the forked build processes
my %forked_builds = ();

# Regex used to match a flavor
my $regex_flavor = '((,[a-z][a-z0-9_]*)*)';
# Regex used to match a subpackage
my $regex_subpkg = '(,-[a-z][a-z0-9_+-]*)?';

# List of pseudo flavors we apply if the port supports them
my %pseudo_flavors = ();

# Global abort flag, only set from the reaper func
my $abort = 0;

# Ports that failed to build
my @aborted = ();

# Hash of reaped child processes
my %reaped_pids = ();


# This function will remove the finished forked build from the list of
# currently build ports.
sub REAPER {
	while ((my $wpid = waitpid(-1, &WNOHANG)) > 0) {
		my $status = $?;

		$abort = 1 if ($status != 0);
		$reaped_pids{$wpid} = $status;
	}
	$SIG{CHLD} = \&REAPER;
}


# Remove the status codes/PIDs from the reaped_pids hash periodically
sub reap {
	my @pids = keys %reaped_pids;
	while (scalar @pids) {
		my $wpid = shift @pids;
		if (exists $forked_builds{$wpid}) {
			my $portname = $forked_builds{$wpid};
			$jobs--;
			my $status = $reaped_pids{$wpid};
			if ($status == 0) {
				print STDOUT 'Finished build of ';
			}
			else {
				print STDOUT 'Build aborted of ';
				push @aborted, ($portname);
			}
			delete $forked_builds{$wpid};
			print STDOUT $portname . "\n";
		}
		else {
			print STDOUT 'No forked process recorded for '
			  . $wpid . "\n";
		}
		delete $reaped_pids{$wpid};
	}
}


# Reads a config file and parses the options set in the config file.
# A list of valid options must be passed to the function. 
sub read_rc_file {
	my $valid_vars = shift;
	my ($fh, @lines, %config);
	open($fh, '<', "$ENV{HOME}/.autoupdaterc")
	    or return \%config;

	while (<$fh>) {
		chomp;
		s/\t/ /g;
		push @lines, ($_);
	}
	close($fh);

	my $temp_line = '';
	my $append = 0;
	my $real_lineno = 0;
	my $lineno = 0;
	foreach (@lines) {
		$lineno++;

		# Check if we have a multiline statement
		if (m/\\$/) {
			$append++;
			s/\\$//g;
			$temp_line .= $_;
			next;
		}
		elsif ($append != 0) {
			$_ = $temp_line . $_;
			$real_lineno = $lineno - $append;
			$append = 0;
			$temp_line = '';
		}

		# Remove comments and unnecessary whitespace
		s/\#.*$//g;
		s/^[[:space:]]//g;
		s/ *= */=/g;
		s/ +/ /g;
		next if (m/^$/);

		# Check if the line has a = character, if not issue an error
		if (! m/=/) {
			print STDERR 'Not a valid config in line ' 
			    . $real_lineno . "\n";
			return undef;
		}

		# Split the line at the first '='
		my $split_index = index($_, '=');
		my $var = substr($_, 0, $split_index);
		my $val = substr($_, $split_index + 1);

		# Check if the varible is valid
		if (defined $valid_vars && defined $valid_vars->{$var}) {
			$config{$var} = $val;
		}
		else {
			print STDERR 'Warning: Unknown variable "' . $var
			    . '" in config file' . "\n";
		}
	}
	return \%config;
}


# Fill a lookup hash from config
sub setup_lookup_hash {
	my $config_line = shift;
	my $hash = shift;
	my $info = shift;

	if (defined $config_line) {
		$config_line =~ tr/,/ /;
		foreach (split / /, $config_line) {
			print STDOUT "Adding $_ to $info\n"
			    unless ($verbose < 2);
			$hash->{$_} = 1;
		}
	}
}


# Sets up the log directory
sub setup_logging {
	my $config = shift;

	if (defined $config->{logging} && $config->{logging} == 1) {
		my $tmpdir = $ENV{TMPDIR} ? $ENV{TMPDIR} : '/tmp';
		$logdir = tempdir("$tmpdir/autoupdate.XXXXXXXXXX");

		my $logfile = "$logdir/autoupdate.pl.log";
		open TEE, "| tee $logfile"
		    or die "Unable to open log file \"$logfile\"\n";
		open STDOUT, ">&TEE"
		    or die "Unable to redirect STDOUT to log file.\n";
		open STDERR, ">&TEE"
		    or die "Unable to redirect STDERR to log file.\n";

		print STDOUT 'Logging builds in "' . $logdir . '"' . "\n";
		print STDOUT 'Using "' . $logfile . '" as mainlog' . "\n";
	}
}


# Returns the ports version or undef if no such version could be deduced
sub get_ports_version {
	my $port = shift;

	chdir "$port" || return undef;
	my $cmd = 'make show=FULLPKGNAME';
	my $pkgname = '';

	open(my $in, "$cmd 2>&1 |") 
	    or die "Unable to get version for \"$port\"\n";
	while (<$in>) {
		chomp;
		$pkgname .= $_;
	}
	close($in);

	my ($stem, $version, @flavors) 
	    = OpenBSD::PackageName::splitname($pkgname);
	return $version;
}


# Returns an integer according to the version numbers supplied.
# -1 if the first argument is the higher version number
#  0 if both version numbers are equal
# +1 if the second argument is the higher version number
sub get_higher_version {
	my ($ver1, $ver2) = @_;

	if (! defined($ver1)) {
		return 0 if (! defined($ver2));
		return 1;
	}
	elsif (! defined($ver2)) {
		return -1;
	}

	my @vers1 = split /[\.pv]/,$ver1;
	my @vers2 = split /[\.pv]/,$ver2;

	my $max_len = scalar @vers1;
	$max_len = scalar @vers2 if (scalar @vers2 > scalar @vers1);

	my $index;
	for ($index = 0; $index < $max_len; $index++) {
		return -1 if ($index >= scalar @vers2);
		return 1 if ($index >= scalar @vers1);
		my $vers1 = $vers1[$index];
		my $vers2 = $vers2[$index];
		my $cmp;
		if (($vers1 =~ /[a-z]/) || ($vers2 =~ /[a-z]/)) {
			$cmp = ($vers2 cmp $vers1); 
		}
		else {
			$cmp = ($vers2 <=> $vers1);
		}
		return $cmp if ($cmp);
	}
	return 0;
}


# Creates an array with the name of all packages that need updates
sub read_update_package_list {
	my $input = shift;
	my ($in, @package_list, $out);

	# Save the output from out-of-date in a log file
	if (defined $logdir && not defined $input) {
		open($out, '>', "$logdir/out-of-date");
		print STDERR "Warning: Unable to open log for out-of-date\n"
		    if (not defined $out);
	}

	if (not defined $input) {
		my $ood_path = 'infrastructure/';
		my @uname = POSIX::uname();
		if ($uname[2] >= 5.1) {
			$ood_path .= 'bin';
		}
		else {
			$ood_path .= 'build';
		}
		my $cmd = "env PORTSDIR=\"$portsdir\" "
		    . "\"$portsdir/$ood_path/out-of-date\" ";
		unless (open($in, $cmd . '2>/dev/null |')) {
			print STDERR "Unable to execute $cmd\n";
			exit 1;
		}
	}
	elsif ($input eq '-') {
		unless (open($in, '<&=STDIN')) {
			print STDERR "Unable to open stdin\n";
			exit 1;
		}
	}
	else {
		unless (open($in, '<', $input)) {
			print STDERR "Unable to open file: " . $input 
			    . " for reading\n";
			exit 1;
		}
	}

	while (<$in>) {
		print $out $_ if (defined $out);
		chomp;
		my $pkg = $_;
		$pkg =~ s/ +#.*$//g;
		if ($_ =~ m/#\s+->/) {
			# Ignore ports that show up every time in out-of-date
			print STDERR 'Ignoring ' . $pkg . "\n";
			next;
		}
		push @package_list, ($pkg);
	}
	close($in);
	close($out) if (defined $out);

	return \@package_list;
}


# Creates an array with a hash for each port that needs an update
sub create_package_information {
	my $pkg_list = shift;

	# Create an array of hashes that has the following data:
	# category	=> name of the ports category
	# port		=> name of the port (the directory in the ports tree)
	# subdir	=> version of the port (for ports with more than one
	#					version, e.q. python)
	# flavor	=> list of flavors as an array reference
	# subpackage	=> name of the subpackage
	my @pkg_information = ();
	foreach my $pkg (@$pkg_list) {
		# Get all the variables from the port identification string
		my ($category, $port, $subdir, $flavor, $subpackage);

		# Each group in the regex has the following meaning:
		# $1 :  category main which may consist of the alphabet
		# $2 :  port name, which must start with at least one alpha
		#	char and may have a number appended.
		#	Some examples may be gtk+2, libIDL etc.
		# $3 :	optional subdirs for the port, $4 will hold the last 
		# $5 :  an optional subpackage name, this will start with a
		#	comma followed by an hyphen and have an alphanumeric
		#	identifier
		# $6 :	a list with optional flavors. Each flavor starts with
		#	a comma and may be an alphanumeric identifier
		if ($pkg =~ m/^
				([a-z][a-z0-9]*)\/
				([A-Za-z][\.A-Za-z0-9-+_]*)
				((\/[a-z0-9._-]*)*)?
				$regex_subpkg
				$regex_flavor/x) {
			$category = $1;
			$port = $2;
			$subdir = $3;
			$subpackage = $5;
			$flavor = $6;
			$subdir = '' if (not defined $subdir);
			$subdir =~ s/(^\/|\/$)//g;
			$subpackage = '' if (not defined $subpackage);
			$subpackage =~ s/^,//g;
			$flavor = '' if (not defined $flavor);

			$flavor =~ s/,/ /g;
			$flavor =~ s/^ //g;

			my %p = (
				category => $category,
				port     => $port,
				subdir   => $subdir,
				subpkg	 => $subpackage,
				flavor	 => $flavor,
				pkg	 => $pkg,
			);
			$p{dependencies} = create_dependencies_list(\%p);
			$p{jobs} = set_parallel_build(\%p);
			$p{deppkgs} 
				= create_dependencies_hash($p{dependencies});
			$p{pseudo_flavors} = create_pseudo_flavors_list(\%p);
			add_pseudo_flavors(\%p);
			push @pkg_information, (\%p);
		}
		else {
			next if ((not defined $pkg) || ($pkg eq ''));
			print STDERR "Unknown port name: $pkg\n";
			exit 2;
		}
		print STDOUT "Category:\t$category\n" 
		    . "Port:\t\t$port\n"
		    . "Subdir:\t\t$subdir\n"
		    . "Subpackage:\t$subpackage\n"
		    . "Flavor:\t\t$flavor\n\n" unless ($verbose < 5);
	}

	return \@pkg_information;
}


# Adds pseudo flavors to the flavors list if they appear both in the 
# pseudo_flavors array from the ports info hash and the %pseudo_flavors
# global hash set via command line.
sub add_pseudo_flavors {
	my $info = shift;

	my $flavors = $info->{flavor};

	foreach my $pseudo_flavor (@{$info->{pseudo_flavors}}) {
		if (exists $pseudo_flavors{$pseudo_flavor}) {
			$flavors .= ' ';
			$flavors .= $pseudo_flavor;
		}
	}
	$info->{flavor} = $flavors;
}


# Creates an array with pseudo flavors. We can check this array against the
# %pseudo_flavors hash to add flavors on demand.
sub create_pseudo_flavors_list {
	my $info = shift;
	my $cur_dir = getcwd;

	my $cmd = 'make show=PSEUDO_FLAVORS';

	# chdir into the ports directory
	my ($port, $port_dir) = find_newer_ports_dir($info);
	chdir $port_dir or die "Unable to change to \"$port_dir\"";

	open (my $in, "$cmd |")
	    or die "Unable to get pseudo flavors for \"$port\"";

	my $output;
	while (<$in>) {
		chomp;
		$output .= $_ . ' ';
	}
	chop $output;
	close($in);
	if ($? != 0) {
		die "Unable to get pseudo flavors for \"$port\"";
	}

	my @pseudo_flavors = split / /,$output;
	return \@pseudo_flavors;
}


# Returns the reference of the package information belonging to a package
# name from the package info array. The sub will die if there is no such
# package listed.
# A package listed more than one time, e.g. several subpackages, will
# always return the first subpackage. It is taken care of the update of the
# other subpackages via the ports Makefile, so we should only need this first
# one.
sub get_pkg_info {
	my ($info_array, $pkg_name) = @_;

	foreach my $info (@$info_array) {
		my $info_pkg_name = $info->{pkg};
		$info_pkg_name =~ s/$regex_subpkg$regex_flavor//g;
		return $info if ($info_pkg_name eq $pkg_name);
	}
	die "ERROR: Internal error, package information not consistent.\n"; 
}


# Tries to find the newest port from directories listed in $PORTSDIR_PATH
# by comparing the output from make show=FULLPKGNAME.
sub find_newer_ports_dir {
	my $info = shift;

	my $port = $info->{category} . '/' . $info->{port};
	$port .= '/' . $info->{subdir} if ($info->{subdir} ne '');

	return ($port, $info->{portdir})
	    if ((defined $info->{portdir}) && ($info->{portdir} ne ''));

	my @port_locations = split /:/,$portsdir_path;
	# Take a shortcut here if we got only one location
	if (scalar @port_locations == 1) {
		$info->{portdir} = "$portsdir_path/$port";
		return ($port, $info->{portdir});
	}
	   
	my @versions = ();
	foreach my $dir (@port_locations) {
		my $port_dir = "$dir/$port";
		my $version = get_ports_version($port_dir);
		push @versions, $version;
	}

	my $highest
	    = reduce { get_higher_version($a, $b) <= 0 ? $a : $b } @versions;
	my $idx = 0;
	$idx = grep 
		{ defined($versions[$_]) 
		    && ($versions[$_] eq $highest) ? $_ : -1 } 0..$#versions
	    if (scalar @versions > 1);
	$info->{portdir} = "$port_locations[$idx - 1]/$port";
	return ($port, $info->{portdir});
}


# (Re)builds a package and updates it.
# The following targets for make are given: repackage, update, clean
# All output from the build process is logged and printed if the package did
# not build.
sub build_pkg {
	my $info = shift;
	my $cur_dir = getcwd();
	my ($port, $port_dir) = find_newer_ports_dir($info);

	my $pid = fork();
	if (! defined $pid) {
		die "Cannot fork to build $port\n";
	}
	elsif ($pid) {
		$forked_builds{$pid} = $port;
		$jobs++;
		return;
	}

	# The child must use the default sig handler for SIGCHLD
	$SIG{CHLD} = 'DEFAULT';

	# Give the parent time to update the forked_builds hash
	sleep 1;

	# Create the command that will build the package
	my $cmd = 'env ';
	$cmd .= 'MAKE_JOBS=' . $info->{jobs} . ' ';
	$cmd .= "FLAVOR=\"$info->{flavor}\" " if ($info->{flavor} ne '');
	$cmd .= "SUBPACKAGE=$info->{subpkg} " if ($info->{subpkg} ne '');
	$cmd .= 'make repackage';

	# chdir into the ports directory
	chdir $port_dir or die "Unable to change to \"$port_dir\"\n";

	print STDOUT "Building $info->{pkg}\n";
	my (@log, $logfile, $logfilename);
	open(my $in, "$cmd 2>&1 |") 
	    or die "Unable to make \"$port\"\n";
	if (defined $logdir) {
		my $tmp = $info->{port};
		$tmp .= "_$info->{subdir}" if ($info->{subdir} ne '');
		$tmp =~ s/\//_/g;
		$logfilename = "$logdir/$tmp.log";
		open($logfile, '>>', $logfilename)
		    or print STDERR 'Warning: Unable to create log file'
			. " for $info->{pkg}\n";
	}
	while (<$in>) {
		exit 1 if (/^Detected loop/);

		print STDOUT $_ unless (($verbose < 2) || ($num_jobs > 1));
		print $logfile $_ if (defined $logfile);
		push @log, ($_);
	}
	close($in);
	my $build_result = $?;
	my $update_result = 1;
	if ($build_result == 0) {
		$cmd = 'env FORCE_UPDATE=Yes CLEANDEPENDS=No ';
		$cmd .= "FLAVOR=\"$info->{flavor}\" "
		    if ($info->{flavor} ne '');
		$cmd .= "SUBPACKAGE=$info->{subpkg} "
		    if ($info->{subpkg} ne '');
		$cmd .= $sudo if ($sudo_make_clean);
		$cmd .= ' make update clean';
		open($in, "$cmd 2>&1 |") 
		    or die "Unable to update \"$port\"\n";
		while (<$in>) {
			print STDOUT $_ 
			    unless (($verbose < 2) || ($num_jobs > 1));
			print $logfile $_ if (defined $logfile);
			push @log, ($_);
		}
		close($in);
		$update_result = $?;
	}
	close($logfile) if (defined $logfile);
	if ($build_result != 0 || $update_result != 0) {
		# Something went wrong. We list the output of the make process
		# and kill the update process
		if (!defined $logdir) {
			foreach my $line (@log) {
				print STDOUT $line;
			}
		}
		else {
			print STDERR "Failed: See log in '$logfilename'\n";
		}
		print STDERR "Aborting build process...\n";
		exit 3;
	}

	chdir $cur_dir;
	exit 0;
}


sub set_parallel_build {
	my $info = shift;

	my $cur_dir = getcwd;
	my $cmd = 'make show=PARALLEL_BUILD';
	my ($port, $port_dir) = find_newer_ports_dir($info);
	chdir $port_dir or die "Unable to change to '$port_dir'\n";

	my $parallel = 1;
	open(my $in, "$cmd |")
	    or die "Unable to determine parallel build info for \"$port\"\n";
	while (<$in>) {
		chomp;
		$parallel &= ($_ eq 'Yes');
	}
	close($in);
	chdir $cur_dir;

	$info->{jobs} = ($parallel) ? $make_jobs : 1;
	return $info->{jobs};
}


# Creates the dependencies list for a given port from the port information
# hash
sub create_dependencies_list {
	my $info = shift;

	my $cur_dir = getcwd;
	my @dep_list = ();

	# Create the command that will give us the dependencies list
	my $cmd = 'env ';
	$cmd .= "FLAVOR=\"$info->{flavor}\" " if ($info->{flavor} ne '');
	$cmd .= "SUBPACKAGE=$info->{subpkg} " if ($info->{subpkg} ne '');
	$cmd .= 'make build-dir-depends';

	# chdir into the ports directory
	my ($port, $port_dir) = find_newer_ports_dir($info);
	chdir $port_dir or die "Unable to change to \"$port_dir\"\n";

	open(my $in, "$cmd |") 
	    or die "Unable to get dependencies for \"$port\"\n";
	while (<$in>) {
		chomp;
		push @dep_list, ($_);
	}
	close($in);
	if ($? != 0) {
		die "Unable to gather information for " . $port;
	}

	# Add the port itself to the list
	$port = "$info->{category}/$info->{port}";
	$port .= "/$info->{subdir}" if ($info->{subdir} ne '');
	$port .= ",$info->{subpkg}" if ($info->{subpkg} ne '');
	# Add the flavors in raw form
	if ($info->{flavor} ne '') {
		$port .= ',';
		my $flavs = $info->{flavor};
		$flavs =~ s/ /,/g;
		$port .= $flavs;
	}
	#push @dep_list, ("$port $port");
	chdir $cur_dir;

	return \@dep_list;
}


# Creates a single hash with all dependant packages from the array created
# via create_dependencies_list
sub create_dependencies_hash {
	my $dep_list = shift;
	my %dep_hash;

	foreach my $pkg (@$dep_list) {
		my $key = $pkg;
		$key =~ s/^.* //g;
		$key =~ s/$regex_subpkg$regex_flavor//g;
		$dep_hash{$key} = 1;
	}
	return \%dep_hash;
}


# Returns true if a package with a given name is in the package list array
# The function will ignore flavors and subpackages.
sub is_pkg_in_list {
	my ($pkg_name, $pkgs) = @_;

	foreach my $p (@$pkgs) {
		$p =~ s/$regex_subpkg$regex_flavor//g;
		return 1 if ($p eq $pkg_name);
	}
	return 0;
}


# Returns 1 if one of the dependencies from the arguments pkg info is currently
# build by a child
sub can_pkg_be_build {
	my $pkg = shift;

	my $pkgs = $pkg->{deppkgs};

	my @pkg_list = keys %$pkgs;
	foreach my $pid (keys %forked_builds) {
		my $build_pkg = $forked_builds{$pid};
		return 1 if (is_pkg_in_list($build_pkg, \@pkg_list));
	}

	return 0;
}


# Prints out the usage information on STDERR
sub usage {
	print STDERR "USAGE: autoupdate.pl [options]\n";
	print STDERR "OPTIONS:\n"
	    . " -v|--verbose\t\tSet verbosity level (1..5)\n"
	    . " -f|--outofdate\t\tUse file as output from the out-of-date script\n"
	    . " -j|--jobs\t\tTry to build packages in parallel\n"
	    . " \t\t\tIf the filename is '-' the input will be\n"
	    . " \t\t\tread from stdin\n"
	    . " -h|--help\t\tShow this help\n";
	exit (1);
}

##############################################################################

$SIG{CHLD} = 'DEFAULT';

# Read the command line params
my $result = GetOptions("v|verbose=i" => \$verbose,
			"f|outofdate=s" => \$out_of_date,
			"j|jobs=i" => \$num_jobs,
			"h|help" => \$show_help);

usage() if ($show_help != 0 || ! $result || $num_jobs < 1);

$out_of_date = File::Spec->rel2abs($out_of_date) if (defined($out_of_date));

my $basedir = $FindBin::Bin;
chdir($basedir);

# Fill the hash with the allowed variables
my %valid_vars = ( 'logging', 1,
		   'make_jobs', 1,
		   'sudo_make_clean', 1,
		   'pseudo_flavors', 1 );

# Read the config and set everything up
my $config = read_rc_file(\%valid_vars);
setup_logging($config);
$make_jobs = $config->{make_jobs} if $config->{make_jobs};
setup_lookup_hash($config->{pseudo_flavors}, \%pseudo_flavors,
		  'pseudo flavors');
$sudo_make_clean = $config->{sudo_make_clean}
    if (defined $config->{sudo_make_clean});

print STDOUT "Reading package list scheduled for update...\n";
my $package_list = read_update_package_list($out_of_date);
print STDOUT "Got " . @$package_list . " packages for update\n";

print STDOUT "Gathering package information...\n";
my $port_info = create_package_information($package_list);

print STDOUT "Merging dependencies...\n";
my @dep_list = ();
my @package_dep_list = ();
# Get the dep list of each port
foreach my $info (@$port_info) {
	my $deps = $info->{dependencies};
	push @dep_list, @$deps
}

print STDOUT "Create dependencies...\n";
my ($fh, $file, $pipe);
($fh, $file) = tempfile(UNLINK => 1);
open($pipe, "| tsort -r >$file") or die "ERROR: Unable to spawn tsort\n";
foreach my $dep_entry (@dep_list) {
	# Zap the flavors and the subpackages for our dep list
	$dep_entry =~ s/$regex_subpkg$regex_flavor//g;
	print $dep_entry . "\n" unless ($verbose < 5);
	print $pipe $dep_entry . "\n";
}
close $pipe;
die "ERROR: Internal error" if ($? != 0);

# Read the result
while (<$fh>) {
	my $pkg = $_;
	chomp $pkg;
	push @package_dep_list, ($pkg);
}
close $fh;

print STDOUT "Got " . @package_dep_list . " packages as dependencies\n"
    unless ($verbose < 1);

print STDOUT "Removing unneeded packages...\n";
# Remove all packages from @package_dep_list that are not in the @package_list
# array, so that only those packages may be build that are in need.
my @pkg_list = ();
foreach my $pkg_name (@package_dep_list) {
	if (is_pkg_in_list($pkg_name, $package_list) == 1) {
		push @pkg_list, ($pkg_name);
	}
}
if ($verbose > 1) {
	print STDOUT "Got " . @pkg_list . " packages for building:\n";
	foreach my $pkg_name (@pkg_list) {
		print STDOUT $pkg_name . "\n";
	}
}

$SIG{CHLD} = \&REAPER;

# Build all the packages. Packages that are still unknown to us are ignored.
foreach my $pkg_name (@pkg_list)  {

	reap();

	# Get the package information from the info array
	my $info = get_pkg_info($port_info, $pkg_name);

	if (not defined $info) {
		print STDERR "Unable to retrieve package information for "
		    . $pkg_name . "\n";
		next;
	}

	my $wait_for_dep_notice = 0;

	# XXX Here we must check if the package depends on a currently build
	# package too.
	while (($jobs >= $num_jobs || can_pkg_be_build($info)) && !$abort) {
		if ($wait_for_dep_notice == 0 && !can_pkg_be_build($info)) {
			print STDOUT "Waiting for dependant package to finish "
			    . "building (" . $pkg_name . ")\n" 
				unless ($verbose < 2);
			$wait_for_dep_notice++;
		}
		reap();
		sleep 1;
	}

	last if ($abort != 0);
	build_pkg($info);
}

# Wait for all childs to finish
while (scalar (keys %forked_builds)) {
	sleep 1;
	reap();
}

$SIG{CHLD} = 'DEFAULT';

# Close the pipe to our log file if we were logging
if (defined $config->{logging} && $config->{logging} != 0) {
	close STDOUT;
	close STDERR;
	close TEE;
}

die 'Abort requested by child' if ($abort != 0);
print STDOUT "Done.\n";

exit 0;