cons

quakeIII源码这个不用我多说吧

#!/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.

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

$CVS_id = 'Id';
$CVS_ver = (split(/\s+/, $CVS_id))[2];

$ver_num = "2.3";
$ver_rev = ".1";

$version = "This is Cons $ver_num$ver_rev ($CVS_id)\n";

# Cons: A Software Construction Tool.
# Copyright (c) 1996-2001 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.003;
# 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; multiple -q flags increase quietness level:
		1: quiet about Installing and Removing targets
		2: quiet about build commands, up-to-date 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.

  -S <pkg>	Use package sig::<pkg> to calculate file signatures.
		Currently supported values are "md5" for MD5
		signatures (the default) and "md5::debug" for MD5
		signature debug information.

  -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 [e-mail] mailing
   list.

   To subscribe, send mail to [e-mail] with body
   'subscribe'.

   If you find a bug, please report it through the [e-mail]
   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 [e-mail]

   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::sourcesig = ['*' => 'content'];# Source file signature calculation
$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.

@param::defaults = ();

#
$indent = '';

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

# Default environment.
# This contains only the completely platform-independent information
# we can figure out.  Platform-specific information (UNIX, Win32)
# gets added below.
@param::base = (
     'SIGNATURE'    => [ '*' => 'build' ],
     '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',
     },
     'PERL'	    => $^X,
);

%param::rulesets =
    (
     # Defaults for Win32.
     # Defined for VC++ 6.0 by Greg Spencer <[e-mail]>
     # Your mileage may vary.
     'msvc' => [
		'CC'             => 'cl',
		'CFLAGS'         => '/nologo',
		'CCCOM'          => '%CC %CFLAGS %_IFLAGS /c %< /Fo%>',
		'CXX'            => '%CC',
		'CXXFLAGS'       => '%CFLAGS',
		'CXXCOM'         => '%CXX %CXXFLAGS %_IFLAGS /c %< /Fo%>',
		'INCDIRPREFIX'   => '/I',
		'INCDIRSUFFIX'   => '',
		'LINK'           => 'link',
		'LINKCOM'        => '%LINK %LDFLAGS /out:%> %< %_LDIRS %LIBS',
		'LINKMODULECOM'  => '%LD /r /o %> %<',
		'LIBDIRPREFIX'   => '/LIBPATH:',
		'LIBDIRSUFFIX'   => '',
		'AR'             => 'lib',
		'ARFLAGS'        => '/nologo ',
		'ARCOM'          => "%AR %ARFLAGS /out:%> %<",
		'RANLIB'         => '',
		'LD'             => 'link',
		'LDFLAGS'        => '/nologo ',
		'PREFLIB'        => '',
		],
     # Defaults for a typical (?) UNIX platform.
     # Your mileage may vary.
     'unix' => [
		'CC'             => 'cc',
		'CFLAGS'         => '',
		'CCCOM'          => '%CC %CFLAGS %_IFLAGS -c %< -o %>',
		'CXX'            => '%CC',
		'CXXFLAGS'       => '%CFLAGS',
		'CXXCOM'         => '%CXX %CXXFLAGS %_IFLAGS -c %< -o %>',
		'INCDIRPREFIX'   => '-I',
		'INCDIRSUFFIX'   => '',
		'LINK'           => '%CXX',
		'LINKCOM'        => '%LINK %LDFLAGS -o %> %< %_LDIRS %LIBS',
		'LINKMODULECOM'  => '%LD -r -o %> %<',
		'LIBDIRPREFIX'   => '-L',
		'LIBDIRSUFFIX'   => '',
		'AR'             => 'ar',
		'ARFLAGS'        => 'r', # rs?
		'ARCOM'          => ['%AR %ARFLAGS %> %<', '%RANLIB %>'],
		'RANLIB'         => 'ranlib',
		'AS'             => 'as',
		'ASFLAGS'        => '',
		'ASCOM'          => '%AS %ASFLAGS %< -o %>',
		'LD'             => 'ld',
		'LDFLAGS'        => '',
		'PREFLIB'        => 'lib',
		'ENV'            => { 'PATH' => '/bin:/usr/bin' },
		],
     );

# Set the rules based on the platform.
script::DefaultRules(script::RuleSet($_WIN32 ? 'msvc' : '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++; },
		    '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]); },
		    'S' =>    sub { $param::sigpro = $_[0]; },
		    'wf' =>   sub { $param::depfile = $_[0]; },
		);

    if (defined $opt{$_}) {
	&{$opt{$_}}();
	return;
    }
    while ($_) {
	$_  =~ m/(.)(.*)/;
	if (defined $opt{$1}) {
	    &{$opt{$1}}();
	    $_ = $2;
	    next;
	}
	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;
    }
}