WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/buildlib.pl

 use PackageEntry;
 use JatsEnv;
 use JatsSystem;
 use JatsVersionUtils;
 use FileUtils;
+use ToolsetFiles;
 use Pod::Usage;
 use Getopt::Long;
 use File::Path;
 use XML::Writer;
 use ArrayHashUtils;
 our $Interface              = 0;
 our $RootOnly               = 0;
 our $Perms                  = 0;
 our $Expert                 = 0;
 our $All                    = 0;
-our $Nolog                  = 0;
 our $Cache                  = $ENV{GBE_DPKG_CACHE_CTL} || 0;
 our $NoPackageError         = 0;
 our $ForceBuildPkg          = 0;
 our $Srcdir                 = "";               # default source root
 our $ForceBuild             = 1;
 my  $DeleteDPACKAGE         = 0;                # Must clobber DPACKAGE
 my  $build_source_pkg       = 0;                # Flag to build source package
 my  $opt_help               = 0;
 my  $sandbox_exact          = 0;                # Exact or in-exact sandbox
+my  $pkgFromSandbox         = 0;                # Flags that we have imported a package from a sandbox
+my  $genToolsetPlatform     = 0;                # BuildToolset directive has been seen
+my  $genToolsetActive       = 0;                # TOOLSET platform required:1, Error:2
+my  $toolsetPlatform        = 'NONE';           # TOOLSET Display Value
+my  @genToolsetArgs;                            # Args for a generated TOOLSET
 BuildLibInit();
 sub BuildLibInit
+{
                              "man:3"         => \$opt_help,
                              "debug:+"       => \$::ScmDebug,
                              "verbose:+"     => \$::ScmVerbose,
                              "expert:1"      => \$Expert,
                              "all"           => \$All,
-                             "nolog"         => \$Nolog,
                              "cache:+"       => \$Cache,
                              "package"       => \$NoPackageError,
                              "nopackages"    => \$IgnorePkgs,
                              "forcebuildpkg" => \$ForceBuildPkg,
                              "force!"        => \$ForceBuild,
     Debug( "BuildFile:     ", $ScmBuildSrc );
     Debug( "Debug:         ", $::ScmDebug );
     Debug( "Verbose:       ", $::ScmVerbose );
     Debug( "Expert:        ", $Expert );
     Debug( "All:           ", $All );
-    Debug( "Nolog:         ", $Nolog );
     Debug( "Cache:         ", $Cache );
     Debug( "package:       ", $NoPackageError );
     Debug( "ForcePkg  :    ", $ForceBuildPkg );
     Debug( "ForceBuild :   ", $ForceBuild );
     Debug( "IgnorePkgs :   ", $IgnorePkgs );
         } elsif ( $CmdSwitch eq "help" || $CmdSwitch eq "usage" ) {
             $opt_help = 1;
             Usage();
-        } elsif ( $CmdSwitch eq "changelog" ) {
-            if ( -d "CVS" )                         # CVS support subdir
-            {
-                System( "$::GBE_PERL $::GBE_TOOLS/cvs2cl.pl --tags --branches --revisions --day-of-week" )
-            }
-            exit(1);
         } else {
             Usage( "(E) build. Unknown command \"$CmdSwitch\"" );
+        }
+    }
             unless ( $Srcdir );
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : isKeyword
+#
+# Description     : Test for an attempt to use reserved platform name
+#
+# Inputs          : $test   - Name to test
+#
+# Returns         : Reserved word or none
+#
+sub isKeyword
+{
+    my ($test) = @_;
+    foreach my $keyword ( qw (NATIVE TOOLSET GENERIC INSTRUMENT))
+    {
+        return $keyword if (uc($test) eq $keyword);
+    }
+    return undef;
+}
+#-------------------------------------------------------------------------------
 # Function        : BuildAlias
+#
 # Description     : Create an alias for multiple targets
 #                   The default operations will:
 #                       Add the alias as a default platform (* in the makefile.pl)
+        }
+    }
     Error( "BuildAlias() missing alias specifications" )
         if ( $alias eq "" );
+    Error ("BuildAlias() attempt to alias a keyword: $alias")
+        if ( isKeyword($alias) );
+    #
     #   If we need to recalculate the alias based on targets, then tag the alias
     #   to be processed
+    #
     $BUILDALIAS_TARGETS{ $alias } = ''
         if ( $target_mode );
     #   Define alias
+    #
-    if ( PlatformConfig::checkBuildAvailability($alias) == 2 )
+    if ( PlatformConfig::targetHasTag($alias, 'GENERIC') )
+    {
         Error( "BuildAlias() cannot create an alias named $alias", "That name is reserved for generic targets" );
+    }
     elsif ( $alias ne quotemeta( $alias ) )
+    {
+        Error   ("BuildAlias() alias '$alias' contains invalid characters") unless defined($::GBE_ABT);
         Warning( "BuildAlias() alias '$alias' contains invalid characters -- ignored" );
+    }
     elsif ( $BUILDALIAS{ $alias } )
+    {
+        Error   ("BuildAlias() duplicate alias '$alias'") unless defined($::GBE_ABT);
         Warning( "BuildAlias() duplicate alias '$alias' -- alias ignored" );
+    }
     else
+    {
+        #
         #   This solves order dependancy problems.
+        #
         @arguments = ExpandPlatforms( @arguments )
             unless $target_mode;
-        my $platform = "";                   # current platform
+        my $platform = '';                   # current platform
         my @pargs = ();                      # current args
+        #
         #   Process the expanded arguments
         #   Collect arguments and process when a new platform is discovered
+            }
+        }
+    }
+}
+#-------------------------------------------------------------------------------
+# Function        : BuildAliasDef
+#
+# Description     : Shorthand for BuildAlias (xxx,-Define, ... )
+#                   The way is should have been done  :(
+#
+# Inputs          : $alias          Name of alias to define
+#                   arguments       Alias arguments; platforms or targets
+#
+sub BuildAliasDef()
+{
+    my( $alias, @arguments ) = @_;
+    BuildAlias($alias . ',--Define', @arguments);
+}
 #-------------------------------------------------------------------------------
 # Function        : Process_TargetAlias
+#
 # Description     : Post Process the --Target option for the build alias
+        }
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : CleanUp_Aliases
+#
+# Description     : Will fully expand aliases to simplify display and processing
+#                       Remove arguments that  start with a '-'
+#                       Remove bits that start with a !
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub CleanUp_Aliases
+{
+    #
+    #   Clean up Aliases
+    #
+#DebugDumpData("BEFORE CleanUp_Aliases", \%BUILDALIAS);
+    foreach my $alias ( keys %BUILDALIAS )
+    {
+        my @aliasList = split(/ /, $BUILDALIAS{$alias});
+        my @expanded =  ExpandPlatforms(@aliasList);
+        my %add;
+        my %remove;
+        foreach ( @expanded)
+        {
+            if (m/^-/) {
+            } elsif (m/^!(.*)/) {
+                $remove{$1} = 1;
+            } else {
+                $add{$_} = 1;
+            }
+        }
+        #
+        #   If there are NO additive expressions in the alias, then
+        #   assume all the active targets
+        #
+        unless (keys %add) {
+            foreach  ( @BUILD_ACTIVEPLATFORMS)
+            {
+                 $add{$_} = 1;
+            }
+        }
+        foreach ( keys %remove) {
+            delete $add { $_};
+        }
+        $BUILDALIAS{$alias} = join(' ',keys %add);
+    }
+#DebugDumpData("AFTER CleanUp_Aliases", \%BUILDALIAS);
+}
+#-------------------------------------------------------------------------------
 # Function        : BuildProduct
+#
 # Description     : Create a family of Platforms with a common product line
 #                   ie: Create two flavors of the TP5, one based on the MOSF and
 #                   the othe based on the MOS68 toolset.
+        #
         unless ( $arg eq '++' )
+        {
             $target = $arg;
             Error( "BuildProduct() cannot create a product based on a GENERIC platform" )
-                if ( PlatformConfig::checkBuildAvailability($target) == 2);
+                if ( PlatformConfig::targetHasTag($target,'GENERIC') );
             next;
+        }
+        #
         #   Infer a BuildPlatform
     $buildentry{BASE} = $target;
     $buildentry{USES} = [ @$pUses ] if $pUses;
     foreach ( @$pArgs )
+    {
         if ( m~^--Alias=(.+)~ ) {
+            foreach my $alias (split(',',$1))
+            {
+                Error ("$fname() attempt to alias a keyword: $alias")
+                    if ( isKeyword($alias) );
-            push @{$buildentry{USERALIAS}}, split(',',$1);
+                push @{$buildentry{USERALIAS}},$alias;
-        }
+            }
-        else{
+        } else {
             push @{$buildentry{ARGS}}, $_;
+        }
+    }
     #   Detect reserved words being misused as a platform name
-    #   At the moment, the value of NATIVE is calculate towards the end of the
+    #   At the moment, the value of NATIVE and TOOLSET are calculate towards the end of the
-    #   build process so that it can be limited to platfroms that
+    #   build process so that it can be limited to platforms that are present.
+    foreach my $reserved ( qw (NATIVE TOOLSET INSTRUMENT))
-    #   are present.
+    {
-    Error('Invalid use of the platform alias NATIVE','The NATIVE alias cannot be used to define build platforms')
+        Error("Invalid use of the platform alias $reserved","The $reserved alias cannot be used to define build platforms")
-        if (uc($target) eq 'NATIVE');
+            if (uc($target) eq uc($reserved));
+    }
+    #
     #   Allow per-platform processing to be alter the basic information
     #   Special processing may be perform to extend the information
     #   Allows special processing to be enabled on a per-target basis
+    #
     #   Detect GENERIC targets
     #       The Build file is only allowed to have one that can be built on any one machine
+    #
-    my $buildAvailability = PlatformConfig::checkBuildAvailability( $base_target );
+    my $buildAvailability = PlatformConfig::targetHasTag( $base_target, 'KNOWN' );
-    if ($buildAvailability == 2 )
+    if (PlatformConfig::targetHasTag( $base_target, 'GENERIC' ) )
+    {
         UniquePush (\@GENERIC_TARGETS, $target );
+    }
+    #
+    #   Detect GENERIC_<machType> targets
+    #
+    if (PlatformConfig::targetHasTag( $base_target, 'GENERIC_MACHTYPE' ) )
+    {
         $pInfo->{IS_GENERIC} = 1;
+        $pInfo->{ALIAS} = 'GENERIC';
+        $pInfo->{NOT_AVAILABLE} = 1 unless needToolset();
+        $All = 1;
+    }
+    #
     #   Ensure target is known to JATS
     #   Remove unknown targets from the build. Create a list of unknown
     #   an alias that has not been expanded.
+    #
     #   One result will be that alias platforms, such as DEVLINUX, that don't
     #   expand on WIN32 will be shown as DEVLINUX and not its components.
+    #
-    unless ( $pInfo->{NOT_AVAILABLE} || exists $BUILDINFO{$target} || $pInfo->{IS_GENERIC} )
+    unless ( $pInfo->{NOT_AVAILABLE} || exists $BUILDINFO{$target} || $pInfo->{IS_GENERIC} || ($base_target =~ m~^GENERIC_~) )
+    {
         unless ( Exists( "$::GBE_CONFIG/PLATFORM", $base_target  ) )
+        {
-            UniquePush (\@BUILD_BADNAME, $target )
+            UniquePush (\@BUILD_BADNAME, $target );
-                unless PlatformConfig::checkKnownSpecial($target);
             $pInfo->{NOT_AVAILABLE} = 1;
+        }
+    }
+    #
         UniquePush (\@BUILDEXCLUDE, split(/\s*,\s*/,$_));
+    }
+}
 #-------------------------------------------------------------------------------
+# Function        : BuildToolset
+#
+# Description     : Indicate that this package will build binary parts of a JATS
+#                   toolset.
+#
+#                   Should be used to indicate that it building non-binary parts
+#                   too.
+#
+#                   Used as a sanity test.
+#
+# Inputs          : Options to limit the Machine Types affected
+#
+# Returns         :
+#
+sub BuildToolset
+{
+    my( @arguments ) = @_;
+    my ($exclude, $include, $including);
+    $genToolsetPlatform = 1;
+    Debug( "BuildToolset(@arguments)" );
+    Error( "BuildToolset must appear before BuildName()..." )
+        if ( $BUILDNAME ne "" );
+    #
+    #   Process TOOLSET specific options
+    #       --ExcludeMachType=xxxx,yyy
+    #       --MachType=xxxx,yyy
+    #
+    foreach ( @arguments )
+    {
+        if ( m~^--ExcludeMachType=(.+)~i ) {
+            foreach my $arch (split(',',$1))
+            {
+                if (uc($arch) eq uc($::GBE_MACHTYPE))
+                {
+                    Verbose("Exclude TOOLSET on this machine");
+                    $exclude = 1;
+                    last;
+                }
+            }
+        } elsif ( m~^--MachType=(.+)~i ) {
+            $including = 1;
+            foreach my $arch (split(',',$1))
+            {
+                if (uc($arch) eq uc($::GBE_MACHTYPE))
+                {
+                    Verbose("Include TOOLSET on this machine");
+                    $include = 1;
+                    last;
+                }
+            }
+        } else {
+            Error ("BuildToolset: Unknown option: $_");
+        }
+    }
+    #
+    #   Show we build for this architecture
+    #
+    $genToolsetActive = 0;
+    if ($exclude) {
+        $toolsetPlatform = 'Excluded';
+        return;
+    }
+    if ($including) {
+        if ($include) {
+            $genToolsetActive = 1;
+        } else {
+            $toolsetPlatform = 'Not included';
+        }
+        return;
+    }
+    $genToolsetActive = 1;
+    return;
+}
+#-------------------------------------------------------------------------------
 # Function        : BuildName
+#
 # Description     : Defines the package name and version
+#
 # Inputs          : build arguments
     my( @arguments ) = @_;
     my $relaxed_version_name = 0;
     my @args;
     Debug( "BuildName(@arguments)" );
     Error( "Platform(s) not defined.",
             "BuildAlias, BuildProduct and BuildPlatform directives must be defined prior to BuildName()." )
         unless( scalar @BUILDPLATFORMS );
 #.. Parse arguments
+    #
     #   Clobber processing done after values have been accumulated
     #   as they may be used later
+    #
     return if ( $Clobber );
-    ToolsetFile('build.log');
+    ToolsetFiles::AddFile('build.log');
-    ToolsetFile('ChangeLog', 'ChangeLog.bak') if ( $ScmHost eq "Unix" );
+    #
     #   Determine type of sandbox
+    #
     $sandbox_exact = ( -f $::GBE_DPKG_SBOX . '/.exact' )
         if ( $::GBE_DPKG_SBOX );
-#.. Create the ChangeLog
-#
-    if ( -d "CVS" )                             # CVS support subdir
-    {
-        System( "$::GBE_PERL $::GBE_TOOLS/cvs2cl.pl --tags --branches --revisions --day-of-week" )
-            if ( $Nolog == 0 && $ScmHost eq "Unix" );
-    }
 #.. Create build.log summary information
+#
     my ($sep) = "\n".(" " x 11) . ". ";
     Log( "\nBuild configuration (version $::GBE_VERSION)" );
     Log( "DPKG_LOCAL . $::GBE_DPKG_LOCAL" );
     Log( "DPKG_SBOX .. $::GBE_DPKG_SBOX" );
     Log( "Sandbox .... " . ($sandbox_exact ? "Exact" : "Development") );
     Log( "LocalFilter. $::GBE_SANDBOX/buildfilter") if ( $::GBE_SANDBOX && -f $::GBE_SANDBOX . '/buildfilter' );
-    Log( "Platforms .. " . PrintPlatforms(\@BUILDPLATFORMS, $sep) );
+    #
     #   Generate a list of platforms that are completely unknown to JATS
     #   May be the result of a user typo or a guess
+    #
     if ( @BUILD_BADNAME )
+    #
     #   Generate a list of active platforms
     #   Ensure that there are some active platforms
+    #
     GeneratePlatformList();
+    Log( "Platforms .. " . PrintPlatforms(\@BUILDPLATFORMS, $sep) );
+    #
     #   Detect a mix of Generic and non Generic targets
     #       Cannot mix generic and non-generic targets
+    #
             Error("Cannot mix GENERIC and non-GENERIC targets in the one build");
+        }
+    }
+    #
-    #   Build System Generic Saniy Test
+    #   Build System Generic Sanity Test
     #       If Generic   then MUST be a GENERIC build
     #       If NoGeneric then MUST not be a GENERIC build
+    #
     if (defined $GenericBuild)
+    {
+    }
     unless( @BUILD_ACTIVEPLATFORMS )
+    {
         my $msg = 'GBE_BUILDFILTER prevents any targets being built';
-        if (defined($::GBE_ABT)) {
+        if (defined($::GBE_ABT) || defined($::GBE_SANDBOX )) {
             # Build filter on this machine prevents the package building
             # On a Build System this is not an error
             #   Create a dummy platform called NOBUILD
             #   Do not populate the interface directory with package data
     else
+    {
         Log( "Build for .. ". PrintPlatforms(\@BUILD_ACTIVEPLATFORMS, $sep));
+    }
+    ProcessToolSetPlatform() if $genToolsetActive;
+    Log( "Toolset .... " . $toolsetPlatform ) if $genToolsetPlatform;
+    Error ("No suitable TOOLSET platform found") if (($genToolsetActive > 1) && $::GBE_ABT);
+    #
     #   Generate an error if nothing can be done because the GBE_PLATFORM
     #   masks any useful operation.
+    #
     if ( $::GBE_PLATFORM )
+    }
     return 1;
+}
+#-------------------------------------------------------------------------------
+# Function        : needToolset
+#
+# Description     : Internal. Determine if this machine needs to build for
+#                   a TOOLSET or a GENERIC_<MachType>
+#
+#                   In Build System
+#                       BUILDFILTER must identify the machine performing TOOLSET builds
+#
+#                       The build filter MUST contain the psuedo platform TOOLSET in order for
+#                       the alias to be created. This requires that the build daemons be configured to
+#                       specify a TOOLSET.
+#
+#                       Care MUST be taken to not configure multiple TOOLSET candiates
+#                       on similar machine types.
+#
+#                   Non Build Sytem (User Development)
+#                       True
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub needToolset
+{
+    my $toolsetNeeded;
+    $toolsetNeeded = 1 if (!defined($::GBE_ABT));
+    if (!$toolsetNeeded && defined($::GBE_BUILDFILTER) ) {
+        $toolsetNeeded = grep( /^TOOLSET$/, split( ' ', $::GBE_BUILDFILTER ) );
+    }
+    return $toolsetNeeded;
+}
+#-------------------------------------------------------------------------------
+# Function        : ProcessToolSetPlatform
+#
+# Description     : Locate the TOOLSET platform if required
+#                   In Build System
+#                       BUILDFILTER must identify the machine performing TOOLSET builds
+#                       The first suitable target will be chosen
+#
+#                       The build filter MUST contain the psuedo platform TOOLSET in order for
+#                       the alias to be created. This requires that the build daemons be configured to
+#                       specify a TOOLSET.
+#
+#                       Care MUST be taken to not configure multiple TOOLSET candiates
+#                       on similar machine types.
+#
+#                   Non Build Sytem (User Development)
+#                       The first suitable target will be chosen
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub ProcessToolSetPlatform
+{
+    my $toolsetNeeded;
+    my $toolset;
+    #
+    #   User is not allowed to create a TOOLSET alias
+    #       This should be captured before here, but ...
+    #
+    if (exists $BUILDALIAS{TOOLSET})
+    {
+        Error('Internal: User has manually specified a TOOLSET alias' );
+    }
+    #
+    #   Determine if we need to do any work
+    #
+    return unless needToolset();
+    #
+    #   Need to ensure that we have a TOOLSET platform in the build set
+    #
+    my %activePlatformMap = map {$_ => 1} @BUILD_ACTIVEPLATFORMS;
+    my @toolsetTargets = PlatformConfig::getTargetsByTag('TOOLSET');
+    foreach my $item (@toolsetTargets)
+    {
+        if (exists($activePlatformMap{$item}))
+        {
+            #
+            #   Add TOOLSET arguments into the existing target
+            #   Really only expecting --OnlyProd
+            #
+            if ( @genToolsetArgs) {
+                PlatformArgument($item, @genToolsetArgs);
+            }
+            # Update the displayed Toolset platform
+            $toolset = $item;
+            $toolsetPlatform = $toolset;
+            last;
+        }
+    }
+    #
+    #   No toolset platform found in the current build set
+    #
+    unless ($toolset) {
+        $toolsetPlatform = "None found in current build set";
+        $genToolsetActive = 2;
+        return;
+    }
+    #
+    #   Insert alias information
+    #
+    $BUILDALIAS{TOOLSET} = $toolset;
+    push @{$BUILDINFO{$toolset}{USERALIAS}}, 'TOOLSET';
+}
+#-------------------------------------------------------------------------------
+# Function        : BuildPreviousVersion
+#
+# Description     : Deprecated. Do not use
+#
+# Inputs          :
+#
+# Returns         :
+#
 sub BuildPreviousVersion
+{
     my( $version ) = shift;
     $BUILDPREVIOUSVERSION = $version;
 sub BuildInterface
+{
     my( $ifdirname ) = @_;
+    #
     #   Clobber the directory - at the end.
+    #
     if ( $Clobber )
+    {
         #   If this Interface directory contains the Dpackage.cfg file
         #   then JATS has created DPACKAGE and it needs to be clobbered
         #   Flag that it needs to be done later - when we know where it is
+        #
         $DeleteDPACKAGE = 1 if ( -f "$ifdirname/Dpackage.cfg" );
-        push @CLOBBERDIRS, $ifdirname;
-        return;
+    }
+    #
-    #   In AutoBuildTool mode the entire interface directory
+    #   Generate the required directory
-    #   will be deleted. This allows the build to be retried
+    #
+    BuildInterfaceInternal($ifdirname);
-    if (  defined($::GBE_ABT) )   # clobber mode ?
+    Log( "Interface .. $ifdirname" );
-    {
+    return 1;
+}
+#-------------------------------------------------------------------------------
-        if ( -d $ifdirname )
+# Function        : BuildInterfaceInternal
+#
+# Description     : Internal Use Only
+#                   Guts of the BuildInterface processing
+#
+# Inputs          : $ifdirname  - Name of an interface directory
+#
-        {
+# Returns         :
+#
+sub BuildInterfaceInternal
+{
-                RmDirTree( $ifdirname );
+    my( $ifdirname ) = @_;
-        }
+    my @createDirs;
-    }
+    push @CLOBBERDIRS, $ifdirname;
     if ( $ifdirname eq "local" ) {
-        mkpath ( "$ifdirname/inc" );
+        push @createDirs, "$ifdirname/inc";
         $BUILDLOCAL = "local";
     } else {
-        mkpath ( "$ifdirname/include" );
+        push @createDirs, "$ifdirname/include";
         $BUILDINTERFACE = $ifdirname;
         $::ScmInterface = $ifdirname;
+    }
-    mkpath ( "$ifdirname/bin" );
-    mkpath ( "$ifdirname/lib" );
+    unless ($Clobber) {
+        push @createDirs, "$ifdirname/bin";
-    Log( "Interface .. $ifdirname" );
+        push @createDirs, "$ifdirname/lib";
+        foreach my $dir ( @createDirs)
+        {
+            mkpath($dir);
-    return 1;
+        }
+        ToolsetFiles::AddDir($ifdirname, 'Internal');
+    }
+}
 sub BuildDirTree
+{
     my( $dirfile, $dirhead ) = @_;
     my( $dirname, $c );
         Log( "PackageIncludes. $name" ) unless ( $INC{$file} );
         require $file;
+    }
+}
-sub LinkSandbox
-{
-    my( $name, $path, $platform ) = @_;
-    return if ( $Clobber );                     # clobber mode ?
-    Warning ("LinkSandbox() This directive is being deprecated.");       #Dec-2011
-    Error ("LinkSandbox() expects three arguments:  @_")
-        unless ( $#_ == 2 );
-    Error ("LinkSandbox not allowed in ABT build","It can only be used in a Development Environment")
-        if ( $::GBE_ABT );
-    Debug( "LinkSandbox:" );
-    Debug( "Package:   $name" );
-    Debug( "Version:   $path" );
-    DataDirective("LinkSandbox");               # This directive allowed here
-    if ( $IgnorePkgs )
-    {
-        Log( "LinkSandbox. $name ($path) - Ignored" );
-        return;
-    }
-#
-#   If GBE_BUILDFILTER exists, Import 'user' platform
-#   specification and filter against the BUILD_ACTIVEPLATFORMS.
-#
-    Log( "LinkSandbox. $name ($path)" );
-    if ( ! -d $path )                           # sandbox exists ?
-    {
-        Log( "WARNING .... Sandbox $path not available" );
-    }
-    else
-    {
-        my @platforms;
-        if ( !defined($platform) || $platform eq "*" ) {
-            @platforms = @BUILD_ACTIVEPLATFORMS;
-        } else {
-            @platforms = ExpandPlatforms( split( ',', $platform ) );
-        }
-        $path = Realpath( $path );
-        IncludePkg ( $name, $path );
-        foreach my $platform ( @platforms )
-        {
-            LinkEntry( $platform, $path, $name, "!sandbox", 1, 1 );
-        }
-    }
-}
 #-------------------------------------------------------------------------------
 # Function        : LinkPkgArchive
+#
 # Description     : Include an external package into the build sandbox
 #                   by extending the compiler and linker search paths to
+        {
             $isa_cache = 0;
             next;
+        }
+        #
         #   If we are playing in a sandbox, then the version number is
         #   not used. The Package suffix is still used so that we can
         #   differentiate sysbasetypes.xxxxx.mas and sysbasetypes.xxxxx.syd
+        #
         else
+        {
             $version = $uversion;
+        }
-        #
-        #   Alias support
-        #   If the 'version' is '!current' then use a version of:
-        #       current
-        #       current_<USER_NAME>
-        #   This is an old mechanism whose use should not be encouraged
-        #
-        #..
-        if ( $version eq "!current" )
-        {
-            Error ("Use of !current is not allowed in ABT build")
-                if ( $::GBE_ABT );
-            $pkg = "$dpkg/$name/current";       # current
-            $pkg = "$dpkg/$name/current.lnk"
-                if ( -e "$dpkg/$name/current.lnk" );
-                                                # USER specific current
-            EnvImport( "USER" );
-            $pkg = "$dpkg/$name/current_$::USER"
-                if ( -e "$dpkg/$name/current_$::USER" );
-            $pkg = "$dpkg/$name/current_$::USER.lnk"
-                if ( -e "$dpkg/$name/current_$::USER.lnk" );
-        }
-        else
-        {                                       # standard
-            $pkg = "$dpkg/$name/$version";
+        $pkg = "$dpkg/$name/$version";
-            $pkg = "$dpkg/$name/$version.lnk"
+        $pkg = "$dpkg/$name/$version.lnk"
-                if ( -e "$dpkg/$name/$version.lnk" );
+            if ( -e "$dpkg/$name/$version.lnk" );
-        }
+        #
         #   Using a soft link
         #   Emulate a link in software. The link file contains one line
         #   which is the real pathname of the package
+        #
                      "Both a link and a package where found - using the link" )
                                                             if ( -d $non_link );
             Debug( "           link found -> $pkg" );
             my $link_src = $pkg;
-            open( LNKFILE, '<', "$pkg" ) || Error( "cannot open '$pkg'" );
-            $pkg = <LNKFILE>;                   # real path
-            close( LNKFILE );
-            $pkg = '' unless ( $pkg );
+            $pkg = TagFileRead($pkg);
-            $pkg =~ s~\s+$~~;
+            $pkg =~ s~\\~/~g;
             if ($pkg =~ s~^GBE_SANDBOX/~$::GBE_SANDBOX/~)
+            {
+                    $pkgFromSandbox++;
                     # If the target sandbox is in the 'deploymode' then the package
                     # will not be in the expected location. It will be in a 'build/deploy'
                     # subdir. Remove the pkg/name dir to get to the root of the package
                     my @dirs = File::Spec->splitdir( $pkg );
                     splice(@dirs, -2);
         System('--NoExit', "$::GBE_PERL $::GBE_TOOLS/cache_dpkg.pl $mode -wait -quiet $name/$version" );
+    }
+    #
     #   Locate the package
-    #   Use the first instance of the package that it found
+    #   Use the first instance of the package that is found
+    #
     Log( "BuildPkgArchive . $name ($version)" );
     my ( $pkg, $local ) = PackageLocate( $name, $version );
     if ( $pkg )
+    {
                   );
+        #
         #   Determine the package format and use the appropriate installer
         #   Supported formats
-        #       1) Package has a descpkg file (new style)
+        #       1) Package has a descpkg file (only style currently supported)
-        #       2) Package has a InstallPkg.sh file (old style)
-        #       3) Package has a Install.sh file (old style is it used ??)
+        #
         if ( $package_installed ) {
             Verbose ("Package already installed: $name, $version");
         } else {
+                #
                 System( "cd $pkg; $::GBE_PERL $::GBE_TOOLS/installpkg.pl $Cwd/$BUILDINTERFACE $Cwd @opts $arglist");
                 Error( "Package installation error" ) if ( $? != 0 );
+            }
-            elsif ( -e "$pkg/InstallPkg.sh" )
-            {
-                System( "(cd $pkg; ./InstallPkg.sh $Cwd/$BUILDINTERFACE $Cwd)" );
-            }
-            elsif ( -e "$pkg/Install.sh" )
-            {
-                System( "(cd $pkg; ./Install.sh $Cwd/$BUILDINTERFACE $Cwd)" );
-            }
             else
+            {
                 Error ("Unknown package format for package $name/$version found in $pkg");
+            }
     return "@arglist";
+}
 #-------------------------------------------------------------------------------
-# Function        : TagFileMatch
-#
-# Description     : Test the contents of a simple (one line) file against a string
-#
-# Inputs          : $tfile      - Name of the tage file
-#                   $tag        - Tag to match
-#
-# Returns         : True - is a match
-#
-sub TagFileMatch
-{
-    my ($tfile, $tag) = @_;
-    return 0 unless -f $tfile;
-    open( my $file, '<', $tfile) || return 0;
-    my $text = <$file>;
-    close $file;
-    # Remove trailing new line and white space
-    $text =~ s~\s*$~~;
-    #Debug0("TagFileMatch:'$text':'$tag'", $text eq $tag );
-    return $text eq $tag;
-}
-#-------------------------------------------------------------------------------
 # Function        : GeneratePlatformList
+#
 # Description     : Return a list of platforms that should particiate in this
 #                   build. This is a function of
 #                       1) Platforms defined in the build.pl file
                     unless ( $1 );
+                #
                 #   Expand PLATFORMs into known aliases
                 #   Alias will expand to PLATFORMs so it won't work unless we are
-                #   processing PALTFORMs.
+                #   processing PLATFORMs.
+                #
                 my @taglist = ( $table eq "PLATFORM" ) ? ExpandPlatforms($3) : $3;
+                #
                 #   Add / Remove items from the result
                 for my $item ( @taglist )
+                {
                     my $plist = $part_to_platform{$table}{$item};
                     for ( @{$plist})
+                    {
-                        if ( $2 )
+                        if ( $2 ) {
-                        {
                             delete $result{$_};
-                        }
-                        else
+                        } else {
-                        {
                             $result{$_} = 1;
+                        }
+                    }
+                }
+            }
+            }
+        }
+        #
         #   Process BuildExclude
-        #   A list of
+        #   A list of targets to be excluded
+        #       INSTRUMENT is a key word
+        #
         for my $word (@BUILDEXCLUDE)
+        {
             my $platform;
             Error('BuildExclude: Unknown option: ' . $word) if ($word =~ m~^-~);
             Error('BuildExclude: Invalid format: ' . $word) if ($word =~ m~^!~);
+            #
+            #   INSTRUMENT is a key word
-            #   Remove items from the result
+            #       Remove all instrumented builds
+            #
-            my $table = "TARGET";
+            if ($word eq 'INSTRUMENT')
+            {
-            my $plist = $part_to_platform{$table}{$word};
+                for ( keys %result) {
-            Warning('BuildExclude: Unknown target:' . $word ) unless $plist;
+                    if ( PlatformConfig::targetHasTag( $_, 'INSTRUMENT') ) {
+                        delete $result{$_} ;
-            for ( @{$plist})
+                    }
+                }
+            }
+            else
+            {
+                #
+                #   Remove items from the result
+                #
+                my $table = "PLATFORM";
+                my $plist = $part_to_platform{$table}{$word};
+                if ($plist) {
+                    for ( @{$plist}) {
-                delete $result{$_};
+                        delete $result{$_};
+                    }
+                }
+                else  {
+                    Warning('BuildExclude: Unknown target:' . $word )
+                        unless exists $::BUILDINFO{$word};
+                }
+            }
+        }
+        #
         #   Return an array of platforms to process
 #                   Directive can be used at any time before the BuildMake
+#
 #                   Will handle the existence of an auto.pl file by inserting
 #                   it as build.pl.
+#
-# Inputs          : Options
+# Inputs          : $platform   - In ABT mode. Process under this platform name
+#
+#
 # Returns         :
+#
 sub BuildSrcArchive
+{
+    my ($platform) = @_;
+    Error ("BuildSrcArchive requires one platform specifier") unless (defined $platform);
+    #
     #   If we are clobbering, then there is nothing to do
     #   The generated file is placed within the interface
     #   directory and that directory will be deleted during the clobber
+    #
     return if ( $Clobber );
     DataDirective("BuildSrcArchive");
+    #
+    #   If not in ABT mode, then build archive on developers machine
+    #   In ABT mode only build the archive on a machine whose platform name is in the build filter
+    #
+    my $doBuild;
+    if (defined($::GBE_ABT))
+    {
+        if (defined ($::GBE_BUILDFILTER))
+        {
+            $doBuild  = grep( /^$platform/, split( ' ', $::GBE_BUILDFILTER ) );
+        }
+        unless ( $doBuild )
+        {
+            Log( "SrcPackage . Not on this machine" );
+            return;
+        }
+    }
+    #
     #   Currently this operation is only supported of some platforms
     #   Only supported on Unix platforms
     #   Uses the 'pax' utility
+    #
     unless ( LocateProgInPath ( 'pax', '--All' ) && ( $ScmHost eq "Unix" ) )
+    {
         next if ( m/^\.$/ );
         next if ( m'^\.\.$' );
         next if ( m'^build\.log$' );
         next if ( m'\.gbe$' );
+        next if ( m'\.svn$' );
+        next if ( m'\.git$' );
+        next if ( m'\.cvs$' );
+        next if ( m'local_dpkg_archive$' );
+        next if ( m'\.jats.packageroot$' );
         next if ( m'^local$' );
         next if ( m'^pkg$' );
         next if ( m/^$BUILDINTERFACE$/ );
         $auto_pl = 1, next  if ( m'^auto\.pl$' );
         next if (  m'^build\.pl$' );
     #   information.
+    #
     TestForForcedBuild();
+    #
-    #   Calcuate the aliases that are being extracted from targets
+    #   Calculate the aliases that are being extracted from targets
+    #
     Process_TargetAlias();
+    #
-    #   Calculate NATIVE alaias
+    #   Calculate NATIVE and INSTRUMENT alias
-    #   Limit the Native Alias to active platforms
+    #       Limit the Aliases to active platforms
+    #
-    if (exists $BUILDALIAS{NATIVE})
+    foreach my $alias (qw( NATIVE INSTRUMENT))
+    {
-        Warning('User has manually specified a NATIVE alias','Default alias will not be set.');
-    }
-    else
-    {
-        my %activePatformMap = map {$_ => 1} @BUILD_ACTIVEPLATFORMS;
-        my @activeNatives;
+        if (exists $BUILDALIAS{$alias})
-        foreach my $item (PlatformConfig::getNativeTargets())
+        {
+            Warning("User has manually specified a $alias alias",'Default alias will not be set.');
+        }
+        else
+        {
+            my %activePlatformMap = map {$_ => 1} @BUILD_ACTIVEPLATFORMS;
+            my @activeAliases;
+            foreach my $item (PlatformConfig::getTargetsByTag($alias))
+            {
-            push (@activeNatives, $item) if exists($activePatformMap{$item});
+                push (@activeAliases, $item) if exists($activePlatformMap{$item});
+            }
+            $BUILDALIAS{$alias} = join(' ', @activeAliases) if (@activeAliases);
+            #
+            #   Add to the build entry too
+            #
+            foreach my $aliasTarget (@activeAliases)
+            {
+                push @{$BUILDINFO{$aliasTarget}{USERALIAS}}, $alias;
+            }
+        }
-        $BUILDALIAS{NATIVE} = join(' ', @activeNatives);
+    }
+    CleanUp_Aliases();
+    #
     #   Create dummy package to describe the Interface directory
+    #
     CreateInterfacePackage();
+    #
     #   Sanity test the users packages
+    #       In a sandbox all bet are off
+    #
-    PackageEntry::SanityTest() unless $Clobber;
+    PackageEntry::SanityTest() unless ($Clobber || $::GBE_SANDBOX);
+    #
     #   Validate the $Srcdir before its first real use
     #   This is calculated from the user directives
+    #
 #-------------------------------------------------------------------------------
 # Function        : TestForForcedBuild
+#
 # Description     : If a non-forced build has been requested, then see
 #                   if a build is required ( ie: build.pl modified )
 #
+#                   Check:
+#                       Time stamp of build.pl
+#                       Time stamp of Makefile.gbe
+#                       BuildFilter has not changed
+#                       Signature of dependencies has not changed
+#                       No packages consumed from within the sandbox
+#
 # Inputs          : None
+#
 # Returns         : May not return
+#                   Will return if we need to perform a build
+#
 sub TestForForcedBuild
+{
+    #
     #   Always return if in clobber mode
+        #
         #   Ensure that the build filter has not changed
         #   If the user has changed the buildfilter, then we need to
         #   force a build.
+        #
-        #   The root Makefile.bge will have a $ScmBuildFilter entry
+        #   The root Makefile.gbe will have a $ScmBuildFilter entry
+        #
         unless ( @build_warn )
+        {
             use JatsMakeInfo;
             ReadMakeInfo();
                 push @build_warn, "Build filter has changed";
                 Verbose2 ("Buildfilter Test: Was:$line, Is:$::GBE_BUILDFILTER");
+            }
+        }
+        #
+        #   If any of the imported packages are from a sandbox, then we must force a build
+        #   and a make.
+        #
+        if ($pkgFromSandbox)
+        {
+            push @build_warn, "Consuming packages from within the sandbox";
+        }
         if ( @build_warn )
+        {
             Verbose ("Forcing Build.", @build_warn );
+        }
         else
+    }
     my $link_dir = "$target_archive/$BUILDNAME_PACKAGE";
     my $link_path = "$link_dir/$link_file";
-    if ( $Clobber )
+    if ( $Clobber || $NoBuild )
+    {
         unlink $link_path;          # Delete the link
         rmdir $link_dir;            # Delete only if empty
+    }
     else
+#
 # Description     : Create data structures to allow this package to be built
 #                   within a multi-package sandbox.
+#
 #                   This will allow multiple components to work together
+#                   Creates:
+#                       sandbox.int     - Rel path to the packages interface
+#                       sandbox.ffp     - Fast FingerPrint over the package body
+#                       sandbox.nob     - No Build marker
+#
 #                   Note: When called in Clobber-mode the link will be deleted
+#
 # Inputs          : $BUILDNAME              - The package name
 #                   $BUILDNAME_PROJECT      - Project extension
     #   information as this will not be correct
+    #
     #   PACKAGE/sandbox.PRJ.cfg
+    #
     my $link_dir = "$sandbox_dpkg_archive/$BUILDNAME_PACKAGE";
-    my $link_file;
+    my $base = 'sandbox' . ${BUILDNAME_SUFFIX};
-    if ( $sandbox_exact )
+    my $nob_path  = $base . ".nob";
-    {
-        $link_file = "$BUILDVERSION.cfg";
+    my $ffp_path  = $base . ".ffp";
-    }
-    else
+    my $int_path  = $base . ".int";
-    {
-        $link_file  = 'sandbox' . ${BUILDNAME_SUFFIX} . '.cfg';
+    $nob_path = "$link_dir/$nob_path";
-    }
+    $ffp_path = "$link_dir/$ffp_path";
-    my $link_path = "$link_dir/$link_file";
+    $int_path = "$link_dir/$int_path";
     if ( $Clobber )
+    {
-        unlink $link_path;          # Delete the link
         rmdir $link_dir;            # Delete only if empty
+    }
     else
+    {
-        Log( "Sandbox cfg. $link_file");
+        ToolsetFiles::AddFile($nob_path);
-        unlink $link_path;
+        ToolsetFiles::AddFile($ffp_path);
-        mkdir $link_dir;
+        ToolsetFiles::AddFile($int_path);
-        #
-        #   Create the sandbox config data structure
+        #Log( "Sandbox Data. $base");
-        #
-        my %sandbox_info = (
+        unlink $int_path;
-            BUILDDIR     => $Cwd,
-            INTERFACEDIR => $BUILDINTERFACE,
-            );
+        mkdir $link_dir;
+        #
+        #   File with path to the interface directory
-        #   Write out the Parsed Config File with new information
+        #   Relative to the base of the sandbox
+        #
-        my $fh = ConfigurationFile::New( $link_path );
-        $fh->Header( "buildlib (version $::BuildVersion)",
+        FileCreate($int_path, catdir('GBE_SANDBOX',RelPath($Cwd,$::GBE_SANDBOX),$BUILDINTERFACE ));
-                                  "Sandbox configuration" );
+        #
-        #   Dump out the configuration information
+        #   Indicate packages not build on this machine
+        #
-        $fh->Dump( [\%sandbox_info], [qw(*sandbox_info)] );
+        unlink $nob_path;           # Delete the NoBuild marker
-        $fh->Close();
+        if ($NoBuild) {
+            TouchFile($nob_path);
+        }
+    }
+}
 #-------------------------------------------------------------------------------
     #   Must have a valid $BUILDINTERFACE
     #   Normally this is held in the interface directory, but this is not
     #   always created. If there is no $BUILDINTERFACE, then use the
     #   build directory
+    #
-    $BUILDINTERFACE = "." unless ( $BUILDINTERFACE );
+    BuildInterfaceInternal($::ScmInterface) unless ( $BUILDINTERFACE );
     #.. Starting the build phase. No more data collection
+    #
     StartBuildPhase();
     LastBuildDirective();
+    }
     if ( $Clobber )                             # clobber mode ?
+    {
+        #
-        #   Read in toolset files - a list of files collected during
-        #   previous builds
-        #
-        ToolsetFile();
-        #
         #   Unmake all the makefiles
         #   No longer needed as we track the file that are created
+        #
         #if ( -e "Makefile.gbe" )
         #{
+        #
         push @CLOBBERDIRS, "build/deploy";
         push @REMOVEDIRS, "build";
+        #
+        #   List of files maintained by the build system
+        #
+        my @toolsetFiles = ToolsetFiles::GetFiles();
+        #
         #   Delete interface directories and other directories that have been
         #   marked to be clobbered
+        #
         foreach my $dir ( @CLOBBERDIRS )
+        {
+            {
                 rmdir ( $dir ); # Only if empty
+            }
+        }
-        if ( exists $::GBE_TOOLSETFiles{Files} )
+        foreach my $file (@toolsetFiles)
+        {
-            foreach my $file (keys %{$::GBE_TOOLSETFiles{Files}})
-            {
-                if ( -f $file )
+            RmDirTree ( $file ) if ( -f $file );
-                {
-                    RmDirTree ( $file );
-                }
-            }
+        }
+        #
         #   DPACKAGE may be a user file, Only delete it if we created it
+        #
     my @cmds = ('jmake.pl', 'rebuild');
     push @cmds, 'NORECURSE=1' if ( $RootOnly );
     JatsTool ( @cmds);
+    #
+    ErrorConfig( 'name' => 'buildlib')   ;
     #   Generate some warnings that will be seen at the end of the build
+    #
     Warning ("BuildSrcArchive Directive Present","Read JATS Manual for correct usage")
         if ($build_source_pkg);
+}
 # Description     : Maintain the nobuild marker
 #                   This is file placed in the interface directory simply
 #                   to indicate to the 'create_dpkg' utility that this build
 #                   does not do anything useful.
+#
-#                   It will only be used on a build machine by the buid daemon
+#                   It will only be used on a build machine by the build daemon
+#
 #                   Its not placed in the interface directory as it would be
 #                   harder for create_dpkg to find it.
+#
 # Inputs          : None
     $path .= '/'. $file;
     $path =~ tr~/~/~s;
     $BUILD_KNOWNFILES {$file} = $path
         unless ( defined($noadd) && $noadd);
-    ToolsetFile( $path )
+    ToolsetFiles::AddFile( $path )
         unless ($Clobber);
     return $path;
+}
     -help          - Display terse usage
     -help -help    - Display verbose usage
     -man           - Display internal manual
     -verbose[=n]   - Set level of progress verbosity
     -debug[=n]     - Set the debug level
-    -nolog         - Do not generate/update Changelog
     -cache         - Cache packages in the local dpkg_package cache
     -cache -cache  - Forced refresh dependent packages in the local cache
     -package       - Ignore packages that are not available and continue
     -nopackages    - Ignore package processing directives
     -forcebuildpkg - Treat LinkPkgArchive directives as BuildPkgArchive
  Sticky settings:
     -all           - Build for all platforms ignoring GBE_BUILDFILTER
     -expert[=n]    - Relaxing dependency checks on the user makefiles
  Commands:
-    changelog      - Only update ChangeLog.
     clobber        - Remove generated build system (eg Makefiles).
-    interface      - Only (re)build the interface tree, including ChangeLog.
+    interface      - Only (re)build the interface tree.
     rootonly       - Only (re)build the root directory.
 =head1 OPTIONS
 =over 8
 progress information.
 If an argument is provided, then it will be used to set the level, otherwise the
 existing level will be incremented. This option may be specified multiple times.
-=item B<-nolog>
-Do not generate or update the ChangeLog maintained when a CVS directory is detected
-in the build directory.
 =item B<-cache>
 This option will cause dependent packages to be cached in the local
 dpkg_archive cache.
 are rebuilt. It will only be lost when the next 'jats build' is performed.
 The effect of the option can be changed when the makefiles are processed. This
 option simply sets the default' mode of operation.
-=item B<changelog>
-This command will only update the CVS change log.
 =item B<interface>
-This command will only build, or rebuild, the 'interface' directory and the
+This command will only build, or rebuild, the 'interface' directory.
-changelog ( if required ).
 This command will not build, or rebuild, the root directory. The build
 process will not recurse through the subdirectories creating makefiles.
 =item B<rootonly>
-This command will only build, or rebuild, the 'interface' directory, the
+This command will only build, or rebuild, the 'interface' directory and
-changelog (if required) and the root-level makefiles.
+the root-level makefiles.
 The build process will not recurse through the subdirectories creating
 makefiles. These can be made on-demand by jats if a 'make' command is issued.
 =item B<clobber>

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/buildlib.pl – Rev 6073 → 6133