/cons-2.2.0/cons

Large files files are truncated, but you can click here to view the full file

#!/usr/bin/env perl

# NOTE:  Cons intentionally does not use the "perl -w" option or
# "use strict."  Because Cons "configuration files" are actually
# Perl scripts, enabling those restrictions here would force them
# on every user's config files, wanted or not.  Would users write
# "better" Construct and Conscript files if we forced "use strict"
# on them?  Probably.  But we want people to use Cons to get work
# done, not force everyone to become a Perl guru to use it, so we
# don't insist.
#
# That said, Cons' code is both "perl -w" and "use strict" clean.
# Regression tests keep the code honest by checking for warnings
# and "use strict" failures.

# $Id: cons.pl,v 1.129 2000/11/16 12:22:37 knight Exp $

use vars qw( $ver_num $ver_rev $version );

$ver_num = "2.2";
$ver_rev = ".0";
$version = sprintf "This is Cons %s%s " .
	    '($Id: cons.pl,v 1.129 2000/11/16 12:22:37 knight Exp $)'. "\n",
	    $ver_num, $ver_rev;

# Cons: A Software Construction Tool.
# Copyright (c) 1996-2000 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

require 5.002;
# See the NOTE above about why Cons doesn't "use strict".
use integer;
use Cwd;
use File::Copy;

use vars qw( $_WIN32 $_a $_exe $_o $_so );

#------------------------------------------------------------------
# Determine if running on win32 platform - either Windows NT or 95
#------------------------------------------------------------------

use vars qw( $PATH_SEPARATOR $iswin32 $_WIN32 $usage $indent @targets );

BEGIN {
    use Config;

    # if the version is 5.003, we can check $^O
    if ($] <  5.003) {
	eval("require Win32");
	$_WIN32 = (!$@);
    } else {
	$_WIN32 = ($^O eq "MSWin32") ? 1 : 0;
    }

    # Fetch the PATH separator from Config;
    # provide our old defaults in case it's not set.
    $PATH_SEPARATOR = $Config{path_sep};
    $PATH_SEPARATOR = $_WIN32 ? ';' : ':' if ! defined $PATH_SEPARATOR;

    # Fetch file suffixes from Config,
    # accomodating differences in the Config variables
    # used by different Perl versions.
    $_exe = $Config{_exe};
    $_exe = $Config{exe_ext} if ! defined $_exe;
    $_exe = $_WIN32 ? '.exe' : '' if ! defined $_exe;
    $_o = $Config{_o};
    $_o = $Config{obj_ext}  if ! defined $_o;
    $_o = $_WIN32 ? '.obj' : '.o' if ! defined $_o;
    $_a = $Config{_a};
    $_a = $Config{lib_ext} if ! defined $_a;
    $_a = $_WIN32 ? '.lib' : '.a' if ! defined $_a;
    $_so = ".$Config{so}";
    $_so = $_WIN32 ? '.dll' : '.so' if ! defined $_so;
}

# Flush stdout each time.
$| = 1;

# Seed random number generator.
srand(time . $$); # this works better than time ^ $$ in perlfunc manpage.

$usage = q(
Usage: cons <arguments> -- <construct-args>

Arguments can be any of the following, in any order:

  <targets>	Build the specified targets. If <target> is a directory
		recursively build everything within that directory.

  +<pattern>	Limit the cons scripts considered to just those that
		match <pattern>. Multiple + arguments are accepted.

  <name>=<val>	Sets <name> to value <val> in the ARG hash passed to the
		top-level Construct file.

  -cc           Show command that would have been executed, when
		retrieving from cache. No indication that the file
		has been retrieved is given; this is useful for
		generating build logs that can be compared with
		real build logs.

  -cd           Disable all caching. Do not retrieve from cache nor
		flush to cache.

  -cr           Build dependencies in random order. This is useful when
		building multiple similar trees with caching enabled.

  -cs           Synchronize existing build targets that are found to be
		up-to-date with cache. This is useful if caching has
		been disabled with -cc or just recently enabled with
		UseCache.

  -d            Enable dependency debugging.

  -f <file>	Use the specified file instead of "Construct" (but first
		change to containing directory of <file>).

  -h            Show a help message local to the current build if
		one such is defined,  and exit.

  -k		Keep going as far as possible after errors.

  -o <file>	Read override file <file>.

  -p		Show construction products in specified trees.
  -pa		Show construction products and associated actions.
  -pw		Show products and where they are defined.

  -q		Be quiet about Installing and Removing targets.

  -r		Remove construction products associated with <targets>

  -R <repos>	Search for files in <repos>.  Multiple -R <repos>
		directories are searched in the order specified.

  -t            Traverse up the directory hierarchy looking for a
		Construct file, if none exists in the current directory.
		(Targets will be modified to be relative to the
		Construct file.)

  -v		Show cons version and continue processing.
  -V            Show cons version and exit.

  -wf <file>    Write all filenames considered into <file>.

  -x		Show this message and exit.


   Please report any suggestions through the cons-discuss@gnu.org mailing
   list.

   To subscribe, send mail to cons-discuss-request@gnu.org with body
   'subscribe'.

   If you find a bug, please report it through the bug-cons@gnu.org
   mailing list.

   Information about CONS can be obtained from the official cons web site
   http://www.dsmit.com/cons/ or its mirrors (listed there).

   The cons maintainers can be contacted by email at cons-maintainers@gnu.org

   User documentation of cons is contained in cons and can be obtained
   by doing 'perldoc /path/to/cons'.

);

# Simplify program name, if it is a path.
{
    my ($vol, $dir, $file) = File::Spec->splitpath(File::Spec->canonpath($0));
    $0 = $file;
}

# Default parameters.
$param::topfile = 'Construct';	# Top-level construction file.
$param::install = 1;		# Show installations
$param::build = 1;		# Build targets
### $param::show = 1;		# Show building of targets.
$param::sigpro = 'md5';		# Signature protocol.
$param::depfile = '';		# Write all deps out to this file
$param::salt = '';		# Salt derived file signatures with this.
$param::rep_sig_times_ok = 1;	# Repository .consign times are in sync
				#   w/files.
$param::conscript_chdir = 0;	# Change dir to Conscript directory
$param::quiet = 0;		# should we show the command being executed.

#
$indent = '';

# Display a command while executing or otherwise. This
# should be called by command builder action methods.
sub showcom {
    print($indent . $_[0] . "\n");
}

# Default environment.
# This contains only the completely platform-independent information
# we can figure out.  Platform-specific information (UNIX, Win32)
# gets added below.
@param::defaults = (
     'SUFEXE'	    => $_exe,				# '' on UNIX systems
     'SUFLIB'	    => $_a,				# '.a' on UNIX systems
     'SUFLIBS'      => "$_so:$_a",			# '.so:.a' on UNIX
     'SUFOBJ'	    => $_o,				# '.o' on UNIX systems
     'SUFMAP'       => {
	 '.c'  => 'build::command::cc',
	 '.s'  => 'build::command::cc',
	 '.S'  => 'build::command::cc',
	 '.C'  => 'build::command::cxx',
	 '.cc' => 'build::command::cxx',
	 '.cxx'=> 'build::command::cxx',
	 '.cpp'=> 'build::command::cxx',
	 '.c++'=> 'build::command::cxx',
	 '.C++'=> 'build::command::cxx',
     },
);

if ($_WIN32) {
    # Defaults for Win32.
    # Defined for VC++ 6.0 by Greg Spencer <greg_spencer@acm.org>.
    # Your mileage may vary.
    my @win = (
	'CC'             => 'cl',
	'CFLAGS'         => '/nologo',
	'CCCOM'          => '%CC %CFLAGS %_IFLAGS /c %< /Fo%>',
	'CXX'            => '%CC',
	'CXXFLAGS'       => '%CFLAGS',
	'CXXCOM'         => '%CXX %CXXFLAGS %_IFLAGS /c %< /Fo%>',
	'INCDIRPREFIX'   => '/I',
	'LINK'           => 'link',
	'LINKCOM'        => '%LINK %LDFLAGS /out:%> %< %_LDIRS %LIBS',
	'LINKMODULECOM'  => '%LD /r /o %> %<',
	'LIBDIRPREFIX'   => '/LIBPATH:',
	'AR'             => 'lib',
	'ARFLAGS'        => '/nologo ',
	'ARCOM'          => "%AR %ARFLAGS /out:%> %<",
	'RANLIB'         => '',
	'LD'             => 'link',
	'LDFLAGS'        => '/nologo ',
	'PREFLIB'        => '',
    );
    push(@param::defaults, @win);
} else {
    # Defaults for a typical (?) UNIX platform.
    # Your mileage may vary.
    my @unix = (
	'CC'             => 'cc',
	'CFLAGS'         => '',
	'CCCOM'          => '%CC %CFLAGS %_IFLAGS -c %< -o %>',
	'CXX'            => '%CC',
	'CXXFLAGS'       => '%CFLAGS',
	'CXXCOM'         => '%CXX %CXXFLAGS %_IFLAGS -c %< -o %>',
	'INCDIRPREFIX'   => '-I',
	'LINK'           => '%CXX',
	'LINKCOM'        => '%LINK %LDFLAGS -o %> %< %_LDIRS %LIBS',
	'LINKMODULECOM'  => '%LD -r -o %> %<',
	'LIBDIRPREFIX'   => '-L',
	'AR'             => 'ar',
	'ARFLAGS'        => 'r', # rs?
	'ARCOM'          => "%AR %ARFLAGS %> %<\n%RANLIB %>",
	'RANLIB'         => 'ranlib',
	'AS'             => 'as',
	'ASFLAGS'        => '',
	'ASCOM'          => '%AS %ASFLAGS %< -o %>',
	'LD'             => 'ld',
	'LDFLAGS'        => '',
	'PREFLIB'        => 'lib',
	'ENV'            => { 'PATH' => '/bin:/usr/bin' },
    );
    push(@param::defaults, @unix);
}

# Handle command line arguments.
while (@ARGV) {
    $_ = shift @ARGV;
    last if /^--$/;		# Argument passing to Construct.
    &option, next			if s/^-//;
    push (@param::include, $_), next	if s/^\+//;
    &equate, next			if /=/;
    push (@targets, $_), next;
}

sub option {
    my %opt = (
		    'cc' =>   sub { $param::cachecom = 1; },
		    'cd' =>   sub { $param::cachedisable = 1; },
		    'cr' =>   sub { $param::random = 1; },
		    'cs' =>   sub { $param::cachesync = 1; },
		    'd' =>    sub { $param::depends = 1; },
		    'h' =>    sub { $param::localhelp = 1; },
		    'k' =>    sub { $param::kflag = 1; },
		    'p' =>    sub { $param::pflag = 1;
				    $param::build = 0; },
		    'pa' =>   sub { $param::pflag = 1;
				    $param::aflag = 1;
				    $indent = "... ";
				    $param::build = 0; },
		    'pw' =>   sub { $param::pflag = 1;
				    $param::wflag = 1;
				    $param::build = 0; },
		    'q' =>    sub { $param::quiet = 1; },
		    'r' =>    sub { $param::rflag = 1;
				    $param::build = 0; },
		    't' =>    sub { $param::traverse = 1; },
		    'v' =>    sub { print($version); },
		    'V' =>    sub { print($version), exit(0); },
		    'x' =>    sub { print($usage), exit 0; },
		);

    my %opt_arg = (
		    'f' =>    sub { $param::topfile = $_[0]; },
		    'o' =>    sub { $param::overfile = $_[0]; },
		    'R' =>    sub { script::Repository($_[0]); },
		    'wf' =>   sub { $param::depfile = $_[0]; },
		);

    if (defined $opt{$_}) {
	&{$opt{$_}}();
	return;
    }
    $_  =~ m/(.)(.*)/;
    if (defined $opt_arg{$1}) {
	if (! $2) {
	    $_ = shift @ARGV;
	    die("$0: -$1 option requires an argument.\n") if ! $_;
	}
	&{$opt_arg{$1}}($2 || $_);
	return;
    }
    $_  =~ m/(..)(.*)/;
    if (defined $opt_arg{$1}) {
	if (! $2) {
	    $_ = shift @ARGV;
	    die("$0: -$1 option requires an argument.\n") if ! $_;
	}
	&{$opt_arg{$1}}($2 || $_);
	return;
    }
    if ($_) {
	die qq($0: unrecognized option "-$_".  Use -x for a usage message.\n);
    }
}

# Process an equate argument (var=val).
sub equate {
    my($var, $val) = /([^=]*)=(.*)/;
    $script::ARG{$var} = $val;
}

# Define file signature protocol.
'sig'->select($param::sigpro);

# Cleanup after an interrupt.
$SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
    $SIG{PIPE} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = 'IGNORE';
    $SIG{HUP} = $SIG{INT} if ! $main::_WIN32;
    warn("\n$0: killed\n");
    # Call this first, to make sure that this processing
    # occurs even if a child process does not die (and we
    # hang on the wait).
    sig::hash::END();
    wait();
    exit(1);
};
$SIG{HUP} = $SIG{INT} if ! $main::_WIN32;

# Cleanup after a broken pipe (someone piped our stdout?)
$SIG{PIPE} = sub {
    $SIG{PIPE} = $SIG{HUP} = $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = 'IGNORE';
    warn("\n$0: broken pipe\n");
    sig::hash::END();
    wait();
    exit(1);
};

if ($param::depfile) {
  open (main::DEPFILE, ">".$param::depfile) ||
    die ("$0: couldn't open $param::depfile ($!)\n");
}

# If the supplied top-level Conscript file is not in the
# current directory, then change to that directory.
{
    my ($vol, $dir, $file) = File::Spec->splitpath(File::Spec->canonpath($param::topfile));
    if ($vol || $dir) {
	my($cd) = File::Spec->catpath($vol, $dir, undef);
	chdir($cd) || die("$0: couldn't change to directory $cd ($!)\n");
	$param::topfile = $file;
    }
}

# Walk up the directory hierarchy looking for a Conscript file (if -t set).
my($target_top);
my(@targetdir) = ();
if ($param::traverse && ! -f $param::topfile) {
    my($vol, $dirs, $file) = File::Spec->splitpath(cwd());
    my(@dirs) = (File::Spec->splitdir($dirs), $file);
    while (! -f File::Spec->catpath($vol, File::Spec->catdir(@dirs), $param::topfile)) {
	die("$0: unable to find $param::topfile.\n") if ! @dirs;
	unshift(@targetdir, pop(@dirs));
    }
    my($cwd) = File::Spec->catpath($vol, File::Spec->catdir(@dirs), '');
    print "$0: Entering directory `$cwd'\n";
    chdir($cwd);
    @targets = map {File::Spec->catdir(@targetdir, $_)} @targets;
}

# Set up $dir::top and $dir::cwd, now that we are in the right directory.
dir::init();

#
if (@targetdir) {
    $target_top = $dir::top->lookupdir(File::Spec->catdir(@targetdir));
}

# Now handle override file.
package override;
if ($param::overfile) {
    my($ov) = $param::overfile;
    die qq($0: can\'t read override file "$ov" ($!)\n) if ! -f $ov; #'
    do $ov;
    if ($@) {
	chop($@);
	die qq($0: errors in override file "$ov" ($@)\n);
    }
}

# Provide this to user to setup override patterns.
sub Override {
    my($re, @env) = @_;
    return if $param::overrides{$re}; # if identical, first will win.
    $param::overrides = 1;
    $param::overrides{$re} = \@env;
    push(@param::overrides, $re);
}

package main;

use vars qw( %priority $errors );

# Check script inclusion regexps
my $re;
for $re (@param::include) {
    if (! defined eval {"" =~ /$re/}) {
	my($err) = $@;
	$err =~ s/in regexp at .*$//;
	die("$0: error in regexp $err");
    }
}

# Read the top-level construct file and its included scripts.
doscripts($param::topfile);

# Status priorities. This lets us aggregate status for directories
# and print an appropriate message (at the top-level).
%priority =
    ('none' => 1, 'handled' => 2, 'built' => 3, 'unknown' => 4, 'errors' => 5);

# If no targets were specified, supply default targets (if any).
@targets = @param::default_targets if ! @targets;

$errors = 0;

# Build the supplied target patterns.
my $tgt;
for $tgt (map($dir::top->lookup($_), @targets)) {
    if ($target_top && ! $tgt->is_under($target_top)) {
	# A -t option was used, and this target is not underneath
	# the directory where we were invoked via -t.
	# If the target is a directory and the -t directory
	# is underneath it, then build the -t directory.
	if (ref $tgt ne "dir" || ! $target_top->is_under($tgt)) {
	    next;
	}
	$tgt = $target_top;
    }
    buildtoptarget($tgt);
}

exit 0 + ($errors != 0);

sub buildtoptarget {
    my($tgt) = @_;
    return if ! $tgt;
    my($status) = buildtarget($tgt);
    if ($status ne 'built') {
	my($path) = $tgt->path;
	if ($status eq "errors") {
	    print qq($0: "$path" not remade because of errors.\n);
	    $errors++;
	} elsif ($status eq "handled") {
	    print qq($0: "$path" is up-to-date.\n);
	} elsif ($status eq "unknown") {
	    # cons error already reported.
	    $errors++;
	} elsif ($status eq "none") {
	    # search for targets that may be linked to the given path.
	    my @linked = dir::linked_targets($tgt) if $target_top;
	    if (@linked) {
		my @names = map($_->path, @linked);
		print "Linked targets: @names\n" unless ($param::quiet);
		map(buildtoptarget($_), @linked);
	    } else {
		print qq($0: nothing to be built in "$path".\n) if $param::build;
	    }
	} else {
	    print qq($0: don\'t know how to construct "$path".\n); #'
	    $errors++;
	}
    }
}

# Build the supplied target directory or files. Return aggregated status.
sub buildtarget {
    my($tgt) = @_;
    if (ref($tgt) eq "dir") {
	my($result) = "none";
	my($priority) = $priority{$result};
	if (exists $tgt->{member}) {
	    my($members) = $tgt->{member};
	    my $entry;
	    for $entry (sort keys %$members) {
		next if $entry eq $dir::CURDIR || $entry eq $dir::UPDIR;
		my($tgt) = $members->{$entry};
		next if ref($tgt) ne "dir" && !exists($tgt->{builder});
		my($stat) = buildtarget($members->{$entry});
		my($pri) = $priority{$stat};
		if ($pri > $priority) {
		    $priority = $pri;
		    $result = $stat;
		}
	    }
	}
	return $result;
    }
    if ($param::depends) {
	my($path) = $tgt->path;
	if ($tgt->{builder}) {
	    my(@dep) = (@{$tgt->{dep}}, @{$tgt->{sources}});
	    my($dep) = join(' ',map($_->path, @dep));
	    print("Target $path: $dep\n");
	} else {
	    print("Target $path: not a derived file\n");
	}
    }
    if ($param::build) {
	return build $tgt;
    } elsif ($param::pflag || $param::wflag || $param::aflag) {
	if ($tgt->{builder}) {
	    if ($param::wflag) {
		print qq(${\$tgt->path}: $tgt->{script}\n);
	    } elsif ($param::pflag) {
		print qq(${\$tgt->path}:\n) if $param::aflag;
		print qq(${\$tgt->path}\n) if !$param::aflag;
	    }
	    if ($param::aflag) {
		$tgt->{builder}->action($tgt);
	    }
	}
    } elsif ($param::rflag && $tgt->{builder}) {
	my($path) = $tgt->path;
	if (-f $path) {
	    if (unlink($path)) {
		print("Removed $path\n") unless ($param::quiet);
	    } else {
		warn("$0: couldn't remove $path\n");
	    }
	}
    }

    return "none";
}

package NameSpace;

# Return a hash that maps the name of symbols in a namespace to an
# array of refs for all types for which the name has a defined value.
# A list of symbols may be specified; default is all symbols in the
# name space.
sub save {
    my $package = shift;
    my(%namerefs, $var, $type);
    no strict 'refs';
    @_ = keys %{$package."::"} if ! @_;
    foreach $var (@_) {
	$namerefs{$var} = [];
	my $fqvar = $package."::".$var;
	# If the scalar for this variable name doesn't already
	# exist, *foo{SCALAR} will autovivify the reference
	# instead of returning undef, so unlike the other types,
	# we have to dereference to find out if it exists.
	push(@{$namerefs{$var}}, *{$fqvar}{SCALAR})
		    if defined ${*{$fqvar}{SCALAR}};
	foreach $type (qw(ARRAY HASH CODE IO)) {
	    push(@{$namerefs{$var}}, *{$fqvar}{$type})
			  if defined *{$fqvar}{$type};
	}
    }
    return \%namerefs;
}

# Remove the specified symbols from the namespace.
# Default is to remove all.
sub remove {
    my $package = shift;
    my(%namerefs, $var);
    no strict 'refs';
    @_ = keys %{$package."::"} if ! @_;
    foreach $var (@_) {
	delete ${$package."::"}{$var};
    }
}

# Restore values to symbols specified in a hash as returned
# by NameSpace::save.
sub restore {
    my($package, $namerefs) = @_;
    my($var, $ref);
    no strict 'refs';
    foreach $var (keys %$namerefs) {
	my $fqvar = $package."::".$var;
	foreach $ref (@{$namerefs->{$var}}) {
	    *{$fqvar} = $ref;
	}
    }
}

# Support for "building" scripts, importing and exporting variables.
# With the exception of the top-level routine here (invoked from the
# main package by cons), these are all invoked by user scripts.
package script;

use vars qw( $ARG $caller_dir_path %special_var );

BEGIN {
    # We can't Export or Import the following variables because Perl always
    # treats them as part of the "main::" package (see perlvar(1)).
    %special_var = map {$_ => 1} qw(ENV INC ARGV ARGVOUT SIG
				    STDIN STDOUT STDERR);
}

# This is called from main to interpret/run the top-level Construct
# file, passed in as the single argument.
sub main::doscripts {
    my($script) = @_;
    Build($script);
    # Now set up the includes/excludes (after the Construct file is read).
    $param::include = join('|', @param::include);

    # Save the original variable names from the script package.
    # These will stay intact, but any other "script::" variables
    # defined in a Conscript file will get saved, deleted,
    # and (when necessary) restored.
    my(%orig_script_var) = map {$_ => 1} keys %script::;
    $caller_dir_path = undef;
    my $cwd = Cwd::cwd();
    my(@scripts) = pop(@priv::scripts);
    while ($priv::self = shift(@scripts)) {
	my($path) = $priv::self->{script}->rsrcpath;
	if (-f $path) {
	    $dir::cwd = $priv::self->{script}->{dir};
	    # Handle chdir to the Conscript file directory, if necessary.
	    my ($vol, $dir, $file);
	    if ($param::conscript_chdir) {
		($vol, $dir, $file) = File::Spec->splitpath(File::Spec->canonpath($path));
		if ($vol ne '' || $dir ne '') {
		    $caller_dir_path = File::Spec->catpath($vol, $dir, undef);
		    chdir($caller_dir_path) ||
			die "Could not chdir to $caller_dir_path: $!\n";
		}
	    } else {
		$file = $path;
	    }
	    # Actually process the Conscript file.
	    do $file;
	    # Save any variables defined by the Conscript file
	    # so we can restore them later, if needed;
	    # then delete them from the script:: namespace.
	    my(@del) = grep(! $orig_script_var{$_}, keys %script::);
	    if (@del) {
		$priv::self->{script}->{pkgvars} =
						NameSpace::save('script', @del);
		NameSpace::remove('script', @del);
	    }
	    if ($caller_dir_path) {
		chdir($cwd);
		$caller_dir_path = undef;
	    }
	    if ($@) {
		chomp($@);
		my $err = ($@ =~ /\n/ms) ? ":\n$@" : " ($@)";
		print qq($0: error in file "$path"$err\n);
		$run::errors++;
	    } else {
		# Only process subsidiary scripts if no errors in parent.
		unshift(@scripts, @priv::scripts);
	    }
	    undef @priv::scripts;
	} else {
	    my $where = '';
	    my $cref = $priv::self->{script}->creator;
	    if (defined $cref) {
		my($_foo, $script, $line, $sub) = @$cref;
		$where = " ($sub in $script, line $line)";
	    }
	    warn qq(Ignoring missing script "$path"$where);
	}
    }
    die("$0: script errors encountered: construction aborted\n")
	if $run::errors;
}

# Return caller info about the method being invoked.
# This is everything from the Perl "caller" builtin function,
# including which Construct/Conscript file, line number,
# subroutine name, etc.
sub caller_info {
    my($lev) = 1;
    my(@frame);
    do {
	@frame = caller ++$lev;
	if (defined($frame[3]) && $frame[3] eq '(eval)') {
	    @frame = caller --$lev;
	    if ($caller_dir_path) {
		$frame[1] = File::Spec->catfile($caller_dir_path, $frame[1]);
	    }
	    return @frame;
	}
    } while ($frame[3]);
    return;
}

# Link a directory to another. This simply means set up the *source*
# for the directory to be the other directory.
sub Link {
    dir::link(@_);
}

# Add directories to the repository search path for files.
# We're careful about stripping our current directory from
# the list, which we do by comparing the `pwd` results from
# the current directory and the specified directory.  This
# is cumbersome, but assures that the paths will be reported
# the same regardless of symbolic links.
sub Repository {
    my($my_dir) = Cwd::cwd();
    my $dir;
    foreach $dir (@_) {
	my($d) = `$^X -e "use Cwd; chdir('$dir') && print cwd"`;
	next if ! $d || ! -d $d || $d eq $my_dir;
	# We know we can get away with passing undef to lookupdir
	# as the directory because $dir is an absolute path.
	push(@param::rpath, dir::lookupdir(undef, $dir));
	push @INC, $d;
    }
}

# Return the list of Repository directories specified.
sub Repository_List {
    map($_->path, @param::rpath);
}

# Specify whether the .consign signature times in repository files are,
# in fact, consistent with the times on the files themselves.
sub Repository_Sig_Times_OK {
    $param::rep_sig_times_ok = shift;
}

# Specify whether we should chdir to the containing directories
# of Conscript files.
sub Conscript_chdir {
    $param::conscript_chdir = shift;
}

# Specify files/targets that must be present and built locally,
# even if they exist already-built in a Repository.
sub Local {
    my(@files) = map($dir::cwd->lookupfile($_), @_);
    map($_->local(1), @files);
}

# Export variables to any scripts invoked from this one.
sub Export {
    my(@illegal) = grep($special_var{$_}, @_);
    if (@illegal) {
	die qq($0: cannot Export special Perl variables: @illegal\n);
    }
    @{$priv::self->{exports}} = grep(! defined $special_var{$_}, @_);
}

# Import variables from the export list of the caller
# of the current script.
sub Import {
    my(@illegal) = grep($special_var{$_}, @_);
    if (@illegal) {
	die qq($0: cannot Import special Perl variables: @illegal\n");
    }
    my($parent) = $priv::self->{parent};
    my($imports) = $priv::self->{imports};
    @{$priv::self->{exports}} = keys %$imports;
    my($var);
    foreach $var (grep(! defined $special_var{$_}, @_)) {
	if (!exists $imports->{$var}) {
	    my($path) = $parent->{script}->path;
	    die qq($0: variable "$var" not exported by file "$path"\n);
	}
	if (!defined $imports->{$var}) {
	    my $path = $parent->{script}->path;
	    my $err = "$0: variable \"$var\" exported but not " .
		      "defined by file \"$path\"\n";
	    die $err;
	}
	${"script::$var"} = $imports->{$var};
    }
}

# Build an inferior script. That is, arrange to read and execute
# the specified script, passing to it any exported variables from
# the current script.
sub Build {
    my(@files) = map($dir::cwd->lookupfile($_), @_);
    my(%imports) = map {$_ => ${"script::$_"}} @{$priv::self->{exports}};
    my $file;
    for $file (@files) {
	next if $param::include && $file->path !~ /$param::include/o;
	my($self) = {'script' => $file,
		     'parent' => $priv::self,
		     'imports' => \%imports};
	bless $self;  # may want to bless into class of parent in future
	push(@priv::scripts, $self);
    }
}

# Set up regexps dependencies to ignore. Should only be called once.
sub Ignore {
    die("Ignore called more than once\n") if $param::ignore;
    $param::ignore = join("|", map("($_)", @_)) if @_;
}

# Specification of default targets.
sub Default {
    push(@param::default_targets, map($dir::cwd->lookup($_)->path, @_));
}

# Local Help.  Should only be called once.
sub Help {
    if ($param::localhelp) {
	print "@_\n";
	exit 2;
    }
}

# Return the build name(s) of a file or file list.
sub FilePath {
    wantarray
	? map($dir::cwd->lookupfile($_)->path, @_)
	: $dir::cwd->lookupfile($_[0])->path;
}

# Return the build name(s) of a directory or directory list.
sub DirPath {
    wantarray
	? map($dir::cwd->lookupdir($_)->path, @_)
	: $dir::cwd->lookupdir($_[0])->path;
}

# Split the search path provided into components. Look each up
# relative to the current directory.
# The usual path separator problems abound; for now we'll use :
sub SplitPath {
    my($dirs) = @_;
    if (ref($dirs) ne "ARRAY") {
	$dirs = [ split(/$main::PATH_SEPARATOR/o, $dirs) ];
    }
    map { DirPath($_) } @$dirs;
}

# Return true if the supplied path is available as a source file
# or is buildable (by rules seen to-date in the build).
sub ConsPath {
    my($path) = @_;
    my($file) = $dir::cwd->lookup($path);
    return $file->accessible;
}

# Return the source path of the supplied path.
sub SourcePath {
    wantarray
	? map($dir::cwd->lookupfile($_)->rsrcpath, @_)
	: $dir::cwd->lookupfile($_[0])->rsrcpath;
}

# Search up the tree for the specified cache directory, starting with
# the current directory. Returns undef if not found, 1 otherwise.
# If the directory is found, then caching is enabled. The directory
# must be readable and writable. If the argument "mixtargets" is provided,
# then targets may be mixed in the cache (two targets may share the same
# cache file--not recommended).
sub UseCache($@) {
    my($dir, @args) = @_;
    # NOTE: it's important to process arguments here regardless of whether
    # the cache is disabled temporarily, since the mixtargets option affects
    # the salt for derived signatures.
    for (@args) {
	if ($_ eq "mixtargets") {
	    # When mixtargets is enabled, we salt the target signatures.
	    # This is done purely to avoid a scenario whereby if
	    # mixtargets is turned on or off after doing builds, and
	    # if cache synchronization with -cs is used, then
	    # cache files may be shared in the cache itself (linked
	    # under more than one name in the cache). This is not bad,
	    # per se, but simply would mean that a cache cleaning algorithm
	    # that looked for a link count of 1 would never find those
	    # particular files; they would always appear to be in use.
	    $param::salt = 'M' . $param::salt;
	    $param::mixtargets = 1;
	} else {
	    die qq($0: UseCache unrecognized option "$_"\n);
	}
    }
    if ($param::cachedisable) {
	warn("Note: caching disabled by -cd flag\n");
	return 1;
    }
    my($depth) = 15;
    while ($depth-- && ! -d $dir) {
	$dir = File::Spec->catdir($dir::UPDIR, $dir);
    }
    if (-d $dir) {
	$param::cache = $dir;
	return 1;
    }
    return undef;
}

# Salt the signature generator. The salt (a number of string) is added
# into the signature of each derived file. Changing the salt will
# force recompilation of all derived files.
sub Salt($) {
    # We append the value, so that UseCache and Salt may be used
    # in either order without changing the signature calculation.
    $param::salt .= $_[0];
}

# Mark files (or directories) to not be removed before building.
sub Precious {
    map($_->{precious} = 1, map($dir::cwd->lookup($_), @_));
}


# These methods are callable from Conscript files, via a cons
# object. Procs beginning with _ are intended for internal use.
package cons;

use vars qw( %envcache );

# This is passed the name of the base environment to instantiate.
# Overrides to the base environment may also be passed in
# as key/value pairs.
sub new {
    my($package) = shift;
    my ($env) = {@param::defaults, @_};
    @{$env->{_envcopy}} = %$env; # Note: we never change PATH
    $env->{_cwd} = $dir::cwd; # Save directory of environment for
    bless $env, $package;	# any deferred name interpretation.
}

# Clone an environment.
# Note that the working directory will be the initial directory
# of the original environment.
sub clone {
    my($env) = shift;
    my $clone = {@{$env->{_envcopy}}, @_};
    @{$clone->{_envcopy}} = %$clone; # Note: we never change PATH
    $clone->{_cwd} = $env->{_cwd};
    bless $clone, ref $env;
}

# Create a flattened hash representing the environment.
# It also contains a copy of the PATH, so that the path
# may be modified if it is converted back to a hash.
sub copy {
    my($env) = shift;
    (@{$env->{_envcopy}}, 'ENV' => {%{$env->{ENV}}}, @_)
}

# Resolve which environment to actually use for a given
# target. This is just used for simple overrides.
sub _resolve {
    return $_[0] if !$param::overrides;
    my($env, $tgt) = @_;
    my($path) = $tgt->path;
    my $re;
    for $re (@param::overrides) {
	next if $path !~ /$re/;
	# Found one. Return a combination of the original environment
	# and the override.
	my($ovr) = $param::overrides{$re};
	return $envcache{$env,$re} if $envcache{$env,$re};
	my($newenv) = {@{$env->{_envcopy}}, @$ovr};
	@{$newenv->{_envcopy}} = %$env;
	$newenv->{_cwd} = $env->{_cwd};
	return $envcache{$env,$re} = bless $newenv, ref $env;
    }
    return $env;
}

# Substitute construction environment variables into a string.
# Internal function/method.
sub _subst {
    my($env, $str) = @_;
    if (! defined $str) {
	return undef;
    } elsif (ref($str) eq "ARRAY") {
	return [ map($env->_subst($_), @$str) ];
    } else {
	# % expansion.  %% gets converted to % later, so expand any
	# %keyword construction that doesn't have a % in front of it,
	# modulo multiple %% pairs in between.
	# In Perl 5.005 and later, we could actually do this in one regex
	# using a conditional expression as follows,
	#	while ($str =~ s/($pre)\%(\{)?([_a-zA-Z]\w*)(?(2)\})/"$1".$env->{$3}/ge) {}
	# The following two-step approach is backwards-compatible
	# to (at least) Perl5.003.
	my $pre = '^|[^\%](?:\%\%)*';
	while (($str =~ s/($pre)\%([_a-zA-Z]\w*)/$1.($env->{$2}||'')/ge) ||
	       ($str =~ s/($pre)\%\{([_a-zA-Z]\w*)\}/$1.($env->{$2}||'')/ge)) {}
	return $str;
    }
}

sub Install {
    my($env) = shift;
    my($tgtdir) = $dir::cwd->lookupdir($env->_subst(shift));
    my $file;
    for $file (map($dir::cwd->lookupfile($env->_subst($_)), @_)) {
	my($tgt) = $tgtdir->lookupfile($file->{entry});
	$tgt->bind(find build::install, $file);
    }
}

sub InstallAs {
    my $env = shift;
    my $tgt = shift;
    my $src = shift;
    my @sources = ();
    my @targets = ();

    if (ref $tgt) {
	die "InstallAs: Source is a file and target is a list!\n"
	    if (!ref($src));
	@sources = @$src;
	@targets = @$tgt;
    } elsif (ref $src) {
	die "InstallAs: Target is a file and source is a list!\n";
    } else {
	push @sources, $src;
	push @targets, $tgt;
    }

    if ($#sources != $#targets) {
	my $tn = $#targets+1;
	my $sn = $#sources+1;
	die "InstallAs: Source file list ($sn) and target file list ($tn) " .
	    "are inconsistent in length!\n";
    } else {
	foreach (0..$#sources) {
	    my $tfile = $dir::cwd->lookupfile($env->_subst($targets[$_]));
	    my $sfile = $dir::cwd->lookupfile($env->_subst($sources[$_]));
	    $tfile->bind(find build::install, $sfile);
	}
    }
}

# Installation in a local build directory,
# copying from the repository if it's already built there.
# Functionally equivalent to:
#	Install $env $dir, $file;
#	Local "$dir/$file";
sub Install_Local {
    my($env) = shift;
    my($tgtdir) = $dir::cwd->lookupdir($env->_subst(shift));
    my $file;
    for $file (map($dir::cwd->lookupfile($env->_subst($_)), @_)) {
	my($tgt) = $tgtdir->lookupfile($file->{entry});
	$tgt->bind(find build::install, $file);
	$tgt->local(1);
    }
}

sub Objects {
    my($env) = shift;
    map($dir::cwd->relpath($_),
	_Objects($env, map($dir::cwd->lookupfile($env->_subst($_)), @_)))
}

# Called with multiple source file references (or object files).
# Returns corresponding object files references.
sub _Objects {
    my($env) = shift;
    my($suffix) = $env->{SUFOBJ};
    map(_Object($env, $_, $_->{dir}->lookupfile($_->base_suf($suffix))), @_);
}

# Called with an object and source reference.  If no object reference
# is supplied, then the object file is determined implicitly from the
# source file's extension. Sets up the appropriate rules for creating
# the object from the source.  Returns the object reference.
sub _Object {
    my($env, $src, $obj) = @_;
    return $obj if $src eq $obj; # don't need to build self from self.
    my($objenv) = $env->_resolve($obj);
    my($suffix) = $src->suffix;

    my($builder) = $env->{SUFMAP}{$suffix};

    if ($builder) {
	$obj->bind((find $builder($objenv)), $src);
    } else {
	die("don't know how to construct ${\$obj->path} from " .
	    "${\$src->path}.\n");
    }
    $obj
}

sub Program {
    my($env) = shift;
    my($tgt) = $dir::cwd->lookupfile(file::addsuffix($env->_subst(shift),
						 $env->{SUFEXE}));
    my($progenv) = $env->_resolve($tgt);
    $tgt->bind(find build::command::link($progenv, $progenv->{LINKCOM}),
	       $env->_Objects(map($dir::cwd->lookupfile($env->_subst($_)), @_)));
}

sub Module {
    my($env) = shift;
    my($tgt) = $dir::cwd->lookupfile($env->_subst(shift));
    my($modenv) = $env->_resolve($tgt);
    my($com) = pop(@_);
    $tgt->bind(find build::command::link($modenv, $com),
	       $env->_Objects(map($dir::cwd->lookupfile($env->_subst($_)), @_)));
}

sub LinkedModule {
    my($env) = shift;
    my($tgt) = $dir::cwd->lookupfile($env->_subst(shift));
    my($progenv) = $env->_resolve($tgt);
    $tgt->bind(find build::command::linkedmodule
	       ($progenv, $progenv->{LINKMODULECOM}),
	       $env->_Objects(map($dir::cwd->lookupfile($env->_subst($_)), @_)));
}

sub Library {
    my($env) = shift;
    my($lib) = $dir::cwd->lookupfile(file::addsuffix($env->_subst(shift),
						 $env->{SUFLIB}));
    my($libenv) = $env->_resolve($lib);
    $lib->bind(find build::command::library($libenv),
	       $env->_Objects(map($dir::cwd->lookupfile($env->_subst($_)), @_)));
}

# Simple derivation: you provide target, source(s), command.
# Special variables substitute into the rule.
# Target may be a reference, in which case it is taken
# to be a multiple target (all targets built at once).
sub Command {
    my($env) = shift;
    my($tgt) = $env->_subst(shift);
    my($com) = pop(@_);
    my(@sources) = map($dir::cwd->lookupfile($env->_subst($_)), @_);
    if (ref($tgt)) {
	# A multi-target command.
	my(@tgts) = map($dir::cwd->lookupfile($_), @$tgt);
	die("empty target list in multi-target command\n") if !@tgts;
	$env = $env->_resolve($tgts[0]);
	my $builder = find build::command::user($env, $com, 'script');
	my($multi) = build::multiple->new($builder, \@tgts);
	for $tgt (@tgts) {
	    $tgt->bind($multi, @sources);
	}
    } else {
	$tgt = $dir::cwd->lookupfile($tgt);
	$env = $env->_resolve($tgt);
	my $builder = find build::command::user($env, $com, 'script');
	$tgt->bind($builder, @sources);
    }
}

sub Depends {
    my($env) = shift;
    my($tgt) = $env->_subst(shift);
    my(@deps) = map($dir::cwd->lookup($env->_subst($_)), @_);
    if (! ref($tgt)) {
	$tgt = [ $tgt ];
    }
    my($t);
    foreach $t (map($dir::cwd->lookupfile($_), @$tgt)) {
	push(@{$t->{dep}}, @deps);
    }
}

# Setup a quick scanner for the specified input file, for the
# associated environment. Any use of the input file will cause the
# scanner to be invoked, once only. The scanner sees just one line at
# a time of the file, and is expected to return a list of
# dependencies.
sub QuickScan {
    my($env, $code, $file, $path) = @_;
    $dir::cwd->lookup($env->_subst($file))->{'srcscan',$env} =
	find scan::quickscan($code, $env, $env->_subst($path));
}

# Generic builder module. Just a few default methods.  Every derivable
# file must have a builder object of some sort attached.  Usually
# builder objects are shared.
package build;

# Null signature for dynamic includes.
sub includes { () }

# Null signature for build script.
sub script { () }

# Not compatible with any other builder, by default.
sub compatible { 0 }


# Builder module for the Install command.
package build::install;

use vars qw( @ISA $installer );

BEGIN {
    @ISA = qw(build);
    bless $installer = {}    # handle for this class.
}

sub find {
    $installer
}

# Caching not supported for Install: generally install is trivial anyway,
# and we don't want to clutter the cache.
sub cachin { undef }
sub cachout { }

# Do the installation.
sub action {
    my($self, $tgt) = @_;
    my($src) = $tgt->{sources}[0];
    main::showcom("Install ${\$src->rpath} as ${\$tgt->path}")
	if ($param::install && !$param::quiet);
    return unless $param::build;
    futil::install($src->rpath, $tgt);
    return 1;
}


# Builder module for generic UNIX commands.
package build::command;

use vars qw( @ISA %com );

BEGIN { @ISA = qw(build) }

sub find {
    my ($class, $env, $com, $package) = @_;
    $com = $env->_subst($com);
    $package ||= '';
    $com{$env,$com,$package} || do {
	# Remove unwanted bits from signature -- those bracketed by %( ... %)
	my $comsig = $com;
	$comsig =~ s/^\@\s*//mg;
	while ($comsig =~ s/%\(([^%]|%[^\(])*?%\)//g) { }
	my $self = { env => $env, com => $com, 'package' => $package,
		     comsig => $comsig };
	$com{$env,$com,$package} = bless $self, $class;
    }
}

# Default cache in function.
sub cachin {
    my($self, $tgt, $sig) = @_;
    if (cache::in($tgt, $sig)) {
	if ($param::cachecom) {
	    map { if (! s/^\@\s*//) { main::showcom($_) } } $self->getcoms($tgt);
	} else {
	    printf("Retrieved %s from cache\n", $tgt->path)
		unless ($param::quiet);
	}
	return 1;
    }
    return undef;
}

# Default cache out function.
sub cachout {
    my($self, $tgt, $sig) = @_;
    cache::out($tgt, $sig);
}

# internal routine to process variable options.
# f: return file part
# F: return file part, but strip any suffix
# d: return directory part
# b: return full path, but strip any suffix (a.k.a. return basename)
# s: return only the suffix (or an empty string, if no suffix is there)
# a: return the absolute path to the file
# no option: return full path to file
sub _variant {
    my($opt, $file) = @_;
    $opt = '' if ! defined $opt;
    if ($opt eq 'f') { return $file->{entry}; }
    elsif ($opt eq 'd') { return $file->{dir}->path; }
    elsif ($opt eq 'F') {
	my $subst = $file->{entry};
	$subst =~ s/\.[^\.]+$//;
	return $subst;
    }
    elsif ($opt eq 'b') {
	my $subst = $file->path;
	$subst =~ s/\.[^\.]+$//;
	return $subst;
    }
    elsif ($opt eq 's') {
	my $subst = $file->{entry};
	$subst =~ m/(\.[^\.]+)$/;
	return $1;
    }
    elsif ($opt eq 'a') {
	my $path = $file->path;
	if (! File::Spec->file_name_is_absolute($path)) {
	    $path = File::Spec->catfile(Cwd::cwd(), $path);
	}
	return $path;
    }
    else { return $file->path; }
}

# For the signature of a basic command, we don't bother
# including the command itself. This is not strictly correct,
# and if we wanted to be rigorous, we might want to insist
# that the command was checked for all the basic commands
# like gcc, etc. For this reason we don't have an includes
# method.

# Call this to get the command line script: an array of
# fully substituted commands.
sub getcoms {
    my($self, $tgt) = @_;
    my(@coms);
    my $com;
    for $com (split(/\n/, $self->{com})) {
	my(@src) = (undef, @{$tgt->{sources}});
	my(@src1) = @src;

	next if $com =~ /^\s*$/;

	# NOTE: we used to have a more elegant s//.../e solution
	# for the items below, but this caused a bus error...

	# Remove %( and %) -- those are only used to bracket parts
	# of the command that we don't depend on.
	$com =~ s/%[()]//g;

	# Deal with %n, n=1,9 and variants.
	while ($com =~ /%([1-9])(:([fdbsFa]?))?/) {
	    my($match) = $&;
	    my($src) = $src1[$1];
	    my($subst) = _variant($3, $src1[$1]->rfile);
	    undef $src[$1];
	    $com =~ s/$match/$subst/;
	}

	# Deal with %0 aka %> and variants.
	while ($com =~ /%[0>](:([fdbsFa]?))?/) {
	    my($match) = $&;
	    my($subst) = _variant($2, $tgt);
	    $com =~ s/$match/$subst/;
	}

	# Deal with %< (all sources except %n's already used)
	while ($com =~ /%<(:([fdbsFa]?))?/) {
	    my($match) = $&;
	    my @list = ();
	    foreach (@src) {
		push(@list, _variant($2, $_->rfile)) if $_;
	    }
	    my($subst) = join(' ', @list);
	    $com =~ s/$match/$subst/;
	}

	# Deal with %[ %].
	$com =~ s{%\[(.*?)%\]}{
	    my($func, @args) = grep { $_ ne '' } split(/\s+/, $1);
	    die("$0: \"$func\" is not defined.\n")
		unless ($self->{env}->{$func});
	    &{$self->{env}->{$func}}(@args);
	}gex;

	# Convert left-over %% into %.
	$com =~ s/%%/%/g;

	# White space cleanup. XXX NO WAY FOR USER TO HAVE QUOTED SPACES
	$com = join(' ', split(' ', $com));
	next if $com =~ /^:/ && $com !~ /^:\S/;
	push(@coms, $com);
    }
    @coms
}

# Build the target using the previously specified commands.
sub action {
    my($self, $tgt) = @_;
    my($env) = $self->{env};

    if ($param::build) {
	futil::mkdir($tgt->{dir});
	unlink($tgt->path) if ! $tgt->precious;
    }

    # Set environment.
    map(delete $ENV{$_}, keys %ENV);
    %ENV = %{$env->{ENV}};

    # Handle multi-line commands.
    my $com;
    for $com ($self->getcoms($tgt)) {
	if ($com !~ s/^\@\s*//) {
	    main::showcom($com);
	}
	if ($param::build) {

	  if ($com =~ /^\[perl\]\s*/) {
	    my $perlcmd = $';
	    my $status;
	    {
	      # Restore the script package variables that were defined
	      # in the Conscript file that defined this [perl] build,
	      # so the code executes with the expected variables.
	      my($package) = $self->{'package'};
	      my($pkgvars) = $tgt->{conscript}->{pkgvars};
	      NameSpace::restore($package, $pkgvars) if $pkgvars;
	      # Actually execute the [perl] command to build the target.
	      $status = eval "package $package; $perlcmd";
	      # Clean up the namespace by deleting the package variables
	      # we just restored.
	      NameSpace::remove($package, keys %$pkgvars) if $pkgvars;
	    }
	    if (!defined($status)) {
		warn "$0: *** Error during perl command eval: $@.\n";
		return undef;
	    } elsif ($status == 0) {
		warn "$0: *** Perl command returned $status (this indicates an error).\n";
		return undef;
	    }
	    next;
	  }
	  #---------------------
	  # Can't fork on Win32
	  #---------------------
	  if ($main::_WIN32) {
	    system($com);
	    if ($?) {
	      my ($b0, $b1) = ($? & 0xFF, $? >> 8);
	      my $err = $b1 || $?;
	      my $path = $tgt->path;
	      my $warn = qq($0: *** [$path] Error $err);
	      $warn .= " (executable not found in path?)" if $b1 == 0xFF;
	      warn "$warn\n";
	      return undef;
	    }
	  } else {
	    my($pid) = fork();
	    die("$0: unable to fork child process ($!)\n") if !defined $pid;
	    if (!$pid) {
	      # This is the child.  We eval the command to suppress -w
	      # warnings about not reaching the statements afterwards.
	      eval 'exec($com)';
	      $com =~ s/\s.*//;
	      die qq($0: failed to execute "$com" ($!). )
		. qq(Is this an executable on path "$ENV{PATH}"?\n);
	    }
	    for (;;) {
	      do {} until wait() == $pid;
	      my ($b0, $b1) = ($? & 0xFF, $? >> 8);
	      # Don't actually see 0177 on stopped process; is this necessary?
	      next if $b0 == 0177; # process stopped; we can wait.
	      if ($b0) {
		my($core, $sig) = ($b0 & 0200, $b0 & 0177);
		my($coremsg) = $core ? "; core dumped" : "";
		$com =~ s/\s.*//;
		my $path = $tgt->path;
		my $err = "$0: *** \[$path\] $com terminated by signal " .
			  "$sig$coremsg\n";
		warn $err;
		return undef;
	      }
	      if ($b1) {
		my($path) = $tgt->path;
		warn qq($0: *** [$path] Error $b1\n); # trying to be like make.
		return undef;
	      }
	      last;
	    }
	  }
	}
    }

    # success.
    return 1;
}

# Return script signature.
sub script {
    $_[0]->{comsig}
}


# Create a linked module.
package build::command::link;

use vars qw( @ISA );

BEGIN { @ISA = qw(build::command) }

# Find an appropriate linker.
sub find {
    my($class, $env, $command) = @_;
    if (!exists $env->{_LDIRS}) {
	my($ldirs) = '';
	my($wd) = $env->{_cwd};
	my($pdirs) = $env->{LIBPATH};
	if (! defined $pdirs) {
	    $pdirs = [ ];
	} elsif (ref($pdirs) ne 'ARRAY') {
	    $pdirs = [ split(/$main::PATH_SEPARATOR/o, $pdirs) ];
	}
	my $dir;
	for $dir (map($wd->lookupdir($env->_subst($_)), @$pdirs)) {
	    my($dpath) = $dir->path;
	    $ldirs .= " ".$env->{LIBDIRPREFIX}.$dpath;
	    next if File::Spec->file_name_is_absolute($dpath);
	    if (@param::rpath) {
		my $d;
		if ($dpath eq $dir::CURDIR) {
		    foreach $d (map($_->path, @param::rpath)) {
			$ldirs .= " ".$env->{LIBDIRPREFIX}.$d;
		    }
		} else {
		    foreach $d (map($_->path, @param::rpath)) {
			$ldirs .= " ".$env->{LIBDIRPREFIX}.File::Spec->catfile($d, $dpath);
		    }
		}
	    }
	}
	$env->{_LDIRS} = "%($ldirs%)";
    }

    # Introduce a new magic _LIBS symbol which allows to use the
    # Unix-style -lNAME syntax for Win32 only. -lNAME will be replaced
    # with %{PREFLIB}NAME%{SUFLIB}. <schwarze@isa.de> 1998-06-18

    if ($main::_WIN32 && !exists $env->{_LIBS}) {
	my $libs;
	my $name;
	for $name (split(' ', $env->_subst($env->{LIBS} || ''))) {
	    if ($name =~ /^-l(.*)/) {
		$name = "$env->{PREFLIB}$1$env->{SUFLIB}";
	    }
	    $libs .= ' ' . $name;
	}
	$env->{_LIBS} = $libs ? "%($libs%)" : '';
    }
    bless find build::command($env, $command);
}

# Called from file::build. Make sure any libraries needed by the
# environment are built, and return the collected signatures
# of the libraries in the path.
sub includes {
    return $_[0]->{sig} if exists $_[0]->{sig};
    my($self, $tgt) = @_;
    my($env) = $self->{env};
    my($ewd) = $env->{_cwd};
    my $ldirs = $env->{LIBPATH};
    if (! defined $ldirs) {
	$ldirs = [ ];
    } elsif (ref($ldirs) ne 'ARRAY') {
	$ldirs = [ split(/$main::PATH_SEPARATOR/o, $ldirs) ];
    }
    my @lpath = map($ewd->lookupdir($_), @$ldirs);
    my(@sigs);
    my(@names);

    if ($main::_WIN32) {
	# Pass %LIBS symbol through %-substituition
	# <schwarze@isa.de> 1998-06-18
	@names = split(' ', $env->_subst($env->{LIBS} || ''));
    } else {
	@names = split(' ', $env->{LIBS} || '');
    }
    my $name;
    for $name (@names) {
	my ($lpath, @allnames);
	if ($name =~ /^-l(.*)/) {
	    # -l style names are looked up on LIBPATH, using all
	    # possible lib suffixes in the same search order the
	    # linker uses (according to SUFLIBS).
	    # Recognize new PREFLIB symbol, which should be 'lib' on
	    # Unix, and empty on Win32. TODO: What about shared
	    # library suffixes?  <schwarze@isa.de> 1998-05-13
	   @allnames = map("$env->{PREFLIB}$1$_",
			   split(/:/, $env->{SUFLIBS}));
	    $lpath = \@lpath;
	} else {
	    @allnames = ($name);
	    # On Win32, all library names are looked up in LIBPATH
	    # <schwarze@isa.de> 1998-05-13
	    if ($main::_WIN32) {
		$lpath = [$dir::top, @lpath];
	    }
	    else {
		$lpath = [$dir::top];
	    }
	}
	my $dir;
	DIR: for $dir (@$lpath) {
	    my $n;
	    for $n (@allnames) {
		my($lib) = $dir->lookup_accessible($n);
		if ($lib) {
		    last DIR if $lib->ignore;
		    if ((build $lib) eq 'errors') {
			$tgt->{status} = 'errors';
			return undef;
		    }
		    push(@sigs, 'sig'->signature($lib));
		    last DIR;
		}
	    }
	}
    }
    $self->{sig} = 'sig'->collect(@sigs);
}

# Always compatible with other such builders, so the user
# can define a single program or module from multiple…