#!/usr/bin/perl
# $OpenBSD: pkg-config,v 1.96 2023/06/08 08:55:27 espie Exp $

# Copyright (c) 2006 Chris Kuethe <ckuethe@openbsd.org>
# Copyright (c) 2011-2020 Jasper Lievisse Adriaanse <jasper@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 v5.36;
use Config;
use Getopt::Long;
use File::Basename;
use File::stat;
use OpenBSD::PkgConfig;

use constant {
	ONLY_I => 1, 
	ONLY_l => 2,
	ONLY_L => 4,
	ONLY_OTHER => 8
};

my @PKGPATH = qw(/usr/lib/pkgconfig
		 /usr/local/lib/pkgconfig
		 /usr/local/share/pkgconfig
		 /usr/X11R6/lib/pkgconfig
		 /usr/X11R6/share/pkgconfig);

if (defined($ENV{PKG_CONFIG_LIBDIR}) && $ENV{PKG_CONFIG_LIBDIR}) {
	@PKGPATH = split(/:/, $ENV{PKG_CONFIG_LIBDIR});
} elsif (defined($ENV{PKG_CONFIG_PATH}) && $ENV{PKG_CONFIG_PATH}) {
	unshift(@PKGPATH, split(/:/, $ENV{PKG_CONFIG_PATH}));
}

my $logfile = '';
if (defined($ENV{PKG_CONFIG_LOG}) && $ENV{PKG_CONFIG_LOG}) {
	$logfile = $ENV{PKG_CONFIG_LOG};
}

my $allow_uninstalled =
	defined $ENV{PKG_CONFIG_DISABLE_UNINSTALLED} ? 0 : 1;
my $found_uninstalled = 0;

my $version = '0.29.2'; # pretend to be this version of pkgconfig

my %configs = ();
setup_self();

my %mode = ();
my $variables = {};

$variables->{pc_top_builddir} = $ENV{PKG_CONFIG_TOP_BUILD_DIR} //
	'$(top_builddir)';

$variables->{pc_sysrootdir} //= $ENV{PKG_CONFIG_SYSROOT_DIR};
# The default '/' is implied.

my @sys_includes = ('/usr/include');
foreach my $path ($ENV{PKG_CONFIG_SYSTEM_INCLUDE_PATH}, $ENV{C_PATH}, $ENV{C_INCLUDE_PATH},
    $ENV{CPLUS_INCLUDE_PATH}) {
	next if !defined($path);
	unshift(@sys_includes, split(/:/, $path));
}

defined $ENV{PKG_CONFIG_DEBUG_SPEW} ? $mode{debug} = 1 : $mode{debug} = 0;

if ($logfile) {
	open my $L, ">>" , $logfile or die;
	say $L beautify_list($0, @ARGV);
	close $L;
}

# combo arg-parsing and dependency resolution loop. Hopefully when the loop
# terminates, we have a full list of packages upon which we depend, and the
# right set of compiler and linker flags to use them.
#
# as each .pc file is loaded, it is stored in %configs, indexed by package
# name. this makes it possible to then pull out flags or do substitutions
# without having to go back and reload the files from disk.

Getopt::Long::Configure('no_ignore_case');
GetOptions(	'debug' 		=> \$mode{debug},
		'help' 			=> \&help, #does not return
		'usage' 		=> \&help, #does not return
		'list-all' 		=> \$mode{list},
		'version' 		=> sub { say $version ; exit(0);} ,
		'errors-to-stdout' 	=> sub { $mode{estdout} = 1},
		'print-errors' 		=> sub { $mode{printerr} = 1},
		'silence-errors' 	=> sub { $mode{printerr} = 0},
		'short-errors' 		=> sub { $mode{printerr} = 0},
		'atleast-pkgconfig-version=s' => \$mode{myminvers},
		'print-provides' 	=> \$mode{printprovides},
		'print-requires' 	=> \$mode{printrequires},
		'print-requires-private' => \$mode{printrequiresprivate},

		'cflags'		=> sub { $mode{cflags} = ONLY_I|ONLY_OTHER},
		'cflags-only-I'		=> sub { $mode{cflags} |= ONLY_I},
		'cflags-only-other'	=> sub { $mode{cflags} |= ONLY_OTHER},
		'libs'			=> sub { $mode{libs} = ONLY_L|ONLY_l|ONLY_OTHER},
		'libs-only-l'		=> sub { $mode{libs} |= ONLY_l},
		'libs-only-L' 		=> sub { $mode{libs} |= ONLY_L},
		'libs-only-other' 	=> sub { $mode{libs} |= ONLY_OTHER},
		'exists' 		=> sub { $mode{exists} = 1} ,
		'validate'		=> sub { $mode{validate} = 1},
		'static' 		=> sub { $mode{static} = 1},
		'uninstalled' 		=> sub { $mode{uninstalled} = 1},
		'atleast-version=s' 	=> \$mode{minversion},
		'exact-version=s' 	=> \$mode{exactversion},
		'max-version=s' 	=> \$mode{maxversion},
		'modversion' 		=> \$mode{modversion},
		'variable=s' 		=> \$mode{variable},
		'define-variable=s' 	=> $variables,
	);

# Unconditionally switch to static mode on static arches as --static
# may not have been passed explicitly, but we don't want to re-order
# and simplify the libs like we do for shared architectures.
{
	my @static_archs = qw();
	my $machine_arch = $Config{'ARCH'};
	if (grep { $_ eq $machine_arch } @static_archs){
		$mode{static} = 1;
	}
}

# Initial value of printerr depends on the options...
if (!defined $mode{printerr}) {
	if (defined $mode{libs}
	    or defined $mode{cflags}
	    or defined $mode{version}
	    or defined $mode{list}
	    or defined $mode{validate}) {
		$mode{printerr} = 1;
	} else {
		$mode{printerr} = 0;
	}
}

say_debug("\n" . beautify_list($0, @ARGV));

my $rc = 0;

# XXX pkg-config is a bit weird
{
my $p = join(' ', @ARGV);
$p =~ s/^\s+//;
@ARGV = split(/\,?\s+/, $p);
}

if ($mode{myminvers}) {
	exit self_version($mode{myminvers});
}

if ($mode{list}) {
	exit do_list();
}

my $cfg_full_list = [];
my $top_config = [];

# When we got here we're supposed to have had at least one
# package as argument.
if (!@ARGV) {
	say_error("No package name(s) specified.");
	exit 1;
}

# Return the next module from @ARGV, if it turns out to be a comma separated
# module list, take the first one and put the rest back to the front.
sub get_next_module()
{
	my $module = shift @ARGV;
	my $m;
	if ($module =~ m/,/) {
	    	my @ms = split(/,/, $module);
		$m = shift @ms;
	    	unshift(@ARGV, @ms) if @ms != 0;
	} else {
		return $module;
	}

	return $m;
}

while (@ARGV) {
	my $p = get_next_module();
	my $op = undef;
	my $v = undef;
	if (@ARGV >= 2  && $ARGV[0] =~ /^[<=>!]+$/ &&
	    $ARGV[1] =~ /^[\d\.]+[\w\.]*$/) {
	    	$op = shift @ARGV;
		$v = shift @ARGV;
	}
	# For these modes we just need some meta-information and
	# parsing the requirements is not needed.
	if (!($mode{modversion} || $mode{printprovides})) {
		handle_config($p, $op, $v, $cfg_full_list);
	}
	push(@$top_config, $p);
}

if ($mode{exists} || $mode{validate}) {
	exit $rc;
}

if ($mode{uninstalled}) {
	$rc = 1 unless $found_uninstalled;
	exit $rc;
}

if ($mode{modversion} || $mode{printprovides}) {
	for my $pkg (@$top_config) {
		do_modversion($pkg);
	}
}

if ($mode{printrequires} || $mode{printrequiresprivate}) {
	for my $pkg (@$top_config) {
		print_requires($pkg);
	}
}

if ($mode{minversion}) {
	my $v = $mode{minversion};
	for my $pkg (@$top_config) {
		$rc = 1 unless versionmatch($configs{$pkg}, '>=', $v);
	}
	exit $rc;
}

if ($mode{exactversion}) {
	my $v = $mode{exactversion};
	for my $pkg (@$top_config) {
		$rc = 1 unless versionmatch($configs{$pkg}, '=', $v);
	}
	exit $rc;
}

if ($mode{maxversion}) {
	my $v = $mode{maxversion};
	for my $pkg (@$top_config) {
		$rc = 1 unless versionmatch($configs{$pkg}, '<=', $v);
	}
	exit $rc;
}

my @vlist = ();

if ($mode{variable}) {
	for my $pkg (@$top_config) {
		do_variable($pkg, $mode{variable});
	}
}

my $dep_cfg_list = $cfg_full_list;

if ($mode{static}){
	$dep_cfg_list = [reverse(@$cfg_full_list)];
} else {
	$dep_cfg_list = simplify_and_reverse($cfg_full_list);
}

if ($mode{cflags} || $mode{libs} || $mode{variable}) {
	push @vlist, do_cflags($dep_cfg_list) if $mode{cflags};
	push @vlist, do_libs($dep_cfg_list) if $mode{libs};
	say join(' ', @vlist) if $rc == 0;
}

exit $rc;

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

sub handle_config($p, $op, $v, $list)
{
	my $cfg = cache_find_config($p);

	unshift @$list, $p if defined $cfg;

	if (!defined $cfg) {
		$rc = 1;
		return undef;
	}

	if (defined $op) {
		if (!versionmatch($cfg, $op, $v)) {
			mismatch($p, $cfg, $op, $v) if $mode{printerr};
			$rc = 1;
			return undef;
		}
	}

	my $get_props = sub($property) {
	    my $pkg;

	    # See if there's anything in the environment that we need to
	    # take into account.
	    ($pkg = $p) =~ s/(^.*\/)?(.*?)\.pc$/$2/g;
	    $pkg = uc($pkg);

	    if (grep {/PKG_CONFIG_${pkg}.*/} keys %ENV) {
		    # Now that we know we have something to look for, do
		    # the inefficient iteration.
		    while (my ($k, $v) = each %ENV) {
			    if ($k =~ /^PKG_CONFIG_${pkg}_(\w+)/) {
				    $variables->{lc($1)} = $v;
			    }
		    }
	    }

	    my $deps = $cfg->get_property($property, $variables);
	    return unless defined $deps;
	    for my $dep (@$deps) {
		    if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+\w*\d+)$/) {
			    handle_config($1, $2, $3, $list);
		    } else {
			    handle_config($dep, undef, undef, $list);
		    }
	    }
	    say_debug("package $p " . lc($property) . " " . join(',', @$deps));
	};

	if (defined $mode{cflags}
	    or ($mode{static} && $mode{libs})
	    or $mode{printrequiresprivate}
    	    or $mode{exists}) {
		&$get_props("Requires.private");
	}

	unless (defined $mode{validate}) {
		&$get_props("Requires");
	}
}

# look for the .pc file in each of the PKGPATH elements. Return the path or
# undef if it's not there
sub pathresolve($p)
{
	if ($allow_uninstalled && $p !~ m/\-uninstalled$/) {
		for my $d (@PKGPATH) {
			my $f = "$d/$p-uninstalled.pc";
			say_debug("pathresolve($p) looking in $f");
			if (-f $f) {
				$found_uninstalled = 1;
				return $f;
			}
		}
	}

	for my $d (@PKGPATH) {
		my $f = "$d/$p.pc";
		say_debug("pathresolve($p) looking in $f");
		return $f if -f $f;
	}
	return undef;
}

sub get_config($f)
{
	my $cfg;
	eval {
		$cfg = OpenBSD::PkgConfig->read_file($f);
	};
	if (!$@) {
		return validate_config($f, $cfg);
	} else {
		say_debug($@);
	}
	return undef;
}

sub cache_find_config($name)
{
	say_debug("processing $name");

	if (exists $configs{$name}) {
		return $configs{$name};
	} else {
	    	return $configs{$name} = find_config($name);
	}
}

# Required elements for a valid .pc file: Name, Description, Version
sub validate_config($f, $cfg)
{
	my @required_elems = ('Name', 'Description', 'Version');

	# Check if we're dealing with an empty file, but don't error out just
	# yet, we'll do that when we realize there's no Name field.
	if (stat($f)->size == 0) {
		say_error("Package file '$f' appears to be empty");
	}

	for my $p (@required_elems) {
		my $e = $cfg->get_property($p, $variables);
		if (!defined $e) {
			$f =~ s/(^.*\/)?(.*?)\.pc$/$2/g;
			say_error("Package '$f' has no $p: field");
			return undef;
		}
	}

	return $cfg;
}

# pkg-config won't install a pkg-config.pc file itself, but it may be
# listed as a dependency in other files. so prime the cache with self.
sub setup_self()
{
	my $pkg_pc = OpenBSD::PkgConfig->new;
	$pkg_pc->add_property('Version', $version);
	$pkg_pc->add_variable('pc_path', join(":", @PKGPATH));
	$pkg_pc->add_property('URL', "http://man.openbsd.org/pkg-config");
	$pkg_pc->add_property('Description', "fetch metadata about installed software packages");
	$configs{'pkg-config'} = $pkg_pc;
}

sub find_config($p)
{
	# Differentiate between getting a full path and just the module name.
	my $f = ($p =~ m/\.pc$/ ? $p : pathresolve($p));

	return get_config($f) if defined($f);

	say_error("Package $p was not found in the pkg-config search path");

	return undef;
}

sub stringize($list, $sep = ',')
{
	if (defined $list) {
		return join($sep, @$list)
	} else {
		return '';
	}
}

#if the variable option is set, pull out the named variable
sub do_variable($p, $v)
{
	my $cfg = cache_find_config($p);

	if (defined $cfg) {
		my $value = $cfg->get_variable($v, $variables);
		if (defined $value) {
			push(@vlist, $value);
		}
		return undef;
	}
	$rc = 1;
}

#if the modversion or print-provides options are set,
#pull out the compiler flags
sub do_modversion($p)
{
	my $cfg = cache_find_config($p);

	if (defined $cfg) {
		my $value = $cfg->get_property('Version', $variables);
		if (defined $value) {
			if (defined($mode{printprovides})){
				say "$p = " , stringize($value);
				return undef;
			} else {
				say stringize($value);
				return undef;
			}
		}
	}
	$rc = 1;
}

#if the cflags option is set, pull out the compiler flags
sub do_cflags($list)
{
	my $cflags = [];

	for my $pkg (@$list) {
		my $l = $configs{$pkg}->get_property('Cflags', $variables);
		PATH: for my $path (@$l) {
			for my $sys_path (@sys_includes) {
				next PATH if $path =~ /\Q${sys_path}\E\/*$/;
			}
			push(@$cflags, $path);
		}
	}
	my $a = OpenBSD::PkgConfig->compress($cflags,
		sub($r) {
			if (($mode{cflags} & ONLY_I) && $r =~ /^-I/ ||
			    ($mode{cflags} & ONLY_OTHER) && $r !~ /^-I/) {
			    return 1;
			} else {
			    return 0;
			}
		});
	if (defined($variables->{pc_sysrootdir})){
		$a =~ s/[\w]?-I/$&$variables->{pc_sysrootdir}/g;
	}

	return $a;
}

#if the lib option is set, pull out the linker flags
sub do_libs($list)
{
	my $libs = [];

	# In static mode, we have to make sure we discover the libs in dependency
	# order, not in search order. Ordering matters for static linking:
	# Start with Libs (first our own, then dependencies), and append
	# Libs.private (same order as for Libs).
	for my $pkg (@$list) {
		my $l = $configs{$pkg}->get_property('Libs', $variables);
		for my $path (@$l) {
			unless ($path =~ /-L\/usr\/lib\/*$/) {
				push(@$libs, $path);
			}
		}
		if ($mode{static}) {
			my $lp = $configs{$pkg}->get_property('Libs.private', $variables);
			for my $path (@$lp) {
				unless ($path =~ /-L\/usr\/lib\/*/) {
			   		push(@$libs, $path);
				}
			}
		}
	}

	# Get the linker path directives (-L) and store it in $a.
	# $b will be the actual libraries.
	my $r = OpenBSD::PkgConfig->compress_list($libs,
	    sub($r) {
		if (($mode{libs} & ONLY_L) && $r =~ /^-L/ ||
		    ($mode{libs} & ONLY_OTHER) && $r !~ /^-[lL]/) {
		    return 1;
		} else {
		    return 0;
		}
	    });

	if (defined($variables->{pc_sysrootdir})){
		for my $i (@$r) {
			$i =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/;
		}
	}

	if ($mode{libs} & ONLY_l) {
		push(@$r, OpenBSD::PkgConfig->rcompress($libs,
		    sub($l) { $l =~ m/^-l/; }));
	}
	return @$r;
}

#list all packages
sub do_list()
{
	my ($p, $x, $y, @files, $fname, $name);

	my $error = 0;

	for my $p (@PKGPATH) {
		push(@files, <$p/*.pc>);
	}

	# Scan the lengths of the package names so I can make a format
	# string to line the list up just like the real pkgconfig does.
	$x = 0;
	for my $f (@files) {
		$fname = basename($f, '.pc');
		$y = length $fname;
		$x = (($y > $x) ? $y : $x);
	}
	$x *= -1;

	for my $f (@files) {
		my $cfg = get_config($f);
		if (!defined $cfg) {
			say_warning("Problem reading file $f");
			$error = 1;
			next;
		}
		$fname = basename($f, '.pc');
		printf("%${x}s %s - %s\n", $fname,
		    stringize($cfg->get_property('Name', $variables), ' '),
		    stringize($cfg->get_property('Description', $variables),
		    ' '));
	}
	return $error;
}

sub help(@)
{
	print <<EOF
Usage: $0 [options]
--debug	- turn on debugging output
--help - this message
--usage - this message
--list-all - show all packages that $0 can find
--version - print version of pkgconfig
--errors-to-stdout - direct error messages to stdout rather than stderr
--print-errors - print error messages in case of error
--print-provides - print all the modules the given package provides
--print-requires - print all the modules the given package requires
--print-requires-private - print all the private modules the given package requires
--silence-errors - don\'t print error messages in case of error
--atleast-pkgconfig-version [version] - require a certain version of pkgconfig
--cflags package [versionspec] [package [versionspec]]
--cflags-only-I - only output -Iincludepath flags
--cflags-only-other - only output flags that are not -I
--define-variable=NAME=VALUE - define variables
--libs package [versionspec] [package [versionspec]]
--libs-only-l - only output -llib flags
--libs-only-L - only output -Llibpath flags
--libs-only-other - only output flags that are not -l or -L
--exists package [versionspec] [package [versionspec]]
--validate package
--uninstalled - allow for uninstalled versions to be used
--static - adjust output for static linking
--atleast-version [version] - require a certain version of a package
--exact-version [version] - require exactly the specified version of a package
--max-version [version] - require at most a certain version of a package
--modversion [package] - query the version of a package
--variable var package - return the definition of <var> in <package>
EOF
;
	exit 0;
}

# do we meet/beat the version the caller requested?
sub self_version($v)
{
	my (@a, @b);

	@a = split(/\./, $v);
	@b = split(/\./, $version);

	if (($b[0] >= $a[0]) && ($b[1] >= $a[1])) {
		return 0;
	} else {
		return 1;
	}
}

sub parse_suffix($s)
{
	my @l = ();
	my $full = $s;
	# is there a valid non-numeric suffix to deal with later?
	# accepted are (in order): a(lpha) < b(eta) < rc < ' '.
	# suffix[0] is the 'alpha' part, suffix[1] is the '1' part in 'alpha1'.
	if ($s =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
		@l = ($1, $2);
	}
	# also deal with -stable extension
	elsif ($s =~ s/(\-stable)$//) {
		@l = ($1);
	}
	# The above are standard suffixes; deal with single alphabetical
	# suffixes too, e.g. 1.0.1h
	elsif ($s =~ s/([a-zA-Z]){1}$//) {
	    @l = ($1);
	}

	if (@l) {
		say_debug("valid suffix @l found in $full.");
	} 

	return ($s, @l);
}

sub compare($full_a, $full_b)
{
	return 0 if $full_a eq $full_b;

	my ($a, @suffix_a) = parse_suffix($full_a);
	my ($b, @suffix_b) = parse_suffix($full_b);

	my @a = split(/\./, $a);
	my @b = split(/\./, $b);

	while (@a && @b) { #so long as both lists have something
		if (!(@suffix_a || @suffix_b)) {
			# simple comparison when no suffixes are in the game.
			my $rc = compare_numeric($a[0], $b[0], 0);
			return $rc if defined($rc);
		} else {
			# extended comparison.
			if (((@a == 1) || (@b == 1)) &&
			    ($a[0] == $b[0])){
				# one of the arrays has reached the last element,
				# compare the suffix.

				# directly compare suffixes, provided both suffixes
				# are present.
				if (@suffix_a && @suffix_b) {
					my $first_char = sub($s) {
						return substr($s, 0, 1);
					};

					# suffixes are equal, compare on numeric
					if (&$first_char($suffix_a[0]) eq
					    &$first_char($suffix_b[0])) {
					    	return compare_numeric($suffix_a[1], $suffix_b[1], 1);
					}

					# rc beats beta beats alpha
					if (&$first_char($suffix_a[0]) lt &$first_char($suffix_b[0])) {
						say_debug("$full_a (installed) < $full_b (wanted)");
						return -1;
					} else {
						say_debug("$full_a (installed) > $full_b (wanted)");
						return 1;
					}

				} else {
					# one of either is lacking a suffix,
					# thereby beating the other.
					# e.g.: 1.02 > 1.02b1
					if (@suffix_a) { # a is older
						say_debug("$full_a (installed) < $full_b (wanted)");
						return 1;
					}

					if (@suffix_b) { # b is older
						say_debug("$full_a (installed) > $full_b (wanted)");
						return -1;
					}
				}
			} else {
				my $rc = compare_numeric($a[0], $b[0], 0);
				return $rc if defined($rc);
			}
		}
		shift @a; shift @b;
	}
	return 1 if @a;
	return -1 if @b;
	return 0;
}

# simple numeric comparison, with optional equality test.
sub compare_numeric($x, $y, $eq)
{
	return  1 if $x > $y;
	return -1 if $x < $y;
	return  0 if (($x == $y) and ($eq == 1));
	return undef;
}

# got a package meeting the requested specific version?
sub versionmatch($cfg, $op, $want)
{
	# can't possibly match if we can't find the file
	return 0 if !defined $cfg;

	my $inst = stringize($cfg->get_property('Version', $variables));

	# can't possibly match if we can't find the version string
	return 0 if $inst eq '';

	say_debug("comparing $want (wanted) to $inst (installed)");
	my $value = compare($inst, $want);
	if    ($op eq '>=') { return $value >= 0; }
	elsif ($op eq '=')  { return $value == 0; }
	elsif ($op eq '!=') { return $value != 0; }
	elsif ($op eq '<')  { return $value < 0; }
	elsif ($op eq '>')  { return $value > 0; }
	elsif ($op eq '<=') { return $value <= 0; }
}

sub mismatch($p, $cfg, $op, $v)
{
	my $name = stringize($cfg->get_property('Name'), ' ');
	my $version = stringize($cfg->get_property('Version'));
	my $url = stringize($cfg->get_property('URL'));

	say_warning("Requested '$p $op $v' but version of $name is $version");
	say_warning("You may find new versions of $name at $url") if $url;
}

sub simplify_and_reverse($reqlist)
{
	my $dejavu = {};
	my $result = [];

	for my $item (@$reqlist) {
		if (!$dejavu->{$item}) {
			unshift @$result, $item;
			$dejavu->{$item} = 1;
		}
	}
	return $result;
}

# retrieve and print Requires(.private)
sub print_requires($p)
{
	my $cfg = cache_find_config($p);

	if (defined($cfg)) {
		my $value;

		if (defined($mode{printrequires})) {
			$value = $cfg->get_property('Requires', $variables);
		} elsif (defined($mode{printrequiresprivate})) {
			$value = $cfg->get_property('Requires.private', $variables);
		} else {
			say_debug("Unknown mode for print_requires.");
			return 1;
		}

		if (defined($value)) {
			say $_ for @$value;
			return undef;
		}
	}

	$rc = 1;
}

sub beautify_list(@p)
{
	return join(' ', map {"[$_]"} @p);
}

sub say_debug($msg)
{
	say_msg($msg) if $mode{debug};
}

sub say_error($msg)
{
	say_msg($msg) if $mode{printerr}
}

sub say_warning($msg)
{
	say_msg($msg);
}

sub say_msg($str)
{
	# If --errors-to-stdout was given, close STDERR (to be safe),
	# then dup the output to STDOUT and delete the key from %mode so we
	# won't keep checking it. STDERR stays dup'ed.
	if ($mode{estdout}) {
		close(STDERR);
		open(STDERR, ">&STDOUT") or die "Can't dup STDOUT: $!";
		delete($mode{estdout});
	}

	say STDERR $str;
}