pcons-2.3.1

quakeIII源码这个不用我多说吧

        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->{'bsig'} = 'sig'->collect(@sigs);
}

# Always compatible with other such builders, so the user
# can define a single program or module from multiple places.
sub compatible
{
    my ($self, $other) = @_;
    ref($other) eq "build::command::link";
}

# Link a program.
package build::command::linkedmodule;

use vars qw( @ISA );

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

# Always compatible with other such builders, so the user
# can define a single linked module from multiple places.
sub compatible
{
    my ($self, $other) = @_;
    ref($other) eq "build::command::linkedmodule";
}

# Builder for a C module
package build::command::cc;

use vars qw( @ISA );

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

sub find
{
    $_[1]->{_cc} || do
    {
        my ($class, $env) = @_;
        my ($cpppath) = $env->_subst($env->{CPPPATH});
        my ($cscanner) = find scan::cpp($env->{_cwd}, $cpppath);
        $env->{_IFLAGS} = "%(" . $cscanner->iflags($env) . "%)";
        my ($self) = find build::command($env, $env->{CCCOM});
        $self->{scanner} = $cscanner;
        bless $env->{_cc} = $self;
      }
}

# Invoke the associated	 C scanner to get signature of included files.
sub includes
{
    my ($self, $tgt) = @_;
    $self->{scanner}->includes($tgt, $tgt->{sources}[0]);
}

# Builder for a C++ module
package build::command::cxx;

use vars qw( @ISA );

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

sub find
{
    $_[1]->{_cxx} || do
    {
        my ($class, $env) = @_;
        my ($cpppath) = $env->_subst($env->{CPPPATH});
        my ($cscanner) = find scan::cpp($env->{_cwd}, $cpppath);
        $env->{_IFLAGS} = "%(" . $cscanner->iflags($env) . "%)";
        my ($self) = find build::command($env, $env->{CXXCOM});
        $self->{scanner} = $cscanner;
        bless $env->{_cxx} = $self;
      }
}

# Invoke the associated	 C scanner to get signature of included files.
sub includes
{
    my ($self, $tgt) = @_;
    $self->{scanner}->includes($tgt, $tgt->{sources}[0]);
}

# Builder for a user command (cons::Command).  We assume that a user
# command might be built and implement the appropriate dependencies on
# the command itself (actually, just on the first word of the command
# line).
package build::command::user;

use vars qw( @ISA );

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

sub includes
{
    my ($self, $tgt) = @_;
    my ($sig) = '';

    # Check for any quick scanners attached to source files.
    my $dep;
    for $dep (@{$tgt->{dep}}, @{$tgt->{sources}})
    {
        my ($scanner) = $dep->{'srcscan', $self->{env}};
        if ($scanner)
        {
            $sig .= $scanner->includes($tgt, $dep);
        }
    }

    # XXX Optimize this to not use ignored paths.
    if (!exists $self->{_comsig})
    {
        my ($env) = $self->{env};
        $self->{_comsig} = '';
        my ($com, $dir);
        com:
        for $com ($self->{act}->commands)
        {
            my ($pdirs) = $env->{ENV}->{PATH};
            if (!defined $pdirs)
            {
                $pdirs = [];
            }
            elsif (ref($pdirs) ne 'ARRAY')
            {
                $pdirs = [split (/$main::PATH_SEPARATOR/o, $pdirs)];
            }
            for $dir (map($dir::top->lookupdir($_), @$pdirs))
            {
                my ($prog) = $dir->lookup_accessible($com);
                if ($prog)
                {    # XXX Not checking execute permission.
                    if ((build $prog) eq 'errors')
                    {
                        $tgt->{status} = 'errors';
                        return $sig;
                    }
                    next com if $prog->ignore;
                    $self->{_comsig} .= 'sig'->signature($prog);
                    next com;
                }
            }
        }
    }

    return $self->{_comsig} . $sig;
}

# Builder for a library module (archive).
# We assume that a user command might be built and implement the
# appropriate dependencies on the command itself.
package build::command::library;

use vars qw( @ISA );

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

sub find
{
    my ($class, $env) = @_;
    bless find build::command($env, $env->{ARCOM});
}

# Always compatible with other library builders, so the user
# can define a single library from multiple places.
sub compatible
{
    my ($self, $other) = @_;
    ref($other) eq "build::command::library";
}

# A multi-target builder.
# This allows multiple targets to be associated with a single build
# script, without forcing all the code to be aware of multiple targets.
package build::multiple;

sub new
{
    my ($class, $builder, $tgts) = @_;
    bless {'builder' => $builder, 'env' => $builder->{env}, 'tgts' => $tgts};
}

sub scriptsig
{
    my ($self, $tgt) = @_;
    $self->{builder}->scriptsig($tgt);
}

sub includes
{
    my ($self, $tgt) = @_;
    $self->{builder}->includes($tgt);
}

sub compatible
{
    my ($self, $tgt) = @_;
    $self->{builder}->compatible($tgt);
}

sub cachin
{
    my ($self, $tgt, $sig) = @_;
    $self->{builder}->cachin($tgt, $sig);
}

sub cachout
{
    my ($self, $tgt, $sig) = @_;
    $self->{builder}->cachout($tgt, $sig);
}

sub action
{
    my ($self, $invoked_tgt) = @_;
    return $self->{built} if exists $self->{built};

    # Make sure all targets in the group are unlinked before building any.
    my ($tgts) = $self->{tgts};
    my $tgt;
    for $tgt (@$tgts)
    {
        futil::mkdir($tgt->{dir});
        unlink($tgt->path) if !$tgt->precious;
    }

    # Now do the action to build all the targets. For consistency
    # we always call the action on the first target, just so that
    # $> is deterministic.
    if ($param::max_jobs <= 1)
    {    # pcons
        $self->{built} = $self->{builder}->action($tgts->[0]);
    }
    else
    {
        {

            # action now is non-blocking, so we must kludge blocking for this
            # explicit call
            local ($file::child_queue) = {parent => $tgts->[0]};    # pcons
            $self->{built} = $self->{builder}->action($tgts->[0]);  # pcons
            &file::wait_on_all_children();                          # pcons
        }
    }

    # Now "build" all the other targets (except for the one
    # we were called with). This guarantees that the signature
    # of each target is updated appropriately. We force the
    # targets to be built even if they have been previously
    # considered and found to be OK; the only effect this
    # has is to make sure that signature files are updated
    # correctly.
    for $tgt (@$tgts)
    {
        if ($tgt ne $invoked_tgt)
        {
            delete $tgt->{status};
            'sig'->invalidate($tgt);
            build $tgt;
        }
    }

    # Status of action.
    $self->{built};
}

package action;

sub new
{
    my ($env, $act) = @_;
    if (ref($act) eq 'CODE')
    {
        return action::perl->new($act);
    }
    else
    {
        return action::command->new($env, $act);
    }
}

package action::command;

use vars qw( @ISA %cmd %_varopts $_varletters );

BEGIN
{
    @ISA = $main::_WIN32 ? 'action::command::win32' : 'action::command::unix';

    # Internal hash for processing variable options.
    # f: return file part
    # d: return directory part
    # F: return file part, but strip any suffix
    # 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
    # S: return the absolute path to a Linked source file
    %_varopts = (
        'f' => sub { return $_[0]->{entry}; },
        'd' => sub { return $_[0]->{dir}->path; },
        'F' => sub {
            my $subst = $_[0]->{entry};
            $subst =~ s/\.[^\.]+$//;
            return $subst;
        },
        'b' => sub {
            my $subst = $_[0]->path;
            $subst =~ s/\.[^\.]+$//;
            return $subst;
        },
        's' => sub {
            my $subst = $_[0]->{entry};
            $subst =~ m/(\.[^\.]+)$/;
            return $1;
        },
        'a' => sub {
            my $path = $_[0]->path;
            if (!File::Spec->file_name_is_absolute($path))
            {
                $path = File::Spec->catfile(Cwd::cwd(), $path);
            }
            return $path;
        },
        'S' => sub {
            my $path = $_[0]->srcpath;
            if (!File::Spec->file_name_is_absolute($path))
            {
                my $cwd = File::Spec->canonpath(Cwd::cwd());
                $path = File::Spec->catfile($cwd, $path);
            }
            return $path;
        },
        );

    $_varletters = join ('', keys %_varopts);
}

# Internal routine for processing variable options.
# Options are specified in hash in the BEGIN block above.
# no option: return path to file (relative to top,
# or absolute if it's outside)
sub _variant
{
    my ($opt, $file) = @_;
    $opt = '' if !defined $opt;
    if (defined $_varopts{$opt})
    {
        return &{$_varopts{$opt}} ($file);
    }
    return $file->path;
}

sub new
{
    my ($class, $env, $cmd) = @_;
    $cmd = $env->_subst($cmd);
    $cmd{$env, $cmd} || do
    {

        # Remove unwanted bits from signature -- those bracketed by %( ... %)
        my $sigs = $cmd;
        my $sig  = '';
        if (ref($sigs) eq 'ARRAY')
        {

            # This is an array of commands..
            my $f;
            foreach $f (@$sigs)
            {
                $sig .= _strip($f);
            }
        }
        else
        {
            $sig = _strip($sigs);
        }
        my $self = {cmd => $cmd, cmdsig => 'sig'->cmdsig($sig)};
        $cmd{$env, $cmd} = bless $self, $class;
    };
}

sub _strip
{
    my $sig = shift;
    $sig =~ s/^\@\s*//mg;
    while ($sig =~ s/%\(([^%]|%[^\(])*?%\)//g) { }
    $sig;
}

sub scriptsig
{
    $_[0]->{cmdsig};
}

# Return an array of all the commands (first word on each line).
sub commands
{
    my ($self) = @_;
    my (@cmds) = ();
    my $com;
    my $cmd = $self->{'cmd'};
    my @allcoms;

    push @allcoms, ref $cmd ? @{$cmd} : split (/\n/, $cmd);

    for $com (@allcoms)
    {
        $com =~ s/^\s*//;
        $com =~ s/\s.*//;
        next if !$com;    # blank line
        push @cmds, $com;
    }
    @cmds;
}

# 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