@rem = '--*-Perl-*--
@echo off

rem User-contributed SDE2 Component build script.
rem Author: Wouter Batelaan - NXP Semiconductors B.V.; Southampton
rem Runs Perl on this file, and executes its output
rem such that environment variables can be updated, and the working directory changed,
rem if necessary.
if "%_TMROOT%"=="" (
  @echo **ERROR: ^(%~f0^) please define _TMROOT. Exit.
  goto endofperl
)
for /F "usebackq tokens=*" %%i IN (`perl.exe -w "%~f0" %*`) do %%i
goto endofperl
rem ';

#
#                             stb225 Project
#                   ---------------------------------
#
# Copyright (C) 2006 NXP Semiconductors B.V.
# All Rights Reserved.
#
# Filename: cbuild.bat
#
# Rev Date       Author      Comments
#-------------------------------------------------------------------------------
#   3 20061117   batelaan    Only set parent env if one :env argument, and not building anything.
#                            Enhance error checking/reporting of cmd executed to obtain env settings.
#   7 20070620   batelaan    Correct error handling if make can't be found.
#   8 20070717   batelaan    Add -q (quiet) option. Improve invocation under Windows.
#   9 20070720   batelaan    Commandline += and -= assignments for env vars.

=head1 NAME

cbuild - SDE2 Component Build program

=head1 SYNOPSIS

See: cbuild -h



=head1 DESCRIPTION

C<cbuild> provides a simple but flexible mechanism to build software components/applications
(called CIs) that are stored according to SDE2-compatible standards. 
On the command line you specify configurations and CI names or directories,
and C<cbuild> will then build your CIs for each of the specified configurations.
Configurations are flexible, but basically define a set of environment variables.

Some of the main features are:

- totally configurable with respect to which build types are available
[debug/trace/assert/retail] combinations with [mips/trimedia/arm] etc

- automatically finds components/interfaces/applications from just their name
(but of course you can also specify the directory path).

- common command line usage for Unix and Windows.

- especially suited to run from within an editor or IDE.
Changes relative path names in output into absolute pathnames for stepping through errors.

- by default has useful action options to run gmake (-m), Qmore (-qm), QAC (-qac), run make clean (-c),
and do a recursive build (-r), but...

- extendable with additional actions and options.

- can reuse existing batch files for defining build configurations.

- written in Perl (a great language! :-).

=for html
This tool is developed using 
<a href="http://gforge.natlab.research.philips.com">
the Philips Gforge site</a>.
For more information, see
<a href="http://gforge.natlab.research.philips.com/projects/sde2utils">
http://gforge.natlab.research.philips.com/projects/sde2utils</a>

=head2 Build Order

CIs are built in the order they appear on the command line.
If multiple configurations have been specified, then each CI
is built for these configurations before building the next CI.

=head2 Running from within an editor or IDE

The tool is especially able to be run from within an editor or IDE.

- It can automatically descend directories to find the directory containing the makefile.
This is option -fm.

- it can massage output of subprocesses such that filename/linenumbers are printed
to suit the editors/IDE. For example, it can make relative filenames absolute,
or change the format to suit the editor's filename/linenumber regular expression matching.

- Option -ni should be used to indicate the non-interactive running of the cbuild script,
to prevent printing environment variable changes.

- It can re-load the environment that was last used and saved
outside the editor (options -sl and -ll).
Thus one can chance the current configuration settings from outside the editor,
in a terminal session, and then use those settings within the editor.
Alternatively one can specify the environment when invoking C<cbuild> from within the editor.

From within an editor one does not use the C<cbuild.bat> script or Unix alias to invoke the tool,
but invokes C<perl> on the C<cbuild.bat> file directly.

The general command to define in an editor to run make on  a CI is:

    perl <path-to-cbuild.bat-file> -ni <OPTS> <user_specified_args>

but you may have to enhance this to set _TMROOT and _TMSITE environment variables.
For example, on Windows, the following command line will ensure that
_TMROOT and _TMSITE are set to q: and soubhs before the perl command runs.

    cmd /c (set _TMROOT=q:) & (set _TMSITE=soubhs) & perl ...

<OPTS> to consider are:

  @<file>  Load <file> or <file>.pl as an additional buildconfig file.
  -ll      Load 'last' environment.
  -fm <current-editor-file-or-directory>

=head2 Source Insight editor integration

Define a custom command (e.g. named cbuild) to run make on a CI, E.G. like this:

    perl <path-to-cbuild.bat-file> -ni <OPTS> %1 %2 %3 %4 %5 %6 %7 %8 %9

or

    cmd /c (set _TMROOT=...) & (set _TMSITE=...) & perl <path-to-cbuild.bat-file> -ni <OPTS> %1 %2 %3 %4 %5 %6 %7 %8 %9

Directory: %d

Ensure Capture output, Save files first, and Parse links in output are ticked.

The pattern for parsing source links in tool output, assuming C<cbuild> has
been configured (see L<"BuildConfigFile::registerLocationEditor">)
to output in Trimedia compiler compatible file/line location format
(C<"...filename", line N:>) should be:

    ^"\([^"]+\)", line \([0-9]+\):

Assign it a key (Suggested: F1). When you
have edited a CI source file and want to build, hit F1 and supply arguments:
if editing a source or header file then .. may sometimes be the shortest
way to specify the current component to build ( -fm .  is another way).

See also L<"Running from within an editor or IDE">.

=head2 Running From a Terminal on Windows

Although C<cbuild> is mostly written in Perl, it does update the command line environment
from which it is invoked.
It does this by echoing environment changing commands to standard output,
which are then interpreted by the C<cbuild.bat> script.

This means that C<cbuild.bat> can be used to set an configuration, and
other tools can then be run from the same command line environment
and they will pickup the enviroment variables set by the previous C<cbuild.bat> run.



=head2 Running From a Terminal on Unix

This is similar to running on Windows, except one should define a shell function
(not a shell script!), e.g. for the bash/zsh:

    function cbuild {
      eval `perl <path-to-cbuild.bat> $*`
    }

Or try to define an alias which also evals the standard output of running C<cbuild.bat>.



=head2 Configuring the tool

Write a C<cbuildconfig.pl> file (usually in your SDE2 site directory):

    - pre SDE2 v2.0:      C<$_TMROOT/sde2/sites/$_TMSITE/cbuildconfig.pl>
    - SDE2 v2.0 or later: C<$_TMROOT/project/sites/$_TMSITE/cbuildconfig.pl>
      or                  C<$_TMPROJECT/sites/$_TMSITE/cbuildconfig.pl>

The C<cbuildconfig.pl> file is searched for along a path, in this order:

    - $_TMROOT
    - directories specified in C<$CBUILDCONFIGPATH>
      Environment variable C<CBUILDCONFIGPATH> is a optional path variable (like C<PATH>).
    - C<$_TMPROJECT/sites/$_TMSITE>
    - C<$_TMROOT/project/sites/$_TMSITE>
    - C<$_TMROOT/sde2/sites/$_TMSITE>


C<cbuildconfig.pl> uses Perl syntax, and can contain the subroutine calls
as described furtheron.

In C<cbuildconfig.pl> you define the available environments that can be set
by this tool, using one or more of:

L<registerEnv|"BuildConfigFile::registerEnv"> - Registers an environment command line option, name, and Perl setup file.

L<registerEnv|"BuildConfigFile::registerEnvByCmd"> - Registers an environment command line option, name, and setup command file.

L<registerEnvSet|"BuildConfigFile::registerEnvSet"> - Registers the name for a set of environments.

E.G.

  registerEnvByCmd("td", "tm_debug", "(env.bat d) & (set > %s)", $ENV{'_TMROOT'});
  registerEnv("md", "mips_vxworks_eb_debug", "mips_vxworks_eb_debug.pl");
  registerEnv("xa", "x86_nt_debug_static_default", "x86_nt_debug_static_default.pl");
  registerEnvSet("a", "trimedia_all", qw(td ta tr));

Each <abbreviation> becomes an :<abbreviation> command line option to cbuild.
Each registered environment has an associated environment setup file,
which is executed to setup that environment. It again uses Perl syntax,
and can contain the follow subroutines.

L<load|"EnvDefFile::load"> - loads another Perl file.

L<set|"EnvDefFile::set"> - sets an environment variable.

L<unset|"EnvDefFile::unset"> - unsets an environment variable.

L<querySet|"EnvDefFile::querySet"> - optionally sets an environment variable.

L<queryUnset|"EnvDefFile::queryUnset"> - optionally unsets an environment variable.

L<setPrompt|"EnvDefFile::setPrompt"> - sets the command line prompt. Only for Windows.

L<setColor|"EnvDefFile::setColor"> - Sets the forground color of the terminal (Windows/MSDOS only).



=head2 Adding Command Line Options

Create and configure instances of L<"Action Class"> and L<"Option Class"> in either:

- the C<cbuildconfig.pl> file directly

- a separate file which is loaded from C<cbuildconfig.pl>.

- a file specified using the C<@> command line option.

Following this various Perl functions and classes are documented.

=cut

use Cwd;
use File::Spec;
use vars qw(@rem);
#require Exporter;

BEGIN {
  #@ISA = qw(Exporter);
  #@EXPORT = qw(checkNumArgs parseArgs nextArg argsUntil runCmd getLocation makeAbsolute cd parentDir yesOrNo);
  #$Exporter::Verbose = 1;
  $pgm = $0;
  @origARGV = @ARGV;
  %origENV = %ENV;
  # Some UNIX environment variables that should not be unset: TODO find a better way to determine this automatically!
  %keepENV = qw(PS1 1 PS2 1 PS3 1 PS4 1 PROMPT_COMMAND 1);
  open(PIPECMD, ">&STDOUT");
  select(PIPECMD); $| = 1; # make unbuffered.
  close(STDOUT);
  open(STDOUT, ">&STDERR");
  select(STDOUT); $| = 1; # make unbuffered.
  $TMP = $ENV{TMP} || $ENV{TEMP} || "/tmp";
  $USER = $ENV{USER} || $ENV{LOGNAME} || "user";
}
$pgmPath = lookupFile($pgm);
$pgmDirectory = $pgmPath;  $pgmDirectory =~ s{[/\\][^/\\]+$}{};
$printEnv = 0;
$origCwd = getcwd();
if ($^O eq 'MSWin32') { $curDrive = $origCwd; $curDrive =~ s/^(.).*$/$1/; }
$mainOptionFound = 0;
$noexec = 0;
$quiet = 0;
$nonInteractive = 0;
$doFilter = 1;
$extendedCommandLine = 0;
$main::ignoreNotCI = 0;
#$locationExtractorsRA = [];
@locationDirectoryExtractors = ();
$locationEditorsRA = [];
$locationFormatterRS = sub { "\"$_[0]\", line $_[1]:"; };
@makefileNames = qw(makefile Makefile);
@defMakeOpts = ();

$loadLastEnv = 0;
$loadEnv = "";
$saveLastEnv = 0;
$saveEnv = "";

$dirMatchSpec = undef;
$doCd = 0;
$envExt = ".env.pl";
$keepGoing = 0; # -k
$alwaysExitOK = 0; # -K
$allowNoCI = 0; # -noci
@options = qw(
  -- @
  -fm -cd -ld -cm
  -br -xc
  -FnotCI
  -ll -sl -le -se -ni
  -q -n -nf -pw
  -h -? -ho
  -k -K -noci);

check_TMROOT(); # $_TMROOT & $ENV{_TMROOT} defined.
check_TMSITE(); # $siteDir & $ENV{_TMSITE} defined.
unshift @LOADPATH, $_TMROOT;
unshift @LOADPATH, PATH::split($ENV{'CBUILDCONFIGPATH'}) if exists $ENV{'CBUILDCONFIGPATH'};
unshift @LOADPATH,
  $siteDir,
  $origCwd;
$cbuildconfigFile = lookupFile("cbuildconfig.pl", @LOADPATH);

Env::registerEnvUserDefined('last', 'last', "$siteDir/last$main::envExt");
registerStandardActions();
BuildConfigFile::load("cbuildconfig.pl");
parseArgs0();
Msg->debug(1, "CWD = $origCwd");
Msg->debug(2, "File load path is: @LOADPATH");
push @defMakeOpts, "--no-print-directory" if $Msg::debug == 0;

%baseENV = %ENV;
doIt();
print "NB: no commands were executed because -n option was specified!\n" if $noexec && !$quiet;
doExit($alwaysExitOK ? 0 : ($Msg::errors == 0 ? 0 : 1));

#-------------------------------------------------------------------------------
sub parseArgs0 {
  if (@ARGV == 0) {
    usage();
  }
  parseArgs(@ARGV);
  if ($doCd && ($mainOptionFound != 1)) {
    usage("-cd is mutually exclusive with other options.");
  }
  if ($loadLastEnv && ($loadEnv ne "")) {
    usage("-ll and -le <name> are mutually exclusive options.");
  }
}
#-------------------------------------------------------------------------------

=head2 main::parseArgs

Usage: C<main::parseArgs($arg...)>

Parses its arguments as if they were specified on the command line.

=cut

sub parseArgs {
  local @ARGV = @_;

  while (@ARGV) {
    $arg = shift @ARGV;
    Msg->debug(5, "Arg: \"$arg\"");
    if (defined $collectingArgsIntoArray) {
      if ($arg eq "--") {
	$collectingArgsIntoArray = undef;
      } else {
	push @$collectingArgsIntoArray, $arg;
      }
    } elsif (defined ($option = Option->getByOption($arg))) {
      $option->setSelected(1);
      my $optionParserRS = $option->{'optionParserRS'};
      $optionParserRS->($option, $arg) if (defined $optionParserRS);
    } elsif ($arg =~ /^-/) {
      parseOption($arg);
    } elsif ($arg =~ /^\@(.*)/) {
      BuildConfigFile::load($1);
    } elsif ($arg =~ /^[\w_]+[-+]?=/) {
      push @overrideENV, $arg;
      overrideENV($arg);
    } elsif ($arg =~ /^:(.+)$/) {
      BuildList->addGlobalEnv($1);
    } else {
      BuildList->addCiUsingGlobalEnvs($arg);
    }
  }
}
#-------------------------------------------------------------------------------
sub parseOption {
  main::checkNumArgs(\@_, 1, 1);
  my ($opt) = @_;

  if ($opt eq "-fm") {
    my $dir = nextArg($opt);
    BuildList->addCiFromFindMakefile($dir);
  } elsif ($opt eq "-cm") { # CIs matching
    map {BuildList->addCiUsingGlobalEnvs($_);} Projects->getMatchingDirs(nextArg($opt));
  } elsif ($opt eq "-cd") {
    $doCd = 1;
    $mainOptionFound++;
  } elsif ($opt eq "-ld") {
    $dirMatchSpec = nextArg($opt);
    $mainOptionFound++;

  # Other options:
  } elsif ($opt eq "-ni") {
    $nonInteractive = 1;
  } elsif ($opt eq "-nf") {
    $doFilter = 0;
  } elsif ($opt eq "-br") {
    $buildroot = nextArg($opt);
  } elsif ($opt eq "-xc") {
    $extendedCommandLine = 1;

  } elsif ($opt eq "-FnotCI") {
    $ignoreNotCI = 1;

  # Environment options:
  } elsif ($opt eq "-ll") {
    $loadLastEnv = 1;
  } elsif ($opt eq "-sl") {
    $saveLastEnv = 1;
  } elsif ($opt eq "-le") {
    $loadEnv = nextArg($opt);
    $loadEnv =~ s/^://; # allow user flexibility of putting a colon on env name.
  } elsif ($opt eq "-se") {
    $saveEnv = nextArg($opt);
    $saveEnv =~ s/^://; # allow user flexibility of putting a colon on env name.

  # Error options::
  } elsif ($opt eq "-k") {
    $keepGoing = 1;
  } elsif ($opt eq "-K") {
    $alwaysExitOK = 1;
  } elsif ($opt eq "-noci") {
    $allowNoCI = 1;

  # Debug and Help options:
  } elsif ($opt eq "-n") {
    $noexec = 1;
  } elsif ($opt eq "-pe") {
    $printEnv = 1;
  } elsif ($opt eq "-q") {
    $quiet = 1;
  } elsif ($opt =~ /^-d([012345])?$/) {
    $Msg::debug = $1 || 1;
  } elsif (($opt eq "-h") || ($opt eq "-?")) {
    help();
  } elsif ($opt eq "-ho") {
    helpOptions();
  } else {
    # perhaps user meant to use : instead of -:
    my $name = $opt;
    $name =~ s/^-//;
    if (Env->exists($name)) {
      usage("Unknown option: \"$opt\": did you mean \":$name\" ?");
    } else {
      usage("Unknown option: \"$opt\"");
    }
  }
}
#-------------------------------------------------------------------------------
sub doIt {
  # process global, non-CI options, first:
  if ($doCd) {
    BuildList->ensureSingleEntry();
    PipeCmd->cd(BuildList->next()->dir());
    return;
  } elsif (defined $dirMatchSpec) {
    Projects->listMatchingDirs($dirMatchSpec);
    return;
  }

  my $envDefined = 0;
  if ($loadEnv ne "") {
    loadEnv($loadEnv);
    $envDefined = 1;
  } elsif ($loadLastEnv) {
    loadEnv('last');
    $envDefined = 1;
  }

  if (BuildList->isEmpty()) {
    if (@BuildList::globalEnvs != 1) {
      Msg->warn("Should specify exactly one environment if omitting a CI spec, or use -ll or -le.")
        unless $envDefined || $allowNoCI;
    } else {
      my $env = $BuildList::globalEnvs[0];
      $env->setup();
    }
  } else {
    BuildList->process();
  }

  pipeEnvToParentProcess() if (!$nonInteractive) && BuildList->isEmpty() && (@BuildList::globalEnvs == 1);

  saveEnv('last') if $saveLastEnv;
  saveEnv($saveEnv) if $saveEnv ne "";
}

#-------------------------------------------------------------------------------

=head2 main::nextArg

Usage: C<main::nextArg($cmdLineOption)>

Returns the next argument on the command line.
Issues a fatal error message and exitst the program if
there are no more arguments on the command line.
$cmdLineOption should be the current command line option
which will be mentioned in the error message issued.
Especially useful for L<"Action Class"> and L<"Option Class"> objects.

=cut

sub nextArg {
  main::checkNumArgs(\@_, 1, 1);
  my ($opt) = @_;
  my $nextArg = shift @main::ARGV;
  unless (defined $nextArg) {
    Msg->fatal("Insufficient arguments after \"$opt\"");
  }
  $nextArg;
}
#-------------------------------------------------------------------------------

=head2 main::argsUntil

Usage: C<main::argsUntil($cmdLineOption, $untilArg)>

Return all arguments until the next arg is $untilArg (usually "--"),
and then drops $untilArg.
Issues a fatal error message and exits the program if
$untilArg is not found.
$cmdLineOption should be the current command line option
which will be mentioned in the error message issued.
Especially useful for L<"Action Class"> and L<"Option Class"> objects.

=cut

sub argsUntil {
  main::checkNumArgs(\@_, 2, 2);
  my ($opt, $untilArg) = @_;
  my @args = ();
  for (;;) {
    my $nextArg = shift @main::ARGV;
    unless (defined $nextArg) {
      Msg->fatal("Missing final \"$untilArg\" after \"$opt\"");
    }
    last if $nextArg eq $untilArg;
    push @args, $nextArg;
  }
  #Msg->debug(5, "Option $opt has args @args");
  @args;
}
#-------------------------------------------------------------------------------
sub help {
  main::checkNumArgs(\@_, 0, 0);
  print <<EOF;

SDE2 command line build tool. General usage:
cbuild <options> <:configSpec>...  <CIspec>[/<subdir>]....
A CI (configurable item) is either a component, interface or application
according to SDE2/MoReUse conventions.

Main behaviour is selected by one of these options:
-ld <wildcard>          List CI directories matching <wildcard>.
-cd <CI>                Change directory to <CI>.

Or any of the following actions:
EOF
  my $action;
  foreach $action (@Action::actions) {
    print $action->{'help'}, "\n";
  }

  my $option;
  print "\nOptions:\n";
  foreach $option (@Option::options) {
    print $option->{'help'}, "\n" if ref($option) eq 'Option';
  }

  print <<EOF;

A CIspec is:
  a name of a CI
  path to the directory of a CI
  a CI with subdirectory, or an option:
  -cm <wildcard>        Matches CI's whose pathname contains Shell-like wildcard
  -fm <dir>             Find CI by makefile: useful if this script is invoked from within a
                        CI subdirectory, and the CI name is not known. The CI will be found
                        by ascending <dir> until it finds a makefile.
EOF
  # ' <= editor syntax highlighting fix
  my $cfgHdr = 0;
  my $name;
  foreach $name (sort(@Env::envFullNames)) {
    my $env = Env->get($name);
    next if ($name eq 'last') || ($name eq 'base');
    print "\nConfigSpecs (from $cbuildconfigFile):\n" unless $cfgHdr++;
    printf ":%-23s %-26s %s\n", $env->abbrev(), $name, $env->info();
  }
  print <<EOF;

For more options help use -ho.
@{[getHelpFileMsg()]}
EOF
  doExit(0);
}
#-------------------------------------------------------------------------------
sub helpOptions {
  main::checkNumArgs(\@_, 0, 0);
  print <<EOF;

Options:
-h                      Basic help.
-br <buildroot>         Globally override value of _TMTGTBUILDROOT (default is specified
                        by configSpec).
-k                      Do not stop on a build error, but keep going.
-K                      Do not return error code if any build failed (implies -k).
-n                      No-execute, only print what would be executed.
-nf                     Do not filter output through location extractors/filters.
-pe                     Print environment after setting it.
-noci                   Suppress warning about missing environment or CI specs.
-d<0-5>                 Debug. Level 0-5.
-q                      Extra quiet.
-xc                     Use extended command line (see HTML help doc).
@<file>                 Load <file> or <file>.pl as an additional buildconfig file.

-ll                     Load 'last' environment.
-sl                     Save 'last' environment.
-le <name>              Load the environment called <name>.
-se <name>              Save the environment to <name>.

The following options cause cbuild to continue after what otherwise is a fatal error:
(place these options early on the cmdline!)
-FnotCI                 command line argument is 'Not a CI' error

Environment variables can be modified on the command line by using:
var=VALUE               Set var to VALUE.
var=                    Delete var from the environment.
var+=VALUE              Prefix VALUE to variable.
If var is _TMDIVERSITY, then the RIGHT thing is done.

@{[getHelpFileMsg()]}
EOF
# Leave this undocumented for the moment,
# until someone really needs it:
#var-=VALUE              Remove VALUE from variable. If VALUE appears more than once
#                        in current var value, then remove first occurance in this order:
#                        beginning, end, anywhere.
  doExit(0);
}

#-------------------------------------------------------------------------------
# Returns a message referring to further help file.
# It tries to find the file cbuild.html in the cbuild program directory.
sub getHelpFileMsg {
  my $htmlFile = "$pgmDirectory/cbuild.html";
  if (-f $htmlFile) {
    "See the following for online documentation: $htmlFile";
  } else {
    "See the online HTML help file cbuild.html";
  }
}

#-------------------------------------------------------------------------------
sub usage {
  main::checkNumArgs(\@_, 0, 1);
  my ($msg) = @_;
  if (defined $msg) {
    print "**FATAL: $msg\n";
  }
  print <<EOF;
cbuild: a user-contributed SDE2 Build tool.
Use -h and/or -ho options for more information.
@{[getHelpFileMsg()]}
EOF
  doExit(1);
}

#-------------------------------------------------------------------------------
sub check_TMROOT {
  main::checkNumArgs(\@_, 0, 0);
  my $_TMROOT_src;
  if (exists $ENV{'_TMROOT'}) {
    $_TMROOT_src = 'Environment variable _TMROOT';
  } else {
    if (exists $ENV{'IV_DRIVE'}) {
      $ENV{'_TMROOT'} = $ENV{'IV_DRIVE'};
      $_TMROOT_src = 'IV_DRIVE';
    } else {
      Msg->fatal('_TMROOT nor IV_DRIVE defined.');
    }
  }
  $_TMROOT = $ENV{'_TMROOT'};
  unless (-d $_TMROOT) {
    Msg->fatal("$_TMROOT_src variable points to non-accessible directory:\n$_TMROOT: $!");
    return;
  }
}

#-------------------------------------------------------------------------------
sub check_TMSITE {
  main::checkNumArgs(\@_, 0, 0);
  $_TMSITE = $ENV{'_TMSITE'};
  my $_TMSITE_src;
  if (defined $_TMSITE) {
    $_TMSITE_src = 'Environment variable _TMSITE';
  } else {
    my $our_site_file = "$_TMROOT/our_site.bat";
    if (-f $our_site_file) {
      open(F, $our_site_file) || Msg->fatal("$!: Cannot read \"$our_site_file\"");
      Msg->debug(2, "Reading $our_site_file");
      while (<F>) {
	if (m!(?:cd|pushd)\s+(?:sde|project)[/\\]sites[/\\](\S+)!) {
	  $_TMSITE = $1;
	  $ENV{'_TMSITE'} = $_TMSITE;
	  $_TMSITE_src = "File $our_site_file";
	  last;
	}
      }
      close(F);
    }
  }
  unless (defined $_TMSITE) {
    Msg->fatal("\$_TMSITE not defined and no our_site.bat file");
    return;
  }
  if (defined $ENV{'_TMPROJECT'}) {
    $_TMPROJECT = $ENV{'_TMPROJECT'};
    Msg->fatal("\$_TMPROJECT does not point to a directory: \"$_TMPROJECT\"") unless -d $_TMPROJECT;
    $siteDir = "$_TMPROJECT/sites/$_TMSITE";
  } elsif (-d "$_TMROOT/project/sites") {
    $siteDir = "$_TMROOT/project/sites/$_TMSITE";
  } else {
    $siteDir = "$_TMROOT/sde/sites/$_TMSITE";
  }
  unless (-d $siteDir) {
    Msg->fatal("Directory \$_TMROOT/sde/sites/\$_TMSITE (< SDE2 v2.0)\n    \$_TMROOT/project/sites/\$_TMSITE (>= SDE2 v2.0) does not exist.\n");
  }
}

#-------------------------------------------------------------------------------
# Usage: findDirContainingMakefile();
# Traverses up directory tree until it finds a makefile,
# returning the directory found. 
# Issues fatal message if not found.
sub findDirContainingMakefile {
  main::checkNumArgs(\@_, 1, 1);
  my ($dir) = @_;
  my $origCwd = getcwd();
  cd($dir);
  my $startingDir = getcwd();
  my $dir1 = $startingDir;
  for (;;) {
    Msg->debug(4, "Checking for [Mm]akefile in $dir1");
    my $mf;
    foreach $mf (@makefileNames) {
      if (-f "$dir1/$mf") {
	Msg->debug(1, "Found \"$dir1/$mf\"");
        chdir($origCwd) || fatal("$!: $origCwd");
	return $dir1;
      }
    }
    # ascend to parent directory:
    last unless $dir1 =~ s![/\\][^/\\]+$!!;
  }
  Msg->fatal("Cannot find [Mm]akefile in or above \"$startingDir\"");
}

#-------------------------------------------------------------------------------
sub saveEnv {
  main::checkNumArgs(\@_, 1, 1);
  my ($name) = @_;
  my $env = Env->get($name);
  if (defined $env && $env->preDefined()) {
    Msg->fatal("Cannot save to predefined environment '$name'");
  }
  my $envFile = $siteDir . "/$name$main::envExt";
  Msg->debug(2, "Saving environment '$name' to ($envFile)");
  return if ($noexec);
  rename($envFile, "$envFile.prev");
  unless (open(F, ">$envFile")) {
    Msg->fatal("$!: $envFile\nCannot save to environment '$name'");
  }
  my $now = localtime();
  print F "# Do not edit!\n";
  print F "# Generated by: perl $main::pgm @main::origARGV\n";
  print F "# Date/time: $now\n";
  foreach $var (sort(keys(%ENV))) {
    my $value = $ENV{$var};
    if ($value =~ /\n/) {
      Msg->warn("Env var $name contains a newline character - NOT saved to env '$name'!\n");
    } else {
      print F "set(", quote($var), ", ", quote($value), ");\n";
      #print F "set ", $var, "=", $value, "\n";
    }
  }
  close(F);
}

#-------------------------------------------------------------------------------
# Looks up the file along a path:
# Usage: lookupFile($file, @filePath)
# If $file does not contain a period, then in each directory look for
# $file and "$file.pl".

sub lookupFile {
  my $file = shift;
  return $file if -f $file;
  my $fileWithExt = $file . ".pl";
  return $fileWithExt if -f $fileWithExt;
  foreach (@_) {
    my $f = "$_/$file";
    if (-f $f or -f ($f = "$_/$fileWithExt")) {
      Msg->debug(2, "Lookup file: \"$file\" => \"$f\"");
      return $f;
    }
  }
  return undef;
}

#-------------------------------------------------------------------------------

sub lookupAndLoadFile {
  main::checkNumArgs(\@_, 3);
  my ($file, $fileLoadSubR, @PATH) = @_;
  my $expandedFile = Var->expand('loadFile', $file);
  #push @PATH, Cwd::getcwd();
  my $resolvedFile = lookupFile($expandedFile, @PATH);
  Msg->fatal("Cannot find file: \"$file\" or \"$file.pl\"; looked in\n  " .
             join("\n  ", @PATH)) unless defined $resolvedFile;
  return loadFile($resolvedFile, $fileLoadSubR);
}

#-------------------------------------------------------------------------------

BEGIN { $loadFileLevel = 0; }

sub loadFile {
  main::checkNumArgs(\@_, 2, 2);
  my ($file, $fileLoadSubR) = @_;
  my $indent = " " x ($loadFileLevel * 2);
  Msg->debug(2, "$indent>>load \"$file\"");
  Msg->fatal("$!: $file") unless -r $file;
  Msg->fatal("Not a file: $file") unless -f $file;
  $loadFileLevel++;
  $fileLoadSubR->($file);
  if ($@) {
    Msg->fatal("$file: $@");
  }
  Msg->debug(2, "$indent<<load \"$file\"");
  $loadFileLevel--;
}

#-------------------------------------------------------------------------------
sub loadEnv {
  main::checkNumArgs(\@_, 1, 1);
  my ($name) = @_;
  my $env = Env->get($name);
  unless (defined $env) {
    $env = Env::registerEnvUserDefined($name, $name, "$name$main::envExt");
  }
  $env->setup();
}

#-------------------------------------------------------------------------------
sub quote {
  main::checkNumArgs(\@_, 1, 1);
  my ($s) = @_;
  $s =~ s/([\'\\])/\\$1/g;
  "'" . $s . "'";
}
#-------------------------------------------------------------------------------

=head2 main::runCmd

Usage: C<main::runCmd(commandLine...)>

Runs a shell command. The command line is printed to stdout.
It is better to use this than the standard
Perl system subroutines, since if -n (noexecute) option is used runCmd
still prints its command line, but does not execute.
Especially meant for use with L<"Action Class"> objects.
The result code of the command executed is returned.
Use L<"Msg::buildError"> to report build failures.

=cut

sub runCmd {
  main::checkNumArgs(\@_, 1);
  my (@cmd) = @_;
  Msg->debug(0, "@cmd");
  if ($noexec) {
    return 0;
  }
  my $status;
  if ($doFilter && @{$main::locationEditorsRA}) { # ignore for the moment: @{$main::locationExtractorsRA}
    $locationDirectory = undef; # Possibly set below; used by makeAbsolute.
    $status = open(PIPE, "@cmd 2>&1 |");
    if (defined $status and $status != 0) {
      my %isFile = ();
      my $origLine;
      L1: while (<PIPE>) {
        $origLine = $_;
        foreach my $locationEditor (@{$main::locationEditorsRA}) {
          # by default extracted filename exists as a real file,
          # but can be set to false by main::getLocation call:
          $locationFileExists = 1;
          # textual substitution happened?
          if ($locationEditor->()) {
            if ($locationFileExists) {
              print;
              next L1;
            } else {
              # file did not exist, so undo substitution
              $_ = $origLine;
            }
          }
        }
#        foreach my $locationExtractor (@{$main::locationExtractorsRA}) {
#          my $regexp = $locationExtractor->[0];
#          if (/$regexp/) {
#            my $file = ${$locationExtractor->[1]};
#            if ($isFile{$file} || ($isFile{$file} = (-f $file))) {
#              print $main::locationFormatterRS->(makeAbsolute($file), ${$locationExtractor->[2]}), "\n";
#              print;
#              next L1;
#            }
#          }
#        }

        # Check for patterns matching location directory, e.g. for SDE2 build_exe.pl script.
        foreach my $sub (@main::locationDirectoryExtractors) {
          my $dir = $sub->();
          if (defined $dir) {
            Msg->debug(2, "Match location directory: '$dir'");
            if (-d $dir) {
              $locationDirectory = $dir; # Used in makeAbsolute.
            }
          }
        }
        print;
      }
      close(PIPE); # or Msg->warn("$?: closing pipe from @cmd");
      $status = $?;
    } else {
      unless (defined $status) {
	Msg->error("Failed to start: @cmd\nDirectory was: " . getcwd());
        return -1;
      }
    }
  } else {
    $status = system(@cmd);
  }
  Msg->debug(1, "Returns $status: @cmd\n");
  if ($status != 0) {
    Msg->error("Returned $status: @cmd\nDirectory was: " . getcwd());
  }
  $status;
}

#-------------------------------------------------------------------------------
sub runSystemCmd {
  main::checkNumArgs(\@_, 1);
  my (@cmd) = @_;
  Msg->debug(0, "@cmd");
  if ($noexec) {
    return 0;
  }
  my $status = system(@cmd);
  Msg->debug(1, "Returns $status: @cmd\n");
  if ($status != 0) {
    Msg->error("Returned $status: @cmd\nDirectory was: " . getcwd());
  }
  $status;
}

#-------------------------------------------------------------------------------

=head2 main::getLocation

Usage: C<main::getLocation($absOrRelFileName, $lineNumber)>

Returns a string containing an absolute filename, and line number in that file.
This calls location formatter subroutine which combines 
the absolute file name and line number.
(This can be set by L<"BuildConfigFile::setLocationFormatter">.)
C<main::getLocation> should be used in the subroutine passed
to L<"BuildConfigFile::registerLocationEditor">
for changing the file/line location format of command output
(see L<"Running from within an editor or IDE">).

=cut

sub getLocation {
  my ($file, $lineNumber) = @_;
  my $absFile = makeAbsolute($file);
  $locationFileExists = -e $absFile;
  return $main::locationFormatterRS->($absFile, $lineNumber);
}

#-------------------------------------------------------------------------------

=head2 main::makeAbsolute

Usage: C<main::makeAbsolute($file)>

Returns an absolute filename.

=cut

sub makeAbsolute {
  my ($file) = @_;
  #print "makeAbsolute $file\n";
  if ($file !~ m{^(?:[/\\]|[a-zA-Z]:)}) {
    #print "makeAbsolute relative: $file\n";
    # relative path name:
    # if file already has forward slash, use that, otherwise use \ :
    my $sep = ($file =~ m{/} ? "/" : "\\");
    my $absFile = getcwd() . $sep . $file;
    # Does not exist, and $locationDirectory defined?
    if ((! -e $absFile) && (defined $locationDirectory)) {
      $absFile = $locationDirectory . $sep . $file;
      #print "makeAbsolute not exist, and locationDirectory=$locationDirectory: return $absFile\n";
    }
    return $absFile;
  }
  return $file;
}

#-------------------------------------------------------------------------------
# Send commands to the parent process to set/unset environment variables.
sub pipeEnvToParentProcess {
  main::checkNumArgs(\@_, 0, 0);
  my $var;
  # Unset any variables in the orig env, but not in the current one:
  foreach $var (sort(keys(%main::origENV))) {
    next if exists $main::keepENV{$var};
    unless (exists $ENV{$var}) {
      PipeCmd->unsetVar($var);
    }
  }

  # Set any variable that is different:
  foreach $var (sort(keys(%ENV))) {
    my $value = $ENV{$var};
    if ((!exists $main::origENV{$var}) || ($value ne $main::origENV{$var})) {
      PipeCmd->setVar($var, $value);
    }
  }
}

#-------------------------------------------------------------------------------

=head2 main::cd

Usage: C<main::cd($directory)>

=cut

sub cd {
  main::checkNumArgs(\@_, 1, 1);
  my ($dir) = @_;
  # For Windows, if the directory is e.g. Q:, then we need to make it Q:\ otherwise no cd is being done!
  $dir =~ s{^[a-zA-Z]:$}{$&/} if $^O eq 'MSWin32';
  #$dir =~ tr!/!\\!;
  Msg->debug(1, "cd \"$dir\"");
  unless (chdir($dir)) {
    Msg->fatal("$!: cannot cd to \"$dir\"");
  }
}

#-------------------------------------------------------------------------------

=head2 main::parentDir

Usage: C<main::parentDir($directory)>

Returns parent directory path.
Note that the result will not have a trailing / or \ and
will be an empty string if $directory did not have a parent directory.

=cut

sub parentDir {
  main::checkNumArgs(\@_, 1, 1);
  my ($dir) = @_;
  $dir =~ s![/\\]?[^/\\]*[/\\]?$!!;
  $dir;
}

#-------------------------------------------------------------------------------
sub rmDir {
  main::checkNumArgs(\@_, 1, 1);
  my ($dir) = @_;
  Msg->debug(0, "rmdir \"$dir\"");
  if ($noexec) {
    return 0;
  }
  unless (rmdir($dir)) {
    Msg->fatal("$!: cannot rmdir \"$dir\"");
  }
}

#-------------------------------------------------------------------------------
sub checkNumArgs {
  my ($argsRA, $minArgs, $maxArgs) = @_;
  if (scalar(@$argsRA) < $minArgs) {
    Msg->fatalCall(1, $argsRA, "too few arguments:\n" .
		   (((defined $maxArgs) && ($minArgs == $maxArgs)) ? "exactly" : "at least") .
		   " $minArgs expected.");
  }
  if ((defined $maxArgs) && (($maxArgs == -1) || (scalar(@$argsRA) > $maxArgs))) {
    Msg->fatalCall(1, $argsRA, "too many arguments:\nat most $maxArgs expected.");
  }
}

#-------------------------------------------------------------------------------

=head2 main::yesOrNo

Usage: C<main::yesOrNo($prompt, $default)>

Asks a yes/no question. If the user hits return, $default is returned
(should normally be 0 or 1).

=cut

sub main::yesOrNo {
  main::checkNumArgs(\@_, 1, 2);
  my ($prompt, $default) = @_;
  for (;;) {
    if (defined $default) {
      print "$prompt [", ($default ? "yes" : "no"), "]? ";
    } else {
      print "$prompt? ";
    }
    my $answer = <STDIN>;
    chomp $answer;
    return 1 if ($answer =~ /^\s*y(es)?\s*$/i);
    return 0 if ($answer =~ /^\s*no?\s*$/i);
    return $default if (defined $default) && ($answer =~ /^\s*$/);
    print "$answer not valid; please answer y|yes|n|no\n";
    return 1;
  }
}

#-------------------------------------------------------------------------------
sub main::canonPath {
  my ($p) = @_;
  $p =~ s!//+!/!g;      # // to /
  # If starts with / or \, prepend current drive:
  if (($^O eq 'MSWin32') && ($p =~ m!^[\\/]!)) {
    $p = "$curDrive:$p";
  }
  # If not absolute path, make absolute:
  if ($p !~ m!^([a-z]:|\\|/)!i) {
    $p =~ s!^(\./)*!$origCwd/!;  # ensure starts with current dir.
  }
  $p =~ s!//+!/!g;      # // to / again
  #$p =~ s/^([A-Z])/lc($1)/e; # lowercase
  $p =~ s!/$!!g;        # remove trailing /
  $p =~ s!/\.$!!g;      # remove trailing ./
  $p =~ s!/\./!/!g;     # remove embedded /./
  my $sep = ($^O eq 'MSWin32') ? '\\' : '/';
  $p =~ s!/!$sep!g;     # \ or / to proper separator
  $p;
}

#-------------------------------------------------------------------------------
sub main::doExit {
  main::checkNumArgs(\@_, 1, 1);
  my ($status) = @_;
  if ($Msg::warnings > 0) {
    print "Warnings: $Msg::warnings\n" unless $quiet;
  }
  if ($Msg::errors > 0) {
    print "Errors: $Msg::errors\n" unless $quiet;
    $status = 1 if $status == 0;
  }
  exit($status);
}

#-------------------------------------------------------------------------------
sub main::readEnvFile {
  main::checkNumArgs(\@_, 2, 3);
  my ($file, $envRH) = @_;
  unless (open(F, $file)) {
    Msg->error("$!: $file");
    return 0;
  }
  my ($var, $value);
  while (<F>) {
    chomp;
    if (/^([^=]+)=(.*)$/) {
      $envRH->{$1} = $2;
    } else {
      Msg->warn("$file:$.: line not in (set var=value) format:\n$_");
    }
  }
  close F;
  return $envRH;
}

#-------------------------------------------------------------------------------
sub main::overrideENV {
  my ($arg) = @_;
  my ($var, $type, $val) = $arg =~ /^([\w_]+)([-+]?)=(.*)/;
  if ($type eq '' && $val eq '') {
    Msg->debug(1, "Override: deleting env var $var");
    delete $ENV{$var};
  } else {
    $val = modifyENV($var, $type, $val) if $type ne '';
    Msg->debug(1, "Override: setting env var $var=$val");
    $ENV{$var} = $val;
  }
}

#-------------------------------------------------------------------------------
sub main::modifyENV {
  my ($var, $type, $val) = $arg =~ /^([\w_]+)([-+]?)=(.*)/;
  my $oldValue = (exists $ENV{$var}) ? $ENV{$var} : '';
  my $newValue;
  # Handle _TMDIVERSITY specially to prevent duplicate entries and underscores:
  if ($var eq '_TMDIVERSITY') {
    my @old = split /_+/, $oldValue;
    my %old = map {($_,1)} @old;
    my @addOrRemove = split /_+/, $val;
    my %addOrRemove = map {($_,1)} @addOrRemove;
    my @new;
    foreach my $old (@old) {
      next if $old eq '';
      if (exists $addOrRemove{$old}) {
	next if $type eq '-';
      }
      push @new, $old;
    }
    push @new, grep(!$old{$_}, @addOrRemove) if $type eq '+';
    $newValue = join '_', @new;
  } else {
    if ($type eq '+') {
      $newValue = $val . $oldValue;
    } else {
      $newValue = $oldValue;
      ($newValue =~ s/^\Q$val\E//) or
      ($newValue =~ s/\Q$val\E$//) or
      ($newValue =~ s/\Q$val\E//) or
      ( Msg->warn("Existing value of env var $var ($oldValue)\n  does not contain value to be removed ($val)") );
    }
  }
  $newValue;
}

################################################################################
package Msg;
################################################################################
BEGIN {
  $debug = ((@main::ARGV > 0) && $main::ARGV[0] =~ /^-d(\d+)$/) ? $1 : 0; # debug level
  $errors = 0; # count
  $warnings = 0; # count
}

sub Msg::warn {
  main::checkNumArgs(\@_, 2);
  shift @_;
  print "\nWarning: @_\n";
  $warnings++;
}

sub Msg::error {
  main::checkNumArgs(\@_, 2);
  shift @_;
  print "\n**ERROR: @_\n";
  $errors++;
}

=head2 Msg::buildError

Usage: C<Msg-E<gt>buildError(args...)>

Prints an error message; then exits the program
unless option -k or -K has been specified.
Args are passed to the Perl print subroutine.

=cut

sub Msg::buildError {
  my $this = shift @_;
  $this->fatalMaybe(($main::keepGoing || $main::alwaysExitOK), @_);
  if (($main::keepGoing || $main::alwaysExitOK) && !($main::lastBuild && $main::lastAction)) {
    print "(cbuild option -k or -K was specified, so continuing)\n" unless $main::quiet;
  }
}

=head2 Msg::fatal

Usage: C<Msg-E<gt>fatal(args...)>

Prints a fatal message  and exists the program.
Args are passed to the Perl print subroutine.

=cut

sub Msg::fatal {
  shift @_;
  print "\n**FATAL: @_\n";
  $errors++;
  main::doExit(1);
}

sub Msg::fatalMaybe {
  shift @_;
  my $isNotFatal = shift;
  print "\n**", ($isNotFatal ? "ERROR" : "FATAL"), ": @_\n";
  $errors++;
  main::doExit(1) unless $isNotFatal;
}

sub Msg::fatalCall {
  shift @_;
  my $callerLevel = shift;
  my $argsRA = shift;
  my @callerInfo = caller($callerLevel + 1);
  #my $pkg = $callerInfo[0];
  my $fileName = $callerInfo[1];
  my $lineNo = $callerInfo[2];
  my $funcName = $callerInfo[3];
  #$funcName =~ s/^\Q$pkg\E:://;
  Msg->fatal("$fileName:$lineNo:\n$funcName(" . join(", ", @$argsRA) . "): ", "\n@_", @_);
}

=head2 Msg::debug

Usage: C<Msg-E<gt>debug($level, args...)>

Prints a debug message if the debug level is >= $level. Args are passed to
the Perl print subroutine. If $level is 0, then the message is not printed
if the -q option was specified.

=cut

sub Msg::debug {
  main::checkNumArgs(\@_, 3);
  my ($class, $debugLevel, @args) = @_;
  if ($debug >= $debugLevel) {
    print "@args\n" unless $main::quiet && ($debugLevel == 0);
  }
}

sub Msg::debugEnabled {
  my ($class, $debugLevel) = @_;
  $debug >= $debugLevel;
}

################################################################################
package BuildConfigFile;
################################################################################

#BEGIN { Exporter::import(main::); }

=head2 BuildConfigFile::registerEnv

Usage: C<registerEnv($abbrevation, $name, $file)>

Registers an environment to be used for building.
On the C<cbuild> command line the abbreviation should be preceded by a ':'
to select this environment.

$file is a Perl syntax file which defines environment
variables for the environment.
See
L<"EnvDefFile::set">
L<"EnvDefFile::unset">
L<"EnvDefFile::querySet">
L<"EnvDefFile::load">
L<"EnvDefFile::setPrompt">
L<"EnvDefFile::setColor">

=cut

sub BuildConfigFile::registerEnv {
  main::checkNumArgs(\@_, 3, 3);
  my ($abbrev, $name, $file) = @_;
  my $env = EnvByPerl->new($abbrev, $name, $file);
  $env;
}

=head2 BuildConfigFile::registerEnvSet

Usage: C<registerEnvSet($abbrevation, $name, @envs)>

Registers the name for a set of environments to be used for building.
On the C<cbuild> command line the abbreviation should be preceded by a ':'
to select this environment.
See L<registerEnv|"BuildConfigFile::registerEnv">
and L<registerEnv|"BuildConfigFile::registerEnvByCmd">.

@envs is a list of abbreviations of previously defined environments.

Example:

  registerEnvSet("a", "trimedia_all", qw(td ta tr));

=cut

sub BuildConfigFile::registerEnvSet {
  main::checkNumArgs(\@_, 3);
  my ($abbrev, $name, @envs) = @_;
  my $env = EnvSet->new($abbrev, $name, @envs);
  $env;
}

=head2 BuildConfigFile::registerEnvByCmd

Usage: C<registerEnvByCmd($abbrevation, $name, $command, $directory)>

Registers an environment to be used for building.
On the C<cbuild> command line the abbreviation should be preceded by a ':'
to select this environment.

$command is a Unix/Windows command line, which when executed should print the required
set of environment variables for the environment to a file, which is given by %s in the command line.

$directory is the directory in which $command should execute.

Example of using a batch script in the SDE2 site directory:

    $siteDir = "$ENV{_TMROOT}/sde/sites/$ENV{_TMSITE}";
    registerEnvByCmd("mr", "mips_vxworks_eb_retail", "mips_vxworks_eb_retail.bat & (set >%s)", $siteDir);

=cut

sub BuildConfigFile::registerEnvByCmd {
  main::checkNumArgs(\@_, 4, 4);
  my ($abbrev, $name, $command, $directory) = @_;
  Msg->fatalCall(0, \@_, "Command should contain %s for filename to store environment variables.")
    unless $command =~ /%s/;
  my $env = EnvByCmd->new($abbrev, $name, $command, $directory);
  $env;
}

=head2 BuildConfigFile::registerDirectoryExtractor

Usage: C<registerDirectoryExtractor($subroutine, $testLine, $expectedDirectory)>

Registers a subroutine to be used for extracting the current location directory
from the output of a command. Example:

    # For SDE2 build_exe.pl:
    registerDirectoryExtractor(sub { /^Building: (.*?) for / ? $1 : undef; },
        'Building: q:/kernel/comps/tmbslCore for tm_psos_el_tm3260 with debug and _sp_pnx1500_noavbsl_',
        'q:/kernel/comps/tmbslCore');

The $testLine and $expectedDirectory arguments are used to test the directory extractor,
if option -d5 is given.

=cut

sub BuildConfigFile::registerDirectoryExtractor {
  main::checkNumArgs(\@_, 3, 3);
  my ($sub, $testLine, $expectedDirectory) = @_;
  push @main::locationDirectoryExtractors, $sub;
  if (Msg->debugEnabled(5)) {
    package main;
    $_ = $testLine;
    unless ($dir = $sub->()) {
      Msg->fatalCall(0, \@_, "Extraction sub does not succeed:\n$testLine\n");
    }
    if ($dir eq $expectedDirectory) {
      Msg->debug(5, "Extraction sub succeeds => $expectedDirectory: $testLine\n");
    } else {
      Msg->fatalCall(0, \@_, "Extraction sub succeeds but extracted directory is incorrect:\n$testLine\nExpected directory: \"$expectedDirectory\"\nExtracted directory: \"$dir\"\n");
    }
  }
}

=head2 BuildConfigFile::registerLocationEditor

Usage: C<registerLocationEditor($subroutine, $substitutionExpression
$testLine, $expectedLine)>

Registers a subroutine to be used for changing the file/line location
format of the output of a command (stored in $_). The subroutine should
call L<"main::getLocation"> to obtain the standardized file/line location format.
See also L<"BuildConfigFile::setLocationFormatter">.
Example:

    # GNU CC output:
    registerLocationEditor(sub { s/^(.*?):(\d+):/main::getLocation($1, $2)/e; },
      "t:/cex/comps/tmMUti/src/tmMUti_Vec.c:76: parse error before `tmMUti_VecCreate'\n",
      "\"t:/cex/comps/tmMUti/src/tmMUti_Vec.c\", line 76: parse error before `tmMUti_VecCreate'\n");

    # QMore output:
    registerLocationEditor(sub { s/^(.*)file - +([^ ]+) (.*?) ?at line:(\d+)/main::getLocation($2, $4) . " $&"/e; },
      "ERROR file - T:/cex/comps/tmMUti/src/tmMUti_CmdLocal.h Does not match _(tmMUti)_<Word>+_t at line:77 ...\n",
      "\"T:/cex/comps/tmMUti/src/tmMUti_CmdLocal.h\", line 77: ERROR file - T:/cex/comps/tmMUti/src/tmMUti_CmdLocal.h Does not match _(tmMUti)_<Word>+_t at line:77 ...\n");


The $testLine and $expectedLine arguments are used to test the location editor,
if option -d5 is given.

=cut

sub BuildConfigFile::registerLocationEditor {
  main::checkNumArgs(\@_, 3, 3);
  my ($substitutionExpression, $testLine, $expectedLine) = @_;
  push @{$main::locationEditorsRA}, $substitutionExpression;
  if (Msg->debugEnabled(5)) {
    package main;
    $_ = $testLine;
    unless ($substitutionExpression->()) {
      Msg->fatalCall(0, \@], "Testline does not match regular expression:\n$testLine\n");
    }
    Msg->debug(5, "Testline matches: $testLine\nNew line = $_\n");
    if ($_ ne $expectedLine) {
      Msg->fatalCall(0, \@_, "Testline matches regular expression but resultant line not as expected:\n$testLine\nExpected line: $expectedLine\nActual line  : $_\n");
    }
  }
}

=head2 BuildConfigFile::setLocationFormatter

Usage: C<setLocationFormatter($subroutine)>

Registers a subroutine to return a line with the extracted file/line location
to be printed to stdout. The subroutine will be called as follows:
    C<$main::locationFormatterRS-E<gt>($absoluteFileName, $lineNumber)>

See also L<"BuildConfigFile::registerLocationEditor">. The standard inbuilt location formatter
is:

    setLocationFormatter(sub { "\"$_[0]\", line $_[1]:"; });

=cut

sub BuildConfigFile::setLocationFormatter {
  main::checkNumArgs(\@_, 1, 1);
  $main::locationFormatterRS = shift;
}

=head2 BuildConfigFile::load

Usage: C<load($fileName)>

Loads another Perl file. The location is relative to the current file.
Absolute path names can be used.
Used in the cbuildconfig.pl and environment definition files
(see L<"Configuring the tool">).

=cut

sub BuildConfigFile::load {
  main::checkNumArgs(\@_, 1, 1);
  my ($file) = @_;
  main::lookupAndLoadFile($file, sub { package BuildConfigFile; do $_[0]}, @main::LOADPATH);
}

################################################################################
package EnvDefFile;
################################################################################

local $_env;

# Usage EnvDefFile->_init(an Env)
sub EnvDefFile::_init {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $env) = @_;
  %EnvDefFile:: = %main::EnvDefFileClean;
  %ENV = %main::baseENV;
  $_env = $env;
}

=head2 EnvDefFile::set

Sets an environment variable to a value.

Usage: C<set($var, $value);>

Example:

    set('_TMTGTREL', 'retail');

=cut

sub EnvDefFile::set {
  main::checkNumArgs(\@_, 2, 2);
  my ($var, $value) = @_;
  $value = Var->expand($var, $value);
  $ENV{$var} = $value;
}

=head2 EnvDefFile::unset

Unsets an environment variable.

Usage: C<unset($var);>

Example:

    unset('MTV_DEBUG');

=cut

sub EnvDefFile::unset {
  main::checkNumArgs(\@_, 1, 1);
  my ($var) = @_;
  delete $ENV{$var};
}

=head2 EnvDefFile::querySet

Optionally sets an environment variable.
It will prompt the user only if the variable is already set to a different value.
Otherwise it will set the variable without prompting.

Usage: C<querySet($var, $value);>

Example:

    querySet('_TMTGTBUILDROOT', '$ENV{_TMROOT}/release');

=cut


sub EnvDefFile::querySet {
  main::checkNumArgs(\@_, 2, 2);
  my ($var, $value) = @_;
  $value = Var->expand($var, $value);
  if (exists $ENV{$var} && ($ENV{$var} ne $value)) {
    print "\nOld value: $var=$ENV{$var}\n";
    print "New value: $var=$value\n";
    return $ENV{$var} unless main::yesOrNo("Use New value?", 1);
  }
  $ENV{$var} = $value;
}

=head2 EnvDefFile::queryUnset

Optionally unsets an environment variable.
It will prompt the user only if the variable is currently set.

Usage: C<queryUnset($var);>

Example:

    queryUnset('MTV_DEBUG');

=cut


sub EnvDefFile::queryUnset {
  main::checkNumArgs(\@_, 1, 1);
  my ($var) = @_;
  if (exists $ENV{$var}) {
    print "\nCurrently set: $var=$ENV{$var}\n";
    delete $ENV{$var} if main::yesOrNo("Unset variable?", 1);
  }
}

=head2 EnvDefFile::setPrompt

Sets the command line prompt (Windows/MSDOS only).

Usage: C<setPrompt($prompt);>

Example:

    setPrompt('TM_PSOS_EB_ASSERT $P$G');

=cut

sub EnvDefFile::setPrompt {
  main::checkNumArgs(\@_, 1, 1);
  $_env->setPrompt(@_);
}

=head2 EnvDefFile::setColor

Sets the forground color of the terminal (Windows/MSDOS only).

Usage: C<setColor($color);>

Example:

    setColor('0D');

=cut

sub EnvDefFile::setColor {
  main::checkNumArgs(\@_, 1, 1);
  $_env->setColor(@_);
}

=head2 EnvDefFile::load

Loads another Perl file. If the filename cannot be read as is,
relative to the working direcory of the tool, then ...

Usage: C<load($file);>

Example:

    load('tm_psos.el');

=cut

sub EnvDefFile::load {
  main::checkNumArgs(\@_, 1, 1);
  my ($file) = @_;
  main::lookupAndLoadFile($file, sub { package EnvDefFile; do $_[0]}, @main::LOADPATH);
}

BEGIN {
  # Basic clean enviroment. This Perl module then only contains
  # the basic vars and functions of this module.
  # Used in EnvDefFile->_init().
  %main::EnvDefFileClean = %EnvDefFile::;
}

################################################################################
package Env;
################################################################################

sub Env::registerEnvUserDefined {
  main::checkNumArgs(\@_, 3, 3);
  my $env = BuildConfigFile::registerEnv(@_);
  delete $env->{'preDefined'};
  $env;
}

# Return an expanded list of Env's (useful if the Env is an abbreviation for a set of Env's.)
sub Env::expand {
  main::checkNumArgs(\@_, 1, 1);
  @_;
}
  
sub Env::exists {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $name) = @_;
  exists $envs{$name};
}

sub Env::get {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $name) = @_;
  $envs{$name};
}

sub Env::name {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'name'};
}

sub Env::abbrev {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'abbrev'};
}

sub Env::file {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'file'};
}

sub Env::preDefined() {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  exists $this->{'preDefined'};
}

sub Env::new {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $abbrev, $name) = @_;
  if (Env->exists($abbrev)) {
    Msg->error("Duplicate definition of environment \"$abbrev\"");
    return undef;
  }
  if (Env->exists($name)) {
    Msg->error("Duplicate definition of environment \"$name\"");
    return undef;
  }
  my $this= {'abbrev'=>$abbrev, 'name'=>$name, 'file'=>$file, 'preDefined'=> 1};
  bless $this, $class;
  $Env::envs{$name} = $Env::envs{$abbrev} = $this;
  push @Env::envFullNames, $name;
  push @Env::envNames, $name;
  push @Env::envNames, $abbrev if $abbrev ne $name;
  $this;
}

sub Env::setup {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  # reduce verbosity: only print message if env name differs from last:
  if ($lastEnvSet ne $this->name()) {
    Msg->debug(0, "\n# Setting environment :".
	       $this->abbrev() . " " .
	       $this->name());
  }
  unless (exists $this->{'ENV'}) {
    $this->setup1();
    # env now defined, store it for future uses:
    $this->{'ENV'} = {%ENV};
  }
  %ENV = %{$this->{'ENV'}};
  map main::overrideENV($_), @main::overrideENV;
  $ENV{'_TMTGTBUILDROOT'} = $main::buildroot if defined $main::buildroot;
  printEnv() if $main::printEnv;
  $lastEnvSet = $this->name();
}

sub Env::printEnv {
  main::checkNumArgs(\@_, 0, 0);
  my $var;
  foreach $var (sort(keys(%ENV))) {
    print $var, "=", $ENV{$var}, "\n";
  }
}

sub setPrompt {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $prompt) = @_;
  $this->{'prompt'} = $prompt;
}

sub setColor {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $color) = @_;
  $this->{'color'} = $color;
}

sub info {
  "";
}

BEGIN {
  @envFullNames = ();
  @envNames = ();
  %envs = ();
  # predefined environment 'base'
  my $env = Env->new('base', 'base');
  $env->{'ENV'} = %{%main::baseENV};
  $lastEnvSet = "";
}

################################################################################
package EnvByPerl;
################################################################################
BEGIN { @ISA = qw(Env); }

sub EnvByPerl::new {
  main::checkNumArgs(\@_, 4, 4);
  my ($class, $abbrev, $name, $file) = @_;
  my $this = $class->SUPER::new($abbrev, $name);
  return undef unless defined $this;
  $this->{'file'} = $file;
  $this;
}


sub EnvByPerl::info {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $info = "File: $this->{'file'}";
  my $resolvedFile;
  if (defined ($resolvedFile = $this->{'resolvedFile'})) {
    $info .= " => $resolvedFile";
  }
  $info;
}

sub EnvByPerl::setup1 {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $resolvedFile;
  my $file = $this->{'file'};
  unless (defined ($resolvedFile = $this->{'resolvedFile'})) {
    $resolvedFile = $this->{'resolvedFile'} = main::lookupFile($file, @main::LOADPATH) || $file;
  }
  EnvDefFile->_init($this);
  Msg->debug(1, "Loading file: " . $resolvedFile);
  { package EnvDefFile;
    EnvDefFile::load($resolvedFile);
    if ($@) {
      Msg->fatal($@, "while loading file", $resolvedFile);
    }
  }
  if (exists $this->{'prompt'}) {
    PipeCmd->setPrompt($this->{'prompt'});
  }
  if (exists $this->{'color'}) {
    PipeCmd->setColor($this->{'color'});
  }
}

################################################################################
package EnvSet;
################################################################################
BEGIN { @ISA = qw(Env); }

# Set of previously defined environments.
sub EnvSet::new {
  main::checkNumArgs(\@_, 4);
  my ($class, $abbrev, $name, @envs) = @_;
  my $this = $class->SUPER::new($abbrev, $name);
  return undef unless defined $this;
  my $envsRA = [];
  foreach (@envs) {
    $envRef = Env->get($_);
    Msg->fatalCall(2, \@_, "Reference to undefined environment $_ in environment set $abbrev, $name") unless defined $envRef;
    push @{$envsRA}, $envRef;
  }
  $this->{'info'} = "Environment set (@envs)";
  $this->{'envsRA'} = $envsRA;
  $this;
}


sub EnvSet::info {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'info'};
}


sub EnvSet::expand {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  @{$this->{'envsRA'}};
}

################################################################################
package EnvByCmd;
################################################################################
BEGIN { @ISA = qw(Env); }

sub EnvByCmd::new {
  main::checkNumArgs(\@_, 5, 5);
  my ($class, $abbrev, $name, $command, $directory) = @_;
  my $this = $class->SUPER::new($abbrev, $name);
  return undef unless defined $this;
  $this->{'command'} = $command;
  $this->{'directory'} = $directory;
  $this;
}

sub EnvByCmd::info {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $info = "Command: $this->{'command'} in directory: $this->{'directory'}";
  $info;
}

sub EnvByCmd::setup1 {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $tmpFile = "$main::TMP/cbuild.env.$main::USER.$$";
  my $cmd = $this->{'command'};
  $cmd =~ s/%s/$tmpFile/g;
  unlink $tmpFile;
  Msg->debug(1, "Executing: $cmd in directory ($this->{directory})");
  # move to specified directory for executing command:
  my $cwd = Cwd::getcwd();
  main::cd($this->{'directory'});
  my $ret = main::runSystemCmd($cmd);
  main::cd($cwd);
  if ($ret != 0) {
    Msg->fatal("$cmd in directory ($this->{directory}) returns $ret\nCheck $tmpFile") if $ret != 0;
  }

  # read temp file:
  unless ($main::noexec) {
    my %env;
    unless (main::readEnvFile($tmpFile, \%env)) {
      Msg->fatal("Executing command ($cmd) did not create file $tmpFile\nCannot setup environment $this->{name}");
    }
    %ENV = %env;
  }
  unlink $tmpFile;
}

################################################################################
package Option;
################################################################################

=head2 Option Class

A new Option instance will create a new command line option.
When this option is encountered, the option parser subroutine
will be executed immediately.

When this command line option is encountered, the option parser routine
for this Action will be executed immediately. By default this routine just sets the 'selected'
field in the Action (See L<"Option::selected"> and L<"Option::setSelected">)

An action, when selected, will execute the action Perl subroutine for
every CI to be built. The following are useful to configure
an Action instance:

- L<setUsage|"Option::setUsage"> - defines help text to print if the user
types C<cbuild> -h

- L<setOptionParser|"Option::setOptionParser"> - defines a subroutine to run when
this option is encountered on the command line.
Required if the command line option has a value.

Template for an Option definition:

    $o = Option->new($name, $cmdLineOption);
    $o->setUsage("$cmdLineOption ...", "... usage description...");
    $o->setOptionParser(
      sub {
        my ($option, $cmdLineOption) = @_;
        ...
      }
    );

The code to execute can set a global variable, or put some data into an Action definition,
for example:

    Action->getByName('lint')->{'level') = main::nextArg($cmdLineOption);

Example:

    $a = Action->new("lint", "-lint");
    $a->setUsage("-lint", "Run lint.bat on CI");
    $a->setAction(
      sub {
        my ($action, $buildEntry) = @_;
        my $status;
        if (($status = main::runCmd("lint.bat", ".")) != 0) {
          Msg->buildError("lint returned error code $status");
        }
        return 1;
      }
    );

The option parser or action subroutines can access any action object via
Option-E<gt>L<getByName|"Option::getByName">($name). The returned object is a hash reference.
Note that the subroutines already receive the current Action or Option object reference.
Other useful functions:

- L<"Option::getByOption"> - returns the object defined with the specified option.

=cut

BEGIN {
  %option2instance = ();
  %name2instance = ();
  @options = ();
}

=head2 Option::new

Usage: C<Option-E<gt>new($name, $cmdLineOption)>

Creates a new L<"Option Class"> instance.

=cut

sub Option::new {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $name, $cmdLineOption) = @_;
  Msg->debug(4, ref($class) . "->new: \"$name\": \"$cmdLineOption\".");
  my $this = {'name'=>$name, 'option'=>$cmdLineOption, 'selected'=>0};
  push @options, $this;
  if (grep {$_ eq $cmdLineOption} @main::options) {
    Msg->fatal(ref($class) . " \"$name\": Option name \"$cmdLineOption\" is already in use.");
  }
  if (defined Option->getByName($name)) {
    Msg->fatal(ref($class) . " \"$name\": name is already in use.");
  }
  $option2instance{$cmdLineOption} = $this;
  $name2instance{$name} = $this;
  push @main::options, $cmdLineOption;
  bless $this, $class;
}

=head2 Option::setUsage

Usage: C<$option-E<gt>setUsage($format, $helpString)>

Records usage info to be printed by the -h option. $format is a string
indicating the option to use and any required arguments to be parsed by the option
(see L<"Option::setOptionParser">).
For example:

    $option->setUsage("-qlevel <level>", "Runs the Q tool, at level <level>");

=cut

sub Option::setUsage {
  main::checkNumArgs(\@_, 3, 3);
  my ($this, $syntax, $help) = @_;
#  my $indent = " " x 24;
#  $help =~ s/\n(?!$)/$indent\n/gms;
  $this->{'help'} = sprintf("%-23s %s", $syntax, $help);
  $this;
}

=head2 Option::setOptionParser

Usage: C<$option-E<gt>setOptionParser($subroutineRef)>

$subroutineRef will be invoked with arguments $option and $cmdLineOption.
This is not required for simple boolean yes/no options, because it will set the
Option as 'selected' (see L<"Option::selected"> and L<"Option::setSelected">).

C<setOptionParser> must be used if the option has a value.
Use L<"main::nextArg"> and L<"main::argsUntil"> to get command line arguments.
For example, if there is one value following the Option option:

  $a->setUsage("-lint <level>", "Run lint.bat on CI, with the specified level (1-3)");
  $a->setOptionParser(
    sub {
      my ($option, $cmdLineOption) = @_;
      push $option->{'level'}}, main::nextArg($cmdLineOption);
    }
  );

=cut

sub Option::setOptionParser {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $optionParserRS) = @_;
  $this->{'optionParserRS'} = $optionParserRS;
  $this;
}

=head2 Option::selected

Usage: C<$option-E<gt>selected()>

Returns true if the option has been selected
(see L<"Option::setSelected"> and L<"Option::setOptionParser">).

=cut

sub Option::selected {
  main::checkNumArgs(\@_, 1, 1);
  $_[0]->{'selected'};
}

=head2 Option::setSelected

Usage: C<$option-E<gt>setSelected($bool)>

Defines whether the option is selected or not.
An Option is by default selected when its option is used on the command line
so normally this subroutine is not needed
(see L<"Option::selected"> and L<"Option::setOptionParser">).

=cut

sub Option::setSelected {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $selected) = @_;
  $this->{'selected'} = $selected;
}

=head2 Option::getByName

Usage: C<Option-E<gt>getByName($name)>

Returns the object defined with the specified name
or undef if no such object.

=cut

sub Option::getByName {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $name) = @_;
  $name2instance{$name};
}

=head2 Option::getByOption

Usage: C<Option-E<gt>getByOption($cmdLineOption)>

Returns the object defined with the specified option
or undef if no such object.

=cut

sub Option::getByOption {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $cmdLineOption) = @_;
  $option2instance{$cmdLineOption};
}

################################################################################
package Action;
################################################################################

=head2 Action Class

Usage: C<Action-E<gt>new($name, $cmdLineOption)>

A new Action instance will create a new command line option
to indicate actions to perform on an CI.
The Action class inherits from the L<Option|"Option Class"> class,
but has in addition a L<setAction|"Action::setAction"> function.

An action, when selected, will execute the action subroutine for
every CI to be built. The following are useful to configure
an Action instance:

- L<Action|"Action::setAction"> - defines a subroutine to run
for every CI to build, if the Action is specified on the command line.

Example:

    $a = Action->new("lint", "-lint");
    $a->setUsage("-lint", "Run lint.bat on CI");
    $a->setAction(
      sub {
        my ($action, $buildEntry) = @_;
        my $status;
        if (($status = main::runCmd("lint.bat", ".")) != 0) {
          Msg->buildError("lint returned error code $status");
        }
        return 1;
      }
    );

The option parser or action subroutines can access any Action or Option object via
$action-E<gt>L<getByName|"Option::getByName">($name).
Note that the subroutines receive the current Action or Option object reference.

Within the action subroutine, one can examine the following variables:

  $main::firstBuild:  is 1 if we are building the first CI the very first time.
  $main::firstCI:     is 1 if we are building the first CI (regardless of configurations).
  $main::lastCI:      is 1 if we are building the last CI (regardless of configurations).
  $main::lastBuild:   is 1 if we are building the last CI for the very last time.
  $main::firstAction: is 1 if we are executing the first action for a CI-configuration.
  $main::lastAction:  is 1 if we are executing the last action for a CI-configuration.

=cut

BEGIN {
  @ISA = qw(Option);
  @actions = ();
}

=head2 Action::new

Usage: C<Action-E<gt>new($name, $cmdLineOption)>

Creates a new Action instance.

=cut

sub Action::new {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $name, $cmdLineOption) = @_;
  my $this = $class->SUPER::new($name, $cmdLineOption);
  push @actions, $this;
  $this;
}

=head2 Action::setAction

Usage: C<$action-E<gt>setAction($subroutineRef)>

$subroutineRef will be invoked for every CI and configuration combination
specified on the command line.
Arguments to the subroutine will be $action and $buildEntry (See L<"BuildEntry Class">).
The current directory is set to that of the CI.
See L<"main::runCmd"> for invoking processes.

=cut

sub Action::setAction {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $actionRS) = @_;
  $this->{'actionRS'} = $actionRS;
  $this;
}

# Returns true if action does something useful.
sub Action::run {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $buildEntry) = @_;
  if (defined $this->{'actionRS'}) {
    Msg->debug(1, "Running the '$this->{name}' action (option '$this->{option}')...");
    Msg->debug(2, <<"EOS");
\$main::firstAction = $main::firstAction
\$main::lastAction  = $main::lastAction
EOS
    return $this->{'actionRS'}->($this, $buildEntry);
  } else {
    return 0;
  }
}

# Returns the Action's that were selected by command line options
# by the user.
sub Action::getSelected {
  unless (defined @selectedActions) {
    @selectedActions = grep {$_->selected()} @actions;
    push @selectedActions, $defaultAction unless @selectedActions;
  }
  @selectedActions;
}

################################################################################
# Standard Actions
################################################################################

sub main::registerStandardActions {
  my $a;

  #
  # MAKE CLEAN
  #
  $a = Action->new('makeclean', '-c');
  $a->setUsage("-c", "Run \$(MAKE) clean on CI. (Can be used with -m)");
  $a->setAction(
    sub {
      my ($action, $buildEntry) = @_;
      Msg->debug(1, "Doing make clean on CI", $buildEntry->ciName());
      $buildEntry->runMake(qw(clean));
      return 1;
    }
  );

  #
  # MAKE
  # cd's to CI; runs $(MAKE) with default arguments specified
  # by the command line.
  #
  $a = Action->new('make', '-m');
  $a->setUsage("-m", "Run \$(MAKE) on CI.");
  $a->setAction(
    sub {
      my ($action, $buildEntry) = @_;
      $buildEntry->runMake(@{$action->{'args'}});
      return 1;
    }
  );
  $Action::defaultAction = $a;

  $a = Option->new('makeArgs', '-M');
  $a->setUsage("-M <arg>... --", "Define arguments to pass to \$(MAKE).");
  $a->setOptionParser(
    sub {
      my ($action, $cmdLineOption) = @_;
      push @{Action->getByName('make')->{'args'}}, main::argsUntil($cmdLineOption, "--");
    }
  );

  $a = Option->new('makeGoal', '-g');
  $a->setUsage("-g <goal>", "Define <goal> to pass to make.");
  $a->setOptionParser(
    sub {
      my ($action, $cmdLineOption) = @_;
      push @{Action->getByName('make')->{'args'}}, main::nextArg($cmdLineOption);
    }
  );

  #
  # QAC
  # cd's to CI; runs $(MAKE) qac
  # by the command line.
  #
  $a = Action->new('QAC', '-qac');
  $a->setUsage("-qac", "Run \$(MAKE) qac on CI.");
  $a->setAction(
    sub {
      my ($action, $buildEntry) = @_;
      $buildEntry->runMake(qw(qac));
      return 1;
    }
  );

  #
  # Qmore
  #
  $a = Action->new('Qmore', '-qm');
  $a->setUsage("-qm", "Run Qmore on CI. (Use -qmk to also keep Qmore results directory)");
  $a->setAction(\&runQmore);
    sub runQmore {
      my ($action, $buildEntry) = @_;
      # We go up one directory, since QMore prints errors as if sitting inside the
      # parent directory of the CI (sigh!):
      chdir("..");
      my $status;
      if (($status = main::runCmd("qmore", "-d", $buildEntry->dir())) != 0) {
	Msg->buildError("qmore returned error code $status");
      }
      unless (exists $action->{'keepQmoreResultsDir'}) {
        # Remove the status directory. Removed in two steps,
        # to ensure we don't by accident throw non-Qmore stuff away in the status directory.
        my $qmoreStatusDir = $buildEntry->dir() . "/status";
        if (-d "$qmoreStatusDir/run_dir") {
          # Removed in two steps, to ensure we do not by accident throw
          # non-Qmore stuff away in the status directory.
          main::runCmd("rm -rf $qmoreStatusDir/run_dir");
          main::rmDir($qmoreStatusDir);
        }
      }
      return 1;
    }

  $a = Action->new('QmoreKeepResults', '-qmk');
  $a->setUsage("-qmk", "Run Qmore on CI, keeping Qmore results directory.");
  $a->setOptionParser(
    sub {
      my ($action, $cmdLineOption) = @_;
      $action->{'keepQmoreResultsDir'} = 1;
    }
  );
  $a->setAction(\&runQmore);

  #
  # Recursive build
  #
  $a = Action->new('recursiveBuild', '-r');
  $a->setUsage("-r", "Do recursive build for CI.");
  # Optional, if the option is just a boolean yes no switch.
  $a->setAction(
    sub {
      my ($action, $buildEntry) = @_;
      my $status;
      if (($status = main::runCmd("perl", "$main::_TMROOT/sde/scripts/build_exe.pl", $buildEntry->dir(),
				  @{$action->{'args'}})) != 0) {
	Msg->buildError("build_exe.pl returned error code $status");
      }
      return 1;
    }
  );

  $a = Option->new('recursiveBuildArgs', '-B');
  $a->setUsage("-B <arg>... --", "Define arguments to pass to recursive build.");
  $a->setOptionParser(
    sub {
      my ($action, $cmdLineOption) = @_;
      push @{Action->getByName('recursiveBuild')->{'args'}}, main::argsUntil($cmdLineOption, "--");
    }
  );

}

################################################################################
package Var;
################################################################################

BEGIN {
  %Var::dontExpandVar = ('PROMPT'=>1); # Windows PROMPT.
}

sub Var::value {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'value'};
}

sub Var::set {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $newValue) = @_;
  $this->{'value'} = $newValue;
}

sub Var::defd {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  exists $this->{'value'};
}

# Usage: Var->expand($var, $string)
# expands environment variable references in the form $XXX and %XXX%
# No expansion occurs if $var is a key in %Var::dontExpandVar hash.
sub Var::expand {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $var, $str) = @_;
  return $str if exists $dontExpandVar{$var};
  my $origStr = $str;
  my $splitRx = '(\$\w+|[^\$]+)';
  # split into bits with/without variable refs:
  my @stack = $str =~ /$splitRx/go;
  my @result;
  #Msg->debug(3, "$var: \"$str\" expanding..."); map {print "$_ ...\n"} @stack;
  while (@stack) {
    my $x = shift @stack;
    if ($x =~ /^\$(\w+)$/) {
      my $varRef = $1;
      my $val = $ENV{$varRef};
      if (defined $val) {
        Msg->debug(4, "$var: Expanding $& in $str to $val");
        unshift @stack, ($val =~ /$splitRx/go);
        next;
      } else {
        Msg->warn("$var: Undefined env var referenced: \"$varRef\"") if Msg->debugEnabled(1);
      }
    }
    push @result, $x;
  }
  $str = join "", @result;
  if ($origStr ne $str) {
    Msg->debug(3, "$var: \"$origStr\" expanded to \"$str\"");
  }
  $str;
}

################################################################################
package PATH;
################################################################################

BEGIN {
  @ISA = qw(Var);
  $sep = $^O eq 'MSWin32' ? ";" : ":";
}

sub PATH::prepend {
  main::checkNumArgs(\@_, 1, 1);
  varPrepend('PATH', @_);
}

sub PATH::varPrepend {
  main::checkNumArgs(\@_, 2, 2);
  my ($var, $dir) = @_;
  $ENV{$var} = exists($ENV{$var}) ? clean($dir . $sep . $ENV{$var}) : $dir;
}

sub PATH::append {
  main::checkNumArgs(\@_, 1, 1);
  varAppend('PATH', @_);
}

sub PATH::varAppend {
  main::checkNumArgs(\@_, 2, 2);
  my ($var, $dir) = @_;
  $ENV{$var} = exists($ENV{$var}) ? clean($ENV{$var} . $sep . $dir) : $dir;
}

sub PATH::split {
  main::checkNumArgs(\@_, 1, 1);
  my ($s) = @_;
  return split($sep, $s);
}

sub PATH::clean {
  main::checkNumArgs(\@_, 1, 1);
  my ($s) = @_;
  my @paths = split($sep, $s);
  my %done;
  join($sep, grep({my $a = $_; $a =~ s{\\}{/}g; {(++$done{$a}) == 1}} @paths));
}

################################################################################
package BuildEntry;
################################################################################

=head2 BuildEntry Class

An object representing an CI to be built. Has the following methods:

L<"BuildEntry::ciName">

L<"BuildEntry::dir">

=cut

# Usage BuildEntry->new($ciName, $env)
# $env can be undef, in case the current environment should be used.
sub BuildEntry::new {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $name, $env) = @_;
  my $ci = Projects->ciLookup($name);
  my $dir;
  if (defined $ci) {
    $dir = $ci->{'dir'};
    $name = $ci->{'name'};
  } else {
    # see if it is a directory reachable from here:
    $dir = main::canonPath($name);
    if (CI::maybeCIDirectory($dir)) {
      $name = $dir;
    } else {
      # See if the first part of $name is a CI:
      my ($ciName, $subDir) = ($name =~ m!^([^/\\]+)([/\\].*)$!);
      unless (defined $subDir and (defined ($ci = Projects->ciLookup($ciName))) and CI::maybeCIDirectory($dir = main::canonPath($ci->{'dir'} . $subDir))) {
        Msg->fatalMaybe($main::ignoreNotCI, "Not a CI: \"$name\". Wrong name, directory path,\nor missing a makefile or inc/ in CI.");
      }
    }
  }
  BuildEntry->new1($name, $env, $dir);
}

# Usage BuildEntry->new($ciName, $env, $dir)
# $env can be undef, in case the current environment should be used.
sub BuildEntry::new1 {
  main::checkNumArgs(\@_, 4, 4);
  my ($class, $name, $env, $dir) = @_;
  my ($this) = {'name'=>$name, 'env'=>$env, 'dir'=>$dir};
  bless $this, $class;
  Msg->debug(5, "BuildEntry::new1 ($name) dir($dir) env(" . 
             ((defined $env) ? $env->name() : "<unspecified>") .")");
  $this;
}

=head2 BuildEntry::ciName

Usage: C<$buildEntry-E<gt>ciName()>

Returns the name of the CI.

=cut

# Usage: $this->ciName()
sub BuildEntry::ciName {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'name'};
}

# Usage: $this->specifiedEnv()
# Returns env field.
sub BuildEntry::specifiedEnv {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'env'};
}

=head2 BuildEntry::dir

Usage: C<$buildEntry-E<gt>dir()>

Returns directory of the CI.
Issues fatal error if non-existing.

=cut

sub BuildEntry::dir {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->{'dir'};
}

# Usage: $this->cd()
# Changes directory to the directory of the CI.
sub BuildEntry::cd {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $name = $this->{'name'};
  my $dir = $this->dir();
  Msg->debug(0, "\n## Selecting CI $name: \"$dir\"");
  main::cd($dir);
}

#-------------------------------------------------------------------------------
# Usage: $this->setupAndBuild().
# Cycles over all required environments, and performs build of CI.
# Checks $main::extendedCommandLine, if set then if a CI has no specified
# environment it will not use the @BuildList::globalEnvs.
sub BuildEntry::setupAndBuild {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  my $specifiedEnv = $this->specifiedEnv();
  my (@envs, $env);
  # Determine environments for this BuildEntry:
  if (defined $specifiedEnv) {
    push @envs, $specifiedEnv;
  } else {
    push @envs, @BuildList::globalEnvs unless $main::extendedCommandLine;
    @envs = (undef) unless @envs;
  }
  # Now do env setups and builds:
  foreach my $i (0..$#envs) {
    my $env = $envs[$i];
    $main::lastBuild = ($main::lastCI && $i == $#envs) ? 1 : 0;
    $this->setupEnv($env) if defined $env;
    $this->build();
    $main::firstBuild = 0;
  }
}

#-------------------------------------------------------------------------------
# Usage: $this->setupEnv($env).
# $env is a Env instance.
sub BuildEntry::setupEnv {
  main::checkNumArgs(\@_, 2, 2);
  my ($this, $env) = @_;
  $env->setup();
}

#-------------------------------------------------------------------------------
# Usage: $this->build($this).
sub BuildEntry::build {
  main::checkNumArgs(\@_, 1, 1);
  my ($this) = @_;
  $this->cd();
  my $somethingDone = 0;
  my $action;
  Msg->debug(2, <<"EOS");
\$main::firstCI     = $main::firstCI
\$main::firstBuild  = $main::firstBuild
\$main::lastCI      = $main::lastCI
\$main::lastBuild   = $main::lastBuild
EOS
  $main::firstAction = 1;
  my @selectedActions = Action::getSelected();
  foreach $i (0..$#selectedActions) {
    my $action = $selectedActions[$i];
    $main::lastAction = ($i == $#selectedActions) ? 1 : 0;
    $action->run($this);
    $main::firstAction = 0;
  }
}

#-------------------------------------------------------------------------------
# cd's to CI; runs make with specified arguments.
sub BuildEntry::runMake {
  main::checkNumArgs(\@_, 1);
  my ($this, @makeArgs) = @_;
  my $make = $main::ENV{'MAKE'} || "gmake";
  my $status;
  #main::runCmd("ls");
  if (($status = main::runCmd($make, @main::defMakeOpts, @makeArgs)) != 0) {
    Msg->buildError("make returned error code $status");
  }
}

################################################################################
package BuildList;
################################################################################
BEGIN {
  @entries = ();
  $nextEntry = 0; # for next, moreEntries
  $globalEnvsUsed = 1;
  @globalEnvs = ();
  $ciIdx = 0; # incr for every ci
}

# Usage: BuildList->process();
# Sets $main::firstCI to 1 if we are building the first CI (regardless of configurations).
# Sets $main::firstBuild to 1 if we are building the first CI for the first configurations.
# Sets $main::lastCI to 1 if we are building the last CI (regardless of configurations).
# Sets $main::lastBuild to 1 if we are building the last CI for the last configurations.
sub BuildList::process {
  main::checkNumArgs(\@_, 1, 1);
  $main::firstBuild = 1;
  foreach my $i (0..$#entries) {
    my $buildEntry = $entries[$i];
    $main::firstCI = ($buildEntry->{'ciIdx'} == 0) ? 1 : 0;
    $main::lastCI = ($buildEntry->{'ciIdx'} == $ciIdx - 1) ? 1 : 0;
    $buildEntry->setupAndBuild();
  }
}

sub BuildList::addCiUsingGlobalEnvs {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $ci) = @_;
  $class->addCi(sub { BuildEntry->new($ci, $_[0]); });
}

sub BuildList::addCiFromFindMakefile {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $dir) = @_;
  my $ciDir = main::findDirContainingMakefile($dir);
  $class->addCi(sub { BuildEntry->new1($dir, $_[0], $ciDir); });
}

# Adds CI to the build list.
# If $main::extendedCommandLine is set, and there are some environments defined,
# then add for each global env a BuildEntry. It then sets $globalEnvsUsed to 1.
# Otherwise it will add a BuildEntry with an undefined environment,
# since environment options can still follow later. In this case
# at build time we use all @globalEnvs for this CI.
# $sub is a subroutine to create the BuildEntry, usually something like:
# BuildList->addCi(sub { BuildEntry->new($ci, $_[0]); });
# Uses and updates $ciIdx.

sub BuildList::addCi {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $sub) = @_;
  if ($main::extendedCommandLine && scalar(@globalEnvs)) {
    foreach my $env (@globalEnvs) {
      my $buildEntry = $sub->($env);
      $buildEntry->{'ciIdx'} = $ciIdx;
      push @entries, $buildEntry;
    }
    $globalEnvsUsed = 1;
  } else {
    my $buildEntry = $sub->(undef);
    $buildEntry->{'ciIdx'} = $ciIdx;
    push @entries, $buildEntry;
  }
  $ciIdx++;
}

# Adds the environment to the list of global envs.
# If $globalEnvsUsed is 0, then appends it to the list of envs,
# otherwise it resets the list of global envs to the one specified.
sub BuildList::addGlobalEnv {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $name) = @_;
  Msg->debug(2, "Adding global env: $name");
  my $env = Env->get($name);
  unless (defined $env) {
    my $option = "-$name";
    my $hint = '';
    $hint = "\nOr do you mean to use option \"$option\"?" if (grep {$_ eq $option} @main::options);
    Msg->fatal("Unknown environment name \"$name\";\nKnown envs are:", @Env::envNames, "\nSee $main::siteDir/cbuildconfig.pl$hint");
  }
  my @envs = $env->expand();
  if ($main::extendedCommandLine && $globalEnvsUsed) {
    @globalEnvs = @envs;
    $globalEnvsUsed = 0;
  } else {
    push @globalEnvs, @envs;
  }
}

sub BuildList::more {
  main::checkNumArgs(\@_, 1, 1);
  my ($class) = @_;
  return ($nextEntry < @entries);
}

sub BuildList::next {
  main::checkNumArgs(\@_, 1, 1);
  my ($class) = @_;
  unless (BuildList->more()) {
    Msg->debug(5, "BuildList::next finished");
    return undef;
  }
  my $entry = $entries[$nextEntry];
  $nextEntry++;
  Msg->debug(5, "BuildList::next => ", $entry->ciName());
  $entry;
}

sub BuildList::isEmpty {
  main::checkNumArgs(\@_, 1, 1);
  if (@entries == 0) {
    Msg->debug(5, "BuildList::isEmpty => true");
    return 1;
  } else {
    Msg->debug(5, "BuildList::isEmpty => false");
    return 0;
  }
}

sub BuildList::ensureSingleEntry {
  main::checkNumArgs(\@_, 1, 1);
  if (@entries != 1) {
    Msg->fatal("Expecting specification of exactly one CI");
  }
}

################################################################################
package CI;
################################################################################

sub CI::new {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $name, $dir) = @_;
  my $this= {'name'=>$name, 'dir'=>$dir};
  bless $this, $class;
  $this;
}

# Usage: CI::maybeCIDirectory($dir)
# returns true if $dir has a makefile (See @main::makefileNames) or an inc subdirectory.
sub CI::maybeCIDirectory {
  main::checkNumArgs(\@_, 1, 1);
  my ($dir) = @_;
  foreach my $mf (@main::makefileNames) {
    return 1 if -f "$dir/$mf";
  }
  return -d "$dir/inc";
}

################################################################################
package Projects;
################################################################################
BEGIN {
  @projDirs = ();
  $initialised = 0;
  @intfs = ();
  @apps  = ();
  %typeList = ("cis"=>\@cis, "apps"=>\@apps, "intfs"=>\@intfs);
  %type = (); # maps comps/intfs/apps name to one of qw(cis apps intfs)
  %dir = (); # maps comps/intfs/apps name to directory
  %dirLC = (); # maps lowercased comps/intfs/apps name to list of case exact names.
  %cis = (); # maps dir to CI
  @dirs = ();
}

sub Projects::prjlistFile {
  main::checkNumArgs(\@_, 0, 0);
  "$main::_TMROOT/project/prjlist.txt";
  #"$main::ENV{'_TMROOT'}/project/prjlist.txt";
}

sub Projects::ensureInitialised {
  main::checkNumArgs(\@_, 0, 0);
  return if $initialised;
  local (*F);
  my $prjlistFile = prjlistFile();
  unless (open(F, $prjlistFile)) {
    Msg->fatal("$!:", $prjlistFile);
  }
  my $line;
  my @projDirs = ();
  my $projDir;
  while (defined ($line = <F>)) {
    next if $line =~ /^\s*#/;
    chomp $line;
    $projDir = $line;
    $projDir =~ s/^\s+//;
    $projDir =~ s/\s+$//;
    next unless ($projDir =~ /\S/);
    $projDir = Var->expand($prjlistFile, $projDir);
    push @projDirs, $projDir;
  }
  close(F);
  foreach $projDir (reverse @projDirs) {
    Projects->readProject($., $line, $projDir);
  }
  Msg->debug(2, scalar(@projDirs), "project directories read from", $prjlistFile);
  Msg->debug(2,
	     scalar(@{$typeList{'comps'}}), "comps",
	     scalar(@{$typeList{'intfs'}}), "intfs",
             scalar(@{$typeList{'apps'}}), "apps");
  $initialised = 1;
}

sub Projects::readProject {
  main::checkNumArgs(\@_, 4, 4);
  my ($class, $lineNo, $line, $projDir) = @_;
  unless (-d $projDir) {
    Msg->warn(prjlistFile() . ":$lineNo:\n$!:", $projDir) if Msg->debugEnabled(1);
    return;
  }
  $projDir =~ s![\\/]!/!g;
  push @projDirs, $projDirs;
  Projects->readNames($projDir, "intfs");
  Projects->readNames($projDir, "comps");
  Projects->readNames($projDir, "apps");
}

sub Projects::readNames {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $projDir, $type) = @_;
  my @projDirDirs = grep {-d $_} glob("$projDir/$type/*");
  my ($dir, $name);
  foreach $dir (@projDirDirs) {
    $dir = main::canonPath($dir);
    $dir =~ m!([^/\\]+)$!;
    my $name = $1;
    if (exists $type{$name} && ($type{$name} eq $type)) {
      Msg->warn("Multiple use with same type ($type) of directory name \"$name\" (\"$dir\"):\nFirst use in \"$dir{$name}\"") if Msg->debugEnabled(1);
      next;
    }
    Msg->debug(4, "Found: $name => $dir");
    $type{$name} = $type;
    $dir{$name} = $dir;
    push @{$dirLC{"\L$name"}}, $name;
    push @dirs, $dir;
    push @{$typeList{$type}}, $name;
    $cis{$dir} = CI->new($name, $dir);
  }
}

# Usage Projects->getMatchingDirs($shellWildcard)
# Returns sorted list.
# shell-style wildcards: * and ?
sub Projects::getMatchingDirs {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $wc) = @_;
  ensureInitialised();
  my $rx = $wc;
  # normalise on forward /:
  $rx =~ s![\\/]!/!g;
  # if we use shell-style wildcards (* and ?) then translate to Perl regexp:
  $rx =~ s!  \.  !\\.!gx;
  $rx =~ s!  \?  !.!gx;
  $rx =~ s!  \*  !.*!gx;
  Msg->debug(2, "Matching comps+apps+intfs (" . scalar(@dirs) . ") with \"$wc\" (Perl regexp \"$rx\")");
  my @dirs = grep {$_ =~ /$rx/} @dirs;
  sort @dirs;
}

# Usage Projects->listMatchingDirs(wildcard)
# Prints sorted list.
# shell-style wildcards: * and ?
sub Projects::listMatchingDirs {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $wc) = @_;
  my $dir;
  foreach $dir (getMatchingDirs($class, $wc)) {
    print $dir, "\n";
  }
}

=head2 Projects::ciDir

Usage: C<Projects-E<gt>ciDir($name)>

Returns the directory of a CI stored according
to the SDE2 structures. Returns undef if no such directory found.

Example: C<Projects-E<gt>ciDir("tmml")>

=cut

# Usage: Projects->ciDir()
# Returns directory of the CI.
# Returns undef if non-existing.
sub Projects::ciDir {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $name) = @_;
  ensureInitialised();
  $dir{$name};
}

#=head2 Projects::ciLookup

#Usage: C<Projects-E<gt>ciLookup($name)>

#Returns the CI from its name or directory (may be case inexact).
#Returns undef if no such directory found.

#Examples:
#    C<Projects-E<gt>ciLookup("tmsposal")>
#    C<Projects-E<gt>ciLookup("..")>

#=cut

sub Projects::ciLookup {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $name) = @_;
  ensureInitialised();
  my $dir = $dir{$name};
  unless (defined $dir) {
    # check if user gave case-incorrect name, and there is just one with a name matching:
    my $nameLC = "\L$name"; # lowercase name
    if (exists $dirLC{$nameLC}) {
      my @namesLC = @{$dirLC{$nameLC}};
      if (@namesLC > 1) {
        Msg->error("Multiple CIs (@{$dirLC{$nameLC}}) match $name");
      } else {
        $dir = $dir{$namesLC[0]};
      }
    }
    # if still undefined, try $name as a directory, but check it has a makefile or inc directory:
    unless (defined $dir) {
      if (-f "$name/makefile" || -d "$name/inc") {
        $dir = main::canonPath(main::makeAbsolute($name));
      }
    }
  }
  defined $dir ? $cis{$dir} : undef;
}

################################################################################
package PipeCmd;
################################################################################

sub PipeCmd::print {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $cmd) = @_;
  Msg->debug($main::noexec ? 0 : 1, "Executing: $cmd\n");
  print main::PIPECMD $cmd, "\n" unless $main::noexec;
}

sub PipeCmd::cdToCurrentDirectory {
  main::checkNumArgs(\@_, 1, 1);
  PipeCmd->cd(Cwd::getcwd());
}

sub PipeCmd::cd {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $dir) = @_;
  if (-d $dir) {
    my $osDir = main::canonPath($dir);
    PipeCmd->print("pushd $osDir");
  } else {
    Msg->fatal("$!: cannot cd to \"$dir\"");
  }
}

sub PipeCmd::unsetVar {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $var) = @_;
  my $cmd = ($^O eq 'MSWin32') ? "set $var=" : "unset $var";
  PipeCmd->print($cmd);
}

sub PipeCmd::setVar {
  main::checkNumArgs(\@_, 3, 3);
  my ($class, $var, $value) = @_;
  my $cmd = ($^O eq 'MSWin32') ? "set $var=$value" : "export $var='$value'";
  PipeCmd->print($cmd);
}

sub PipeCmd::setPrompt {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $prompt) = @_;
  my $cmd = ($^O eq 'MSWin32') ? "prompt $prompt" : "export PS1='$prompt'";
  PipeCmd->print($cmd);
}

sub PipeCmd::setColor {
  main::checkNumArgs(\@_, 2, 2);
  my ($class, $color) = @_;
  my $cmd = ($^O eq 'MSWin32') ? "color $color" : "echo Setting of color by $main::pgm not supported";
  PipeCmd->print($cmd);
}

__END__
:endofperl
