cons

quakeIII源码这个不用我多说吧

	${"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;
    }
}

# For windows platforms which use unix tool sets, the msvc defaults may
# not be useful. Also, in the future, other platforms (Mac?) may have the
# same problem.
sub RuleSet {
    my $style = shift;
    my @rulesets = sort keys %param::rulesets;
    die "Unknown style for rules: $style.\n" .
	"Supported rules are: (" . join(" ", @rulesets) . ")"
	    unless eval(join("||", map("\$style eq '$_'", @rulesets)));
    return @param::base, @{$param::rulesets{$style}};
}

sub DefaultRules {
    @param::defaults = ();
    push @param::defaults, @_;
}

# 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 AfterBuild {
    my($env) = shift;
    my($perl_eval_str) = pop(@_);
    my $file;
    for $file (map($dir::cwd->lookup($_), @_)) {
	$file->{after_build_func} = $perl_eval_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($env), $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($env), $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($env), $file);
	$tgt->local(1);
    }
}

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

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

# 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(@_));
}

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(@_));
}

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(@_));
}

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(@_));
}

# 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($builder) = find build::command::user($env, pop(@_), 'script');
    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($multi) = build::multiple->new($builder, \@tgts);
	for $tgt (@tgts) {
	    $tgt->bind($multi, @sources);
	}
    } else {
	$tgt = $dir::cwd->lookupfile($tgt);
	$env = $env->_resolve($tgt);
	$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;

use vars qw( %builder );