WebSVN – DevTools – Diff – /core_devl/branches/gitBuilder/TOOLS/buildlib.pl

 use ArrayHashUtils;
 use File::Find;
 use Storable qw(dclone);
 #use Digest::SHA qw(sha1);
 use Digest::SHA::PurePerl qw(sha1);
-use IPC::Open3;
+use JatsSignatureBuilder;
 our $BuildVersion           = "2.1.0";
 #.. Switchs
+#
 our $CmdSwitch              = "";
 our $Clobber                = 0;
 our $Archive                = 0;
 our $Interface              = 0;
 our $RootOnly               = 0;
+our $SignatureOnly          = 0;
 our $Perms                  = 0;
 our $Expert                 = 0;
 our $All                    = 0;
 our $Cache                  = $ENV{GBE_DPKG_CACHE_CTL} || 0;
 our $NoPackageError         = 0;
 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
+my  $descpkgPath;                               # Path to the dscpkg file
 BuildLibInit();
 sub BuildLibInit
+{
     EnvImport( 'USER' );
     EnvImport( 'GBE_HOSTNAME');
     EnvImport( 'GBE_DRV' )
         if ( $ScmHost ne 'Unix' );            # DOS or WIN special
+    EnvImportOptional ( 'GBE_DPKG_ESCROW','' );
     EnvImportOptional ( 'GBE_DPKG_REPLICA','' );
     EnvImportOptional ( 'GBE_DPKG_STORE','' );
     EnvImportOptional ( 'GBE_DPKG_CACHE','' );
     EnvImportOptional ( 'GBE_DPKG_LOCAL','' );
     EnvImportOptional ( 'GBE_DPKG_SBOX' ,'' );
             $RootOnly       = 1;
         } elsif ( $CmdSwitch eq "clobber" ) {
             $Clobber        = 1;
+        } elsif ( $CmdSwitch eq "signature" ) {
+            $SignatureOnly  = 1;
+            $Interface      = 1;
+            $IgnorePkgs     = 1;
         } elsif ( $CmdSwitch eq "help" || $CmdSwitch eq "usage" ) {
             $opt_help = 1;
             Usage();
         } else {
+        #
         #   If there are NO additive expressions in the alias, then
         #   assume all the active targets
+        #
         unless (keys %add) {
-            my %add = map { $_ => 1 } @BUILD_ACTIVEPLATFORMS;
+            %add = map { $_ => 1 } @BUILD_ACTIVEPLATFORMS;
+Debug0("Adding: @BUILD_ACTIVEPLATFORMS");
+        }
         foreach ( keys %remove) {
             delete $add { $_};
+        }
+        {
             $BUILDINFO{$word}{NOT_AVAILABLE} = 2;
             Debug("ProcessBuildExclude. Remove $word ");
         } else {
-            Warning('BuildExclude: Unknown target:' . $word )
+            abtWarning(0,'BuildExclude: Unknown target:' . $word )
+        }
+    }
+    ErrorDoExit();
+}
 #-------------------------------------------------------------------------------
 # Function        : BuildProduct
+#
     Log( "BUILDFILTER. " . PrintList([split(' ', $::GBE_BUILDFILTER)], $sep) ) if defined ($::GBE_BUILDFILTER);
     Log( "DPKG_STORE.. $::GBE_DPKG_STORE" );
     Log( "DPKG ....... $::GBE_DPKG" );
     Log( "DPKG_REPLI . $::GBE_DPKG_REPLICA" );
+    Log( "DPKG_ESCROW. $::GBE_DPKG_ESCROW" ) if $::GBE_DPKG_ESCROW;
     Log( "DPKG_CACHE . $::GBE_DPKG_CACHE" );
     Log( "DPKG_LOCAL . $::GBE_DPKG_LOCAL" );
     Log( "DPKG_SBOX .. $::GBE_DPKG_SBOX" );
     Log( "Sandbox .... Development" );
     Log( "LocalFilter. $::GBE_DPKG_SBOX/buildfilter") if ( $::GBE_DPKG_SBOX && -f $::GBE_DPKG_SBOX . '/buildfilter' );
     Debug( "Name:      $name" );
     Debug( "Version:   $version" );
     DataDirective("LinkPkgArchive");            # This directive allowed here
-#   if ( $IgnorePkgs )
+   if ( $IgnorePkgs )
-#   {
+   {
-#       Log( "LinkPkgArchive .. $name ($version) - Ignored" );
+       Log( "LinkPkgArchive .. $name ($version) - Ignored" );
-#       return;
+       return;
-#   }
+   }
+    #
     #   Ensure that we have do not have multiple definitions
+    #
     if ( PackageEntry::Exists( $name, $version ) )
     Log( "LinkPkgArchive .. $name ($version)" );
     my ($pkg, $local, $pkgSig ) = PackageLocate( $name, $version );
     if ( $pkg )
+    {
+        #
+        #   Create a Package Entry
+        #
+        my $entry = PackageEntry::New( $pkg, $name, $version, 'link', $local, $pkgSig );
+        #
         #   Generate package rules for each active platform
+        #
         IncludePkg ( $name, $pkg );
-        foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
+        foreach my $platform ( @BUILD_ACTIVEPLATFORMS ) {
-        {
-            LinkEntry( $platform, $pkg, $name, $version, 0, $local, $pkgSig );
+            LinkEntry( $platform, $entry );
+        }
+    }
+}
 #-------------------------------------------------------------------------------
     my $pkg;
     my $local = 1;
     my $sandbox = 1;
     my $isa_cache = 0;
     my $version;
-    my $pkgSig = 'Unknown';
+    my $pkgSig = 'MSG: No signature for ' . $name . '_' . $uversion;
     Debug( "PackageLocate: ($name/$uversion)" );
+    #
     #   If we are in a SandBox, then we use package signatures to locate pre-built
                        '--NotSandbox',
                        split( $::ScmPathSep, $::GBE_DPKG_LOCAL),
                        '--NotLocal',
                        split( $::ScmPathSep, $::GBE_DPKG_CACHE),
                        '--NotCache',
+                       split( $::ScmPathSep, $::GBE_DPKG_ESCROW),
+                       '--NotEscrow',
                        split( $::ScmPathSep, $::GBE_DPKG_REPLICA),
                        split( $::ScmPathSep, $::GBE_DPKG),
                        split( $::ScmPathSep, $::GBE_DPLY),
                        split( $::ScmPathSep, $::GBE_DPKG_STORE) )
+    {
         if ( $dpkg eq '--NotCache' )
+        {
             $isa_cache = 0;
             next;
+        }
+        if ( $dpkg eq '--NotEscrow' )
+        {
+            last if ($::GBE_DPKG_ESCROW);
+            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
     my $ifaceDir = catdir($::GBE_SANDBOX, 'sandbox_dpkg_archive', $name, $version . '.int');
     $ifaceDir = TagFileRead($ifaceDir);
     $ifaceDir =~ s~\\~/~g;
     $ifaceDir =~ s~GBE_SANDBOX/~$::GBE_SANDBOX/~;
     my $pkgSigFile = catfile( $ifaceDir, 'Package.sig');
+Debug0 ('SigFile:', $ifaceDir ,$pkgSigFile);
     # Temp: Remove when we no longer have package-versions
     return unless -f $pkgSigFile;
     Error("Package signature not found for $name/$version", "You must 'build' the package before using it")
         unless ( -f $pkgSigFile);
+    #
     #   Package not found
     #   This is an error, although it can be bypassed
+    #
-    Error ("Required package not found by signature: '$name/$version'" ) unless ( $NoPackageError );
+    Error ("Required package not found by signature: '$name/$version'", "Signature: $pkgSig" ) unless ( $NoPackageError );
     Log( "WARNING .... Package not available: '$name/$version'" );
     return;
+}
 # Description     : Scan a package an locate platform specific directories
 #                   Create data structures to capture the information
 #                   This function is used by LinkPkgArchive
 #                   to perfom the bulk of package inclusion work.
+#
-# Inputs          : platform being processed
+# Inputs          : $platform   - Platform being processed
-#                   path to the package
-#                   name of the package
-#                   version of the package
+#                   $entry      - Reference to a PackageEntry
-#                   sandbox support (non-zero)
-#                   local package
-#                   package Signature
+#
 sub LinkEntry
+{
-    my( $platform, $pkg, $name, $version, $sandbox, $local, $pkgSig ) = @_;
-    my( $entry );
+    my( $platform, $base_entry ) = @_;
-    #   Create entry record
+    #
+    #   Clone the entry - we will add platform specific data into it
-    #..
+    #
-    $entry = PackageEntry::New( $pkg, $name, $version, $sandbox, 'link', $local, $pkgSig );
+    my $entry = dclone($base_entry);
     #   Populate includes:
+    #
     #   - include/$platform                 (eg include/solaris)
     #   - inc/$platform                     (eg inc/solaris)
     #..
     my $parts = $BUILDINFO{$platform}{PARTS};
     foreach my $part ( @$parts )
+    {
-        $entry->RuleInc( "/include." . $part ) if ( !$sandbox );
+        $entry->RuleInc( "/include." . $part );
-        $entry->RuleInc( "/inc." . $part )     if ( !$sandbox );
+        $entry->RuleInc( "/inc." . $part );
-        $entry->RuleInc( "/include/" . $part ) if ( !$sandbox );
+        $entry->RuleInc( "/include/" . $part );
         $entry->RuleInc( "/inc/" . $part );
+    }
+    #
     #   Also search the root include directory - last
+    #
-    $entry->RuleInc( "/include" )               if ( !$sandbox );
+    $entry->RuleInc( "/include" );
     $entry->RuleInc( "/inc" );
     #   Populate libraries:
+    #
     #   - lib/lib.$platform[D|P]            (eg lib/lib.sparcD)
     #..
     $parts = $BUILDINFO{$platform}{PARTS};
     foreach my $part ( @$parts )
+    {
-        $entry->RuleLib("/lib" . ".$part" )     if ( !$sandbox );
+        $entry->RuleLib("/lib" . ".$part" );
-        $entry->RuleLib("/lib" . "/lib.$part" ) if ( !$sandbox );
+        $entry->RuleLib("/lib" . "/lib.$part" );
         $entry->RuleLib("/lib" . "/$part" );
+    }
+    #
     #   Some extra places to search
     Debug( "Name:      $name" );
     Debug( "Version:   $version" );
     DataDirective("BuildPkgArchive");           # This directive allowed here
-#   if ( $IgnorePkgs )
+   if ( $IgnorePkgs )
-#   {
+   {
-#       Log( "BuildPkgArchive . $name ($version) - Ignored" );
+       Log( "BuildPkgArchive . $name ($version) - Ignored" );
-#       return;
+       return;
-#   }
+   }
+    #
     #   Ensure that we have do not have multiple definitions
+    #
     if ( PackageEntry::Exists( $name, $version ) )
     if ( $pkg )
+    {
+        #
         #   Create a Package Entry
+        #
-        my $entry = PackageEntry::New( $pkg, $name, $version, 0, 'build', $local, $pkgSig );
+        my $entry = PackageEntry::New( $pkg, $name, $version, 'build', $local, $pkgSig );
+        #
         #   Determine if the package needs to be installed:
         #       If the package is a 'local' package then force transfer
         #       If the user has specified --cache then force transfer
+    }
     if ( $Clobber )                             # clobber mode ?
+    {
+        #
-        #   Unmake all the makefiles
-        #   No longer needed as we track the file that are created
-        #
-        #if ( -e "Makefile.gbe" )
-        #{
-        #    JatsTool ( 'jmake.pl', 'unmakefiles');
-        #}
-        #
         #   Delete my own configuration files
+        #
         DeleteCfg();
+        #
         BuildPackageLink();
         BuildSandboxData();
         return;
+    }
+    #
+    #   Generate the path to the descpkg file
+    #   The file is created later in the build proccess, but the makefile generation
+    #   needs to have a known path to the file.
+    #
+    #   It will be a file that is 'known' to JATS
+    #
+    $descpkgPath = BuildAddKnownFile ( $NoBuild ? $Cwd : $Srcdir, 'descpkg' );
     #.. Build support files
+    #
     DeleteCfg();
     BuildConfig();
     BuildSharedLibFiles();
     WriteParsedBuildConfig();
     BuildPackageLink();
     BuildSandboxData();
-    NoBuildMarker();
+    #
     #  ONLY (re)building interface dir
+    #
-    return
-        if ( $Interface );
+    unless ( $Interface ) {
-    #---------------------------------------------------------------------------
+        #---------------------------------------------------------------------------
-    #
+        #
-    #.. Make bootstrap "makefile",
+        #.. Make bootstrap "makefile",
-    #   Simulate a top level makefile
+        #   Simulate a top level makefile
-    #       Pass argumenst to makelib
+        #       Pass argumenst to makelib
-    #       Sumulate SubDir() operations
+        #       Sumulate SubDir() operations
-    #       Sumulate a Platform(*);
+        #       Sumulate a Platform(*);
-    #
+        #
-    #       Due to the normal way that makelib.pl is executed,
+        #       Due to the normal way that makelib.pl is executed,
-    #       the following substitutions are done.
+        #       the following substitutions are done.
-    #
+        #
-    @ARGV = ();
+        @ARGV = ();
-    $0 = "makefile.pl ";
+        $0 = "makefile.pl ";
-    push @ARGV, "$Cwd";                         # current working directory
+        push @ARGV, "$Cwd";                         # current working directory
-    push @ARGV, "$::GBE_TOOLS/makelib.pl";     # makelib.pl image
+        push @ARGV, "$::GBE_TOOLS/makelib.pl";      # makelib.pl image
-    push @ARGV, "--interface=$BUILDINTERFACE"
+        push @ARGV, "--interface=$BUILDINTERFACE"
-        if ($BUILDINTERFACE);
+            if ($BUILDINTERFACE);
-    Debug( "ARGV:      @ARGV" );
+        Debug( "ARGV:      @ARGV" );
-    #.. (re)Build root makefile
+        #.. (re)Build root makefile
-    #
+        #
-    $ScmBuildlib = 0;                           # clear Buildlib flag for 'makelib.pl'
+        $ScmBuildlib = 0;                           # clear Buildlib flag for 'makelib.pl'
-    RootMakefile();                             # inform 'makelib.pl'
+        RootMakefile();                             # inform 'makelib.pl'
-    MakeLibInit();                              # run initialisation
+        MakeLibInit();                              # run initialisation
-    #.. Register subdir(s)
+        #.. Register subdir(s)
-    #
+        #
-    UniquePush (\@BUILDSUBDIRS, $Srcdir );
+        UniquePush (\@BUILDSUBDIRS, $Srcdir );
-    SubDir( @BUILDSUBDIRS );
+        SubDir( @BUILDSUBDIRS );
-    Platform( @BUILD_ACTIVEPLATFORMS );
+        Platform( @BUILD_ACTIVEPLATFORMS );
-    #.. (re)build src makefiles and associated information
+        #.. (re)build src makefiles and associated information
-    #   JatsTool will not return on error
+        #   JatsTool will not return on error
-    #
+        #
-    my @cmds = ('jmake.pl', 'rebuild');
+        my @cmds = ('jmake.pl', 'rebuild');
-    push @cmds, 'NORECURSE=1' if ( $RootOnly );
+        push @cmds, 'NORECURSE=1' if ( $RootOnly );
-    JatsTool ( @cmds);
+        JatsTool ( @cmds);
+    }
+    #
     #   Generate package signature
+    #   Write the descpkg file again - with a signature this time
+    #
     ErrorConfig( 'name' => 'buildlib')   ;
     BuildSignature();
+    WriteDescpkg();
+    NoBuildMarker();
+    #
     #   Generate some warnings that will be seen at the end of the build
+    #
     Warning ("BuildSrcArchive Directive Present","Read JATS Manual for correct usage")
+#
 # Returns         :
+#
 sub BuildSignature
+{
-    my %sigExcludeDirs;
-    my %sigExcludeFiles;
-    my $BuildSignatureSha1;
-    my $signatureFile = catfile($Cwd, $BUILDINTERFACE, 'Package.sig');
-    my $sigDebugFile  = catfile($Cwd, $BUILDINTERFACE, 'Package.dsig');
-    my @sigList;
-    #
-    #   Only create the Signature file ONCE
-    #   Done on first build (after a clobber)
-    #
-#   if (-f $signatureFile)
-#   {
-#       Message("Generate Package Signature - Already generated");
-#       return;
-#   }
     Message("Generate Package Signature");
-    #
-    #   Determine if this is a GIT enabled sandbox build
-    #   Need a .git directory or file in the root of the sandbox
-    #
-    my $gitEnabled;
-    if ($::GBE_SANDBOX && -e catfile ($::GBE_SANDBOX, '.git') )
-    {
-        $gitEnabled = 1;
-    }
-    #
-    #   Start generating the signature
-    #       Include the package Name,Version and Project
+    #   Generate the package signature using the new method
-    #
-    $BuildSignatureSha1 = Digest::SHA::PurePerl->new;
-    $BuildSignatureSha1->add("PKGNAME: $BUILDNAME_PACKAGE $BUILDNAME_VERSION $BUILDNAME_SUFFIX");
-    push @sigList, "PKGNAME: $BUILDNAME_PACKAGE $BUILDNAME_VERSION $BUILDNAME_SUFFIX: " . $BuildSignatureSha1->clone->hexdigest;
-    #
-    #   Include the signature of ALL dependent packages
+    #       Quick parse the build and makefiles
-    #   Ie: The package signature is a function of the source and its dependents
-    #
-    foreach my $tag ( PackageEntry::GetPackageList() )
-    {
-        my $pkgSig = PackageEntry::GetPackageSignature($tag);
-        $BuildSignatureSha1->add("PKGSIGNATURE: $pkgSig");
-        push @sigList, sprintf("PKGSIGNATURE: [%s] %s: %s", PackageEntry::GetNameVersion($tag), $pkgSig , $BuildSignatureSha1->clone->hexdigest);
-    }
-    #
-    #   Save the signature of the package header and the dependencies
-    #   This will be used for a simple test to see in we need to rebuild the build file
+    #
-    my $depSha1 =  $BuildSignatureSha1->clone->hexdigest;
-    Debug2("DepSha1: $depSha1");
-    FileCreate( catfile($ScmInterface, 'build.bfp'), $depSha1 );
-    if ($gitEnabled)
-    {
-        #
-        #   Include the sha1 of all 'git' tree items that form the complete source image
-        #   Warn user if not all components are version controlled
-        #
-        my @relDirList = map { my $relName = $_; $relName =~ s~^$::GBE_SANDBOX/~~; $relName  } ToolsetFiles::GetSubTrees();
-        my @cmdList = map { 'HEAD:' . $_  } @relDirList;
-        Debug3(" GIT CMD: " . "git rev-parse", @cmdList );
-        #
-        #   Callback function to process the output of the Git parse
-        #   Expect one line for each HEAD: item
-        #
-        my $index = 0;
-        my @notControlled;
-        my $callback = sub {
-            my ($cdata, $line) = @_;
-            $line =~ s~\s+$~~;
-            Debug3(" GIT OUT: " . $line  );
-            if ($line =~ m~^HEAD:(.*)~) {
-                push @notControlled, $1;
-            }
-            $BuildSignatureSha1->add($line);
-            push @sigList, "PKGSRC: $relDirList[$index++]: $line: " . $BuildSignatureSha1->clone->hexdigest;
-            return 0;
-        };
-        my $rv = GitCmd('rev-parse', @cmdList, { process => $callback } );
-        Debug2("GitCmd Result: $rv");
-        $BUILDSIGNATURE =  $BuildSignatureSha1->hexdigest;
+    $BUILDSIGNATURE = JatsSignatureBuilder::GeneratePackageSignature ($Cwd, catfile($Cwd, $BUILDINTERFACE));
-        if (@notControlled) {
-            Warning('The folling paths are not version controlled:', @notControlled);
-        }
-    }
-    else
-    {
-        $BUILDSIGNATURE = 'MSG: Sandbox is not git enabled';
-    }
-    Message("Signature: $BUILDSIGNATURE");
-    push @sigList, "Signature: $BUILDSIGNATURE";
-    FileCreate( $signatureFile, $BUILDSIGNATURE );
-    FileCreate( $sigDebugFile, @sigList );
-Debug0("sigDebugFile: $sigDebugFile");
+    #
     #   See if the package exists in one of the package stores
     #   Look in each package archive directory
+    #
         if (-d $pkgDir ) {
             Message("PreBuild: $pkgDir");
             last;
+        }
+    }
-    #
-    #   Create the descpkg file - to include the signature
-    #
-    BuildDescpkg('Internal');
-}
-#-------------------------------------------------------------------------------
-# Function        : GitCmd
-#
-# Description     : Run a Git Command and capture/process the output
-#
-#                   Based on JatsSvnCore:SvnCmd
-#
-# Inputs          : Command
-#                   Command arguments
-#                   Last argument may be a hash of options.
-#                       nosavedata  - Don't save the data
-#                       process     - Callback function
-#                       printdata   - Print data
-#                       error       - Error Message
-#                                     Used as first line of an Error call
-#
-# Returns         : non-zero on errors detected
-#
-sub GitCmd
-{
-    my $self;           # Local storage
-    Debug ("GitCmd");
-    #
-    #   Locate essential tools
-    #
-    our $GBE_SVN_PATH;
-    EnvImportOptional('GBE_GIT_PATH', '');
-    Debug ("GBE_GIT_PATH", $::GBE_GIT_PATH);
-    my $stdmux = LocateProgInPath ( 'stdmux');
-    my $git    = LocateProgInPath ( 'git', '--All', '--Path=' . $::GBE_GIT_PATH );
-    #
-    #   Extract arguments and options
-    #   If last argument is a hash, then its a hash of options
-    #
-    my $opt;
-    $opt = pop @_
-        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH'));
-    $self->{PRINTDATA} = $opt->{'printdata'} if ( exists $opt->{'printdata'} );
-    Verbose2 "GitCmd $git @_";
-    #
-    # Useful debugging
-    #
-    # $self->{LAST_CMD} = [$svn, @_];
-    #
-    #   Reset command output data
-    #
-    $self->{ERROR_LIST} = [];
-    $self->{RESULT_LIST} = [];
-#    $self->{LAST_CMD} = \@_;
-    #
-    #   Make use of a wrapper program to mux the STDERR and STDOUT into
-    #   one stream (STDOUT). #   This solves a lot of problems
-    #
-    #   Do not use IO redirection of STDERR because as this will cause a
-    #   shell (sh or cmd.exe) to be invoked and this makes it much
-    #   harder to kill on all platforms.
-    #
-    #   Use open3 as it allows the arguments to be passed
-    #   directly without escaping and without any shell in the way
-    #
-    local (*CHLD_OUT, *CHLD_IN);
-    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, '>&STDERR', $stdmux, $git, @_);
-    #
-    #   Looks as though we always get a PID - even if the process dies
-    #   straight away or can't be found. I suspect that open3 doesn't set
-    #   $! anyway. I know it doesn't set $?
-    #
-    Debug ("Pid: $pid");
-    Error ("Can't run command: $!") unless $pid;
-    #
-    #   Close the input handle
-    #   We don't have anything to send to this program
-    #
-    close(CHLD_IN);
-    #
-    #   Monitor the output from the utility
-    #   Have used stdmux to multiplex stdout and stderr
-    #
-    #   Note: IO::Select doesn't work on Windows :(
-    #   Note: Open3 will cause blocking unless both streams are read
-    #         Can't read both streams because IO::Select doesn't work
-    #
-    #   Observation:
-    #       svn puts errors to STDERR
-    #       svn puts status to STDOUT
-    #
-    while (<CHLD_OUT>)
-    {
-        s~\s+$~~;
-        tr~\\/~/~;
-        Verbose3 ( "GitCmd:" . $_);
-        m~^STD(...):(.+)~;
-        my $data = $1 ? $2 : $_;
-        next unless ( $data );
-        if ( $1 && $1 eq 'ERR' )
-        {
-            #
-            #   Process STDERR output
-            #
-            push @{$self->{ERROR_LIST}}, $data;
-        }
-        else
-        {
-            #
-            #   Process STDOUT data
-            #
-            push @{$self->{RESULT_LIST}}, $data unless ($opt->{'nosavedata'});
-            #
-            #   If the user has specified a processing function then pass each
-            #   line to the specified function.  A non-zero return will
-            #   be taken as a signal to kill the command.
-            #
-            if ( exists ($opt->{'process'}) && $opt->{'process'}($self, $data) )
-            {
-                kill 9, $pid;
-                sleep(1);
-                last;
-            }
-        }
-    }
-    close(CHLD_OUT);
-    #
-    #   MUST wait for the process
-    #   Under Windows if this is not done then we eventually fill up some
-    #   perl-internal structure and can't spawn anymore processes.
-    #
-    my $rv = waitpid ( $pid, 0);
-    #
-    #   If an error condition was detected and the user has provided
-    #   an error message, then display the error
-    #
-    #   This simplifies the user error processing
-    #
-    if ( @{$self->{ERROR_LIST}} && $opt->{'error'}  )
-    {
-        Error ( $opt->{'error'}, @{$self->{ERROR_LIST}} );
-    }
-    #
-    #   Exit status has no meaning since open3 has been used
-    #   This is because perl does not treat the opened process as a child
-    #   Not too sure it makes any difference anyway
-    #
-    #
-    Debug ("Useless Exit Status: $rv");
-    my $result = @{$self->{ERROR_LIST}} ? 1 : 0;
-    Verbose3 ("Exit Code: $result");
-    return $result;
+}
 #-------------------------------------------------------------------------------
 # Function        : BuildVersion
+#
 # Description     : Generate version.c and version.h files
+#
 #                   The format of this file matches that generated by JANTS
 #                   Take care when extending the format
+#
 #                   NOTE: It turns out that JANTS is not a standard and the
 #                         implementors (of JANTS) kept on changing it.
+#
+#                   NOTE: This directive is now ignored
+#                         The descpkg file is generated internally
+#
 # Inputs          : $mode - 'Internal' - Skip sanity test
+#
 # Returns         :
+#
 sub BuildDescpkg
+{
-    my ($mode) = @_;
-    unless ($mode && $mode eq 'Internal')
-    {
-        StartBuildPhase();                  # Starting the build phase. No more data collection
+    StartBuildPhase();                  # Starting the build phase. No more data collection
-    }
+}
-    return if ( $Clobber );                 # clobber mode ?
+#-------------------------------------------------------------------------------
+# Function        : WriteDescpkg
-    #
+#
+# Description     : Create a package description file
-    #   Store the files location for use at runtime
+#                   The format of this file matches that generated by JANTS
-    #   It will be a file that is 'known' to JATS
+#                   Take care when extending the format
-    #
+#
-    my $pkgfile = BuildAddKnownFile ( $NoBuild ? $Cwd : $Srcdir, 'descpkg' );
+#                   NOTE: It turns out that JANTS is not a standard and the
+#                         implementors (of JANTS) kept on changing it.
+#
+# Inputs          :
+#
+# Returns         :
+#
+sub WriteDescpkg
+{
+    return if ( $Clobber );                 # clobber mode ?
     my @desc;
     push @desc, "Package Name:  $BUILDNAME_PACKAGE";
     push @desc, "Version:       $BUILDVERSION";
     push @desc, "Signature:     $BUILDSIGNATURE" if defined $BUILDSIGNATURE;
         push @attributes, "build=\"true\"" if $type =~ /Build/i;
         push @desc, "<sandbox @attributes/>";
+    }
-    FileCreate ($pkgfile, \@desc );
+    FileCreate ($descpkgPath, \@desc );
+}
 #-------------------------------------------------------------------------------
 # Function        : NoBuildMarker
+#
  Commands:
     clobber        - Remove generated build system (eg Makefiles).
     interface      - Only (re)build the interface tree.
     rootonly       - Only (re)build the root directory.
+    signature      - Create the packages signature
 =head1 OPTIONS
 =over 8
 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<signature>
+This command will only build, or rebuild, the 'interface' directory and
+the root-level makefiles. It will not process external packages.
+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.
+This option is provided to allow the packages signature to be calculated.
 =item B<clobber>
 This command will remove generated build system files and directories.
 =back

Subversion Repositories DevTools

(root)/core_devl/branches/gitBuilder/TOOLS/buildlib.pl – Rev 7312 → 7319