pcons-2.3.1

quakeIII源码这个不用我多说吧

          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 );

# Every builder must now have at least an associated environment,
# so we can find its sigarray and calculate the proper signature.
sub find
{
    my ($class, $env) = @_;
    $builder{$env} || do
    {
        my $self = {env => $env};
        $builder{$env} = bless $self, $class;
      }
}

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

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

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

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

use vars qw( @ISA );

BEGIN { @ISA = qw(build) }

# 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 < 1);
    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, $cmd, $package) = @_;
    my ($act) = action::new($env, $cmd);
    $package ||= '';
    $com{$env, $act, $package} || do
    {
        my $self = {env => $env, act => $act, 'package' => $package};
        $com{$env, $act, $package} = bless $self, $class;
      }
}

# Default cache in function.
sub cachin
{
    my ($self, $tgt, $sig) = @_;
    if (cache::in($tgt, $sig))
    {
        if ($param::cachecom)
        {
            $self->{act}->show($self->{env}, $tgt);
        }
        else
        {
            printf("Retrieved %s from cache\n", $tgt->path)
              if ($param::quiet < 1);
        }
        return 1;
    }
    return undef;
}

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

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

# Return script signature.
sub scriptsig
{
    $_[0]->{act}->scriptsig;
}

# 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, $dpath);
        for $dir (map($wd->lookupdir($env->_subst($_)), @$pdirs))
        {
            $dpath = $dir->path;

            # Add the (presumably local) directory to the -L flags
            # if we're not using repositories, the directory exists,
            # or it's Linked to a source directory (that is, it *will*
            # exist by the time the link occurs).
            $ldirs .= " " . $env->{LIBDIRPREFIX} . $dpath . $env->{LIBDIRSUFFIX}
              if !@param::rpath || -d $dpath || $dir->is_linked;
            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
                          . $env->{LIBDIRSUFFIX};
                    }
                }
                else
                {
                    my ($rpath);
                    foreach $d (map($_->path, @param::rpath))
                    {
                        $rpath = File::Spec->catfile($d, $dpath);
                        $ldirs .= " "
                          . $env->{LIBDIRPREFIX} . $rpath
                          . $env->{LIBDIRSUFFIX}
                          if -d $rpath;
                    }
                }
            }
        }
        $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}. <[e-mail]> 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]->{'bsig'} if exists $_[0]->{'bsig'};
    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);

    # Pass %LIBS symbol through %-substituition
    # <[e-mail]> 1998-06-18
    @names = split (' ', $env->_subst($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?  <[e-mail]> 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
            # <[e-mail]> 1998-05-13
            if ($main::_WIN32)
            {
                $lpath = [$dir::top, @lpath];
            }
            else
            {
                $lpath = [$dir::top];
            }
        }