Subversion Repositories DevTools

Rev

Rev 7302 | Rev 7304 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
363 dpurdie 1
########################################################################
7300 dpurdie 2
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
227 dpurdie 3
#
4
# Module name   : buildlib.pl
5
# Module type   : Makefile system
363 dpurdie 6
# Compiler(s)   : Perl
7
# Environment(s): jats
227 dpurdie 8
#
363 dpurdie 9
# Description   : Process build.pl file and create the build environment
227 dpurdie 10
#
363 dpurdie 11
# Usage         : Refer to documentation at the end of the file
227 dpurdie 12
#
363 dpurdie 13
#......................................................................#
227 dpurdie 14
 
15
use strict;
16
use warnings;
17
 
363 dpurdie 18
use JatsError;
227 dpurdie 19
use BuildVersion;
20
use BuildName;
21
use PackageEntry;
22
use JatsEnv;
23
use JatsSystem;
24
use JatsVersionUtils;
25
use FileUtils;
6133 dpurdie 26
use ToolsetFiles;
227 dpurdie 27
use Pod::Usage;
261 dpurdie 28
use Getopt::Long;
305 dpurdie 29
use File::Path;
5969 dpurdie 30
use XML::Writer;
5986 dpurdie 31
use ArrayHashUtils;
7301 dpurdie 32
use File::Find;
33
use Digest::SHA qw(sha1);
34
use IPC::Open3;
227 dpurdie 35
 
36
our $BuildVersion           = "2.1.0";
37
 
38
#.. Switchs
39
#
40
our $ScmBuildlib            = 0;
41
our $ScmBuildSrc            = "";
42
 
43
our $CmdSwitch              = "";
44
our $Clobber                = 0;
45
our $Archive                = 0;
46
our $Interface              = 0;
47
our $RootOnly               = 0;
48
our $Perms                  = 0;
49
our $Expert                 = 0;
50
our $All                    = 0;
5109 dpurdie 51
our $Cache                  = $ENV{GBE_DPKG_CACHE_CTL} || 0;
261 dpurdie 52
our $NoPackageError         = 0;
227 dpurdie 53
our $ForceBuildPkg          = 0;
54
our $Srcdir                 = "";               # default source root
331 dpurdie 55
our $ForceBuild             = 1;
2078 dpurdie 56
our $IgnorePkgs             = 0;
4778 dpurdie 57
our $GenericBuild           = undef;            # Build System Generic Build Test
227 dpurdie 58
 
59
#.. Public symbols, referenced by many build.pl implementations
60
#
61
our $BUILDPREVIOUSVERSION   = "0.0.0";          # BuildPreviousVersion()
62
our @BUILDPLATFORMS         = ();               # BuildPlatforms()
63
our %BUILDINFO              = ();               # BuildInfo
64
our @DEFBUILDPLATFORMS      = ();
65
our %BUILDPLATFORMARGS      = ();
66
our @BUILD_ACTIVEPLATFORMS  = ();
67
our @BUILDSUBDIRS           = ();               # BuildSubDir()
68
our @BUILDSETENV            = ();               # BuildSetenv()
69
our $BUILDINTERFACE         = "";               # BuildInterface()
70
our $BUILDLOCAL             = "";               # BuildInterface()
71
our $BUILDDIRTREE           = "";               # BuildDirTree()
241 dpurdie 72
our @BUILD_BADNAME          = ();               # Unknown platforms
4551 dpurdie 73
our @GENERIC_TARGETS        = ();               # Generic targets - only one allowed    
227 dpurdie 74
 
75
our $BUILDNAME              = "";               # BuildName()
76
our $BUILDVERSION           = "";               # BuildName()
77
our $BUILDNAME_PACKAGE;                         # Name
78
our $BUILDNAME_VERSION;                         # Version
79
our $BUILDNAME_PROJECT;                         # Project(optional)
359 dpurdie 80
our $BUILDNAME_SUFFIX;                          # Project (available)
227 dpurdie 81
our $DEPLOY_PATCH           = 0;                # Deplyment patch number
7301 dpurdie 82
our $BUILDSIGNATURE;                            # Source signature
227 dpurdie 83
 
84
our %BUILDALIAS_DELAY       = ();               # Delayed aliases
85
our %BUILDALIAS_TARGETS     = ();               # BuildAlias from --Targets
86
our %BUILDALIAS             = ();               # BuildAlias
87
our %BUILDPRODUCT           = ();               # BuildProduct
88
our %BUILDPRODUCT_PARTS     = ();               # BuildProduct parts
89
our %PKGRULES               = ();               # Package include and link rules
90
our @BUILDTOOLS             = ();               # Extended tool path
91
our $BUILDPHASE             = 0;                # In Build Phase
92
our @CLOBBERDIRS            = ();               # Directories to clobber
375 dpurdie 93
our @REMOVEDIRS             = ();               # Directories to remove - if empty
247 dpurdie 94
our %BUILD_KNOWNFILES       = ();               # Files that will be known
5679 dpurdie 95
our @BUILDEXCLUDE           = ();               # Platforms to be excluded
227 dpurdie 96
 
333 dpurdie 97
our $Makelib                = "";
263 dpurdie 98
our $GBE_CORE;                                  # Root of JATS
99
our $InterfaceVersion;                          # Interface directory format version
3967 dpurdie 100
our $ScmRoot;                                   # Package Root
263 dpurdie 101
our $ScmInterface;                              # Interface directory
363 dpurdie 102
our $ScmBuildFilter;                            # Build Filter when build was created
4003 dpurdie 103
our $NoBuild                = 0;                # Dummy Build under ABT only
7300 dpurdie 104
our $BUILD_UUID             = time() . substr(rand(),2); # Build Unique Identifier
227 dpurdie 105
 
106
my  $DeleteDPACKAGE         = 0;                # Must clobber DPACKAGE
305 dpurdie 107
my  $build_source_pkg       = 0;                # Flag to build source package
227 dpurdie 108
my  $opt_help               = 0;
6133 dpurdie 109
my  $pkgFromSandbox         = 0;                # Flags that we have imported a package from a sandbox
227 dpurdie 110
 
6133 dpurdie 111
my  $genToolsetPlatform     = 0;                # BuildToolset directive has been seen
112
my  $genToolsetActive       = 0;                # TOOLSET platform required:1, Error:2
113
my  $toolsetPlatform        = 'NONE';           # TOOLSET Display Value
114
my  @genToolsetArgs;                            # Args for a generated TOOLSET
115
 
227 dpurdie 116
BuildLibInit();
117
 
118
sub BuildLibInit
119
{
120
 
121
#.. Set environment
122
#
331 dpurdie 123
    EnvImport( 'GBE_VERSION' );
124
    EnvImport( 'GBE_BIN' );
125
    EnvImport( 'GBE_CORE' );
126
    EnvImport( 'GBE_PERL' );
127
    EnvImport( 'GBE_TOOLS' );
128
    EnvImport( 'GBE_CONFIG' );
129
    EnvImport( 'GBE_DPKG' );
130
    EnvImport( 'GBE_MACHTYPE' );
131
    EnvImport( 'USER' );
132
    EnvImport( 'GBE_HOSTNAME');
133
    EnvImport( 'GBE_DRV' )
134
        if ( $ScmHost ne 'Unix' );            # DOS or WIN special
227 dpurdie 135
 
4688 dpurdie 136
    EnvImportOptional ( 'GBE_DPKG_REPLICA','' );
227 dpurdie 137
    EnvImportOptional ( 'GBE_DPKG_STORE','' );
138
    EnvImportOptional ( 'GBE_DPKG_CACHE','' );
139
    EnvImportOptional ( 'GBE_DPKG_LOCAL','' );
140
    EnvImportOptional ( 'GBE_DPKG_SBOX' ,'' );
313 dpurdie 141
    EnvImportOptional ( 'GBE_DPLY'      ,'' );
341 dpurdie 142
    EnvImportOptional ( 'GBE_SANDBOX'   ,'' );
227 dpurdie 143
 
144
    EnvImportOptional ( 'GBE_PLATFORM' );           # optional PLATFORM filter
145
    EnvImportOptional ( 'GBE_BUILDFILTER' );        # optional BUILD filter       
146
    EnvImportOptional ( 'GBE_ABT' );                # optional ABT flags          
147
 
148
#.. Common stuff
149
#
150
    require "$::GBE_TOOLS/common.pl";
331 dpurdie 151
    CommonInit( 'buildlib' );
227 dpurdie 152
    Debug( "Version:   $BuildVersion" );
279 dpurdie 153
    Require( "$::GBE_CONFIG/PLATFORM", "PLATFORM_CFG.PM"  );
227 dpurdie 154
 
155
#.. Parse command line
156
#
157
    $ScmBuildSrc = $0;                          # Name of the build file
331 dpurdie 158
    $Cwd = shift @ARGV;
227 dpurdie 159
    $Cwd =~ tr~\\/~/~s;;                        # Need / in path, Remove doubles
3967 dpurdie 160
    $::ScmRoot = StripDrive($Cwd);
333 dpurdie 161
    $Makelib = shift @ARGV;                     # Only for legacy build.pl files
227 dpurdie 162
 
261 dpurdie 163
    Verbose ("Command Line: @ARGV");
313 dpurdie 164
    my $result = GetOptions( "help|h:+"      => \$opt_help,
165
                             "man:3"         => \$opt_help,
166
                             "debug:+"       => \$::ScmDebug,
167
                             "verbose:+"     => \$::ScmVerbose,
168
                             "expert:1"      => \$Expert,
169
                             "all"           => \$All,
331 dpurdie 170
                             "cache:+"       => \$Cache,
313 dpurdie 171
                             "package"       => \$NoPackageError,
2078 dpurdie 172
                             "nopackages"    => \$IgnorePkgs,
313 dpurdie 173
                             "forcebuildpkg" => \$ForceBuildPkg,
331 dpurdie 174
                             "force!"        => \$ForceBuild,
4778 dpurdie 175
                             "generic!"      => \$GenericBuild,
313 dpurdie 176
                             );
261 dpurdie 177
    Usage() if ( $opt_help || !$result );
227 dpurdie 178
 
331 dpurdie 179
    Debug( "Host:          ", $ScmHost );
180
    Debug( "Cwd:           ", $Cwd );
333 dpurdie 181
    Debug( "Makelib:       ", $Makelib );
331 dpurdie 182
    Debug( "BuildFile:     ", $ScmBuildSrc );
183
    Debug( "Debug:         ", $::ScmDebug );
184
    Debug( "Verbose:       ", $::ScmVerbose );
185
    Debug( "Expert:        ", $Expert );
186
    Debug( "All:           ", $All );
187
    Debug( "Cache:         ", $Cache );
188
    Debug( "package:       ", $NoPackageError );
189
    Debug( "ForcePkg  :    ", $ForceBuildPkg );
190
    Debug( "ForceBuild :   ", $ForceBuild );
4778 dpurdie 191
    Debug( "IgnorePkgs :   ", $IgnorePkgs );
192
    Debug( "GenericTest :  ", $GenericBuild );
227 dpurdie 193
 
194
#.. Command
195
#
3967 dpurdie 196
 
197
    $CmdSwitch = (lc shift @ARGV) if @ARGV;
331 dpurdie 198
    Debug( "CmdSwitch:     ", $CmdSwitch );
227 dpurdie 199
 
331 dpurdie 200
    if ( $CmdSwitch )
201
    {
202
        if ( $CmdSwitch eq "interface" ) {
203
            $Interface      = 1;
227 dpurdie 204
 
331 dpurdie 205
        } elsif ( $CmdSwitch eq "rootonly" ) {
206
            $RootOnly       = 1;
227 dpurdie 207
 
331 dpurdie 208
        } elsif ( $CmdSwitch eq "clobber" ) {
209
            $Clobber        = 1;
227 dpurdie 210
 
331 dpurdie 211
        } elsif ( $CmdSwitch eq "help" || $CmdSwitch eq "usage" ) {
212
            $opt_help = 1;
213
            Usage();
227 dpurdie 214
 
331 dpurdie 215
        } else {
216
            Usage( "(E) build. Unknown command \"$CmdSwitch\"" );
217
        }
218
    }
227 dpurdie 219
 
331 dpurdie 220
    #
341 dpurdie 221
    #   If we are not performing a ForceBuild, then we don't need to continue
222
    #   We have updated the interface directory with BuildPkgArchive
223
    #   information.
331 dpurdie 224
    #
341 dpurdie 225
    unless ( $::GBE_SANDBOX )
331 dpurdie 226
    {
341 dpurdie 227
        TestForForcedBuild();
227 dpurdie 228
    }
229
 
230
    #
231
    #   Must inform makelib that its running under buildlib
232
    #
233
    $ScmBuildlib = 1;
234
 
235
    #
236
    #   In clobber mode System commands will not force termination
237
    #   otherwise, within build.pl, a failed system command will die.
238
    #
239
    SystemConfig ('UseShell' => 1,
283 dpurdie 240
                  'ExitOnError' => ($Clobber == 0) );
5109 dpurdie 241
 
242
    #
243
    #   Capture messages while processing directives
244
    # 
245
    StartCapture(1) 
246
        unless ($Clobber);
227 dpurdie 247
}
248
 
249
 
250
#-------------------------------------------------------------------------------
251
# Function        : Log
252
#
253
# Description     : Internal function to generate a log file of the build process
341 dpurdie 254
#                   The function will print its arguments to the screen and a log file
227 dpurdie 255
#
256
# Inputs          : Arguments will be printed
257
#
258
# Returns         : Nothing
259
#
260
sub Log
261
{
262
    if ( ! $Clobber )
263
    {
261 dpurdie 264
        print "@_\n";
265
        FileAppend ('build.log', \@_ );
227 dpurdie 266
    }
267
}
268
 
269
#-------------------------------------------------------------------------------
270
# Function        : BuildSubDir
271
#
272
# Description     : Specify one or more directories in which makefile.pl's can be
273
#                   found to be processed.
274
#
275
#                   This function will flag the build 'src' dir.
276
#                   This will be the first directory specified UNLESS there
277
#                   is a 'src' directory in the list
278
#
279
#                   The function may be called multiple times.
280
#
281
# Inputs          : NewDirs             - An array of directories
282
#
283
# Returns         : Nothing
284
#
285
 
286
sub BuildSubDir
287
{
288
    my( @NewDirs );
289
 
290
    @NewDirs = map { split /\s+/ } @_;
291
    @NewDirs = grep { defined $_ } @NewDirs;
292
 
293
    Debug( "BuildSubDir(@NewDirs)" );
294
 
295
    foreach my $ThisDir ( @NewDirs )
296
    {
297
        unless ( $Clobber )
298
        {
2450 dpurdie 299
            $ThisDir =~ s~/+$~~;
227 dpurdie 300
            if ( $ThisDir eq "." )
301
            {
302
                Error( "BuildSubDir() cannot specify the current directory (.)",
303
                       "The makefile.pl in the root directory is included in all makefile.pl's" );
304
            }
305
 
306
            if ( $ThisDir =~ m~\\~)
307
            {
308
                Warning ("BuildSubDir contains a '\\' character: $ThisDir" );
309
            }
310
            if ( grep /^$ThisDir$/, @BUILDSUBDIRS )
311
            {
312
                Warning( "BuildSubDir() duplicate subdirectory ignored '$ThisDir'." );
313
                next;
314
            }
315
            if ( ! ( -e $ThisDir and -d $ThisDir ) )
316
            {
317
                Error( "BuildSubDir() non-existent subdirectory: '$ThisDir'." );
318
            }
319
            if ( ! -f $ThisDir . '/makefile.pl' )
320
            {
321
                Error( "BuildSubDir() makefile.pl not found in subdirectory: '$ThisDir'." );
322
            }
323
 
324
            push( @BUILDSUBDIRS, $ThisDir );
325
        }
326
 
327
        #
328
        #   Capture the first source directory mentioned
329
        #   This will be used as the root of the build
330
        #
331
        #   If there is a Src directory then use this
332
        #
333
        $Srcdir = $ThisDir
334
            if ( $ThisDir =~ m/^src$/i );
335
        $Srcdir = $ThisDir
336
            unless ( $Srcdir );
337
    }
338
}
339
 
340
#-------------------------------------------------------------------------------
6133 dpurdie 341
# Function        : isKeyword 
342
#
343
# Description     : Test for an attempt to use reserved platform name 
344
#
345
# Inputs          : $test   - Name to test
346
#
347
# Returns         : Reserved word or none
348
#
349
sub isKeyword
350
{
351
    my ($test) = @_;
7300 dpurdie 352
    foreach my $keyword ( qw (NATIVE TOOLSET GENERIC INSTRUMENT PKG_DEB PKG_RPM PRG_WIN))
6133 dpurdie 353
    {
354
        return $keyword if (uc($test) eq $keyword);
355
    }
356
 
357
    return undef;
358
}
359
 
360
 
361
#-------------------------------------------------------------------------------
227 dpurdie 362
# Function        : BuildAlias
363
#
364
# Description     : Create an alias for multiple targets
365
#                   The default operations will:
366
#                       Add the alias as a default platform (* in the makefile.pl)
367
#                       Perform an implicit BuildPlatform for the alias targets
368
#
369
#                   In hindsight this was not good. Options modify the behaviour
370
#                   Options:
371
#                       --NotDefault    The alias will not be a part of the default
372
#                                       platform for the makefile.pls
373
#                       --Define        Simply define text substitution
374
#                                       Do not implicitly create platforms
375
#                       --Target        Accumulate platforms with specified targets
376
#                                       Complete alias determination is delayed
377
#                                       The named targets are specified as an alias
378
#                                       until the calculation is done
379
#
380
# Inputs          : alias[,--options]   comma seperated options
381
#                   arguments           alias arguments; platforms or targets
382
#
383
# Returns         : Nothing
384
#
385
sub BuildAlias
386
{
387
    my( $alias, @arguments ) = @_;
388
    my $notdefault;
389
    my $define;
390
    my $target_mode;
391
 
392
    Debug( "BuildAlias($alias, @arguments)" );
393
    Error ("BuildAlias: No platforms specified") unless ( @arguments );
394
    Error( "BuildAlias() must appear before BuildName()..." ) if ( $BUILDNAME );
395
 
396
    #   Parse attributes
397
    #
398
    my ( @attrs ) = split( ',', $alias );
399
 
400
    $alias = "";
401
    foreach ( @attrs ) {
402
        if ( /^--/ ) {
403
            if ( /^--NotDefault$/ ) {
404
                $notdefault = 1;
405
 
406
            } elsif ( /^--Define$/ ) {
407
                $define = 1;
408
 
409
            } elsif ( /^--Target$/ ) {
410
                $target_mode = 1;
411
 
412
            } else {
413
                Warning( "BuildAlias() unknown attribute: $_ -- ignored" );
414
            }
415
 
416
        } else {
5262 dpurdie 417
            Error( "BuildAlias() multiple alias specifications", "First: $alias and now $_" )
227 dpurdie 418
                if ( $alias ne "" );
419
            $alias = $_;
420
        }
421
    }
422
    Error( "BuildAlias() missing alias specifications" )
423
        if ( $alias eq "" );
424
 
6133 dpurdie 425
    Error ("BuildAlias() attempt to alias a keyword: $alias")
426
        if ( isKeyword($alias) );
227 dpurdie 427
 
428
    #
429
    #   If we need to recalculate the alias based on targets, then tag the alias
430
    #   to be processed
431
    #
432
    $BUILDALIAS_TARGETS{ $alias } = ''
433
        if ( $target_mode );
434
 
435
    #   Define alias
436
    #
6133 dpurdie 437
    if ( PlatformConfig::targetHasTag($alias, 'GENERIC') )
227 dpurdie 438
    {
4551 dpurdie 439
        Error( "BuildAlias() cannot create an alias named $alias", "That name is reserved for generic targets" );
227 dpurdie 440
    }
441
    elsif ( $alias ne quotemeta( $alias ) )
442
    {
6133 dpurdie 443
        Error   ("BuildAlias() alias '$alias' contains invalid characters") unless defined($::GBE_ABT);
227 dpurdie 444
        Warning( "BuildAlias() alias '$alias' contains invalid characters -- ignored" );
445
    }
446
    elsif ( $BUILDALIAS{ $alias } )
447
    {
6133 dpurdie 448
        Error   ("BuildAlias() duplicate alias '$alias'") unless defined($::GBE_ABT);
227 dpurdie 449
        Warning( "BuildAlias() duplicate alias '$alias' -- alias ignored" );
450
    }
451
    else
452
    {
453
        #
454
        #   Expand alias UNLESS using --Target.
455
        #   The --Target is a real target and not a subject to alias expansion
456
        #   This solves order dependancy problems.
457
        #
458
        @arguments = ExpandPlatforms( @arguments )
459
            unless $target_mode;
460
 
6133 dpurdie 461
        my $platform = '';                   # current platform
227 dpurdie 462
        my @pargs = ();                      # current args
463
 
464
        #
465
        #   Process the expanded arguments
466
        #   Collect arguments and process when a new platform is discovered
467
        #
468
        foreach my $arg ( @arguments, '++' )
469
        {
470
            if ( $arg =~ /^--/ )
471
            {
472
                push @pargs, $arg;
473
                next;
474
            }
475
            else
476
            {
477
                #
478
                #   Start of a platform
479
                #   Process previous data, once a platform has been seen
480
                #
481
                if ( $platform )
482
                {
483
                    #   Add arguments to BUILDALIAS as we see them
484
                    #
485
                    HashJoin( \%BUILDALIAS, ' ', $alias, $platform );
486
                    HashJoin( \%BUILDALIAS, ' ', $alias, grep(!/^--Uses=/, @pargs) );
487
 
488
                    #
489
                    #   The BuildAlias can also define a platform.
490
                    #   (Sounded like a good idea at the time!)
491
                    #
492
                    unless ( $define || $target_mode )
493
                    {
494
                        push @pargs, '--NotDefault' if ( $notdefault );
495
                        push @pargs, '--FunctionName=BuildAlias';
496
                        BuildPlatforms( $platform, @pargs );
497
                    }
498
                }
499
 
500
                #
501
                #   Start collecting args for the next platform
502
                #
503
                @pargs = ();
504
                $platform = $arg;
505
            }
506
        }
507
    }
508
}
509
 
6133 dpurdie 510
#-------------------------------------------------------------------------------
511
# Function        : BuildAliasDef  
512
#
513
# Description     : Shorthand for BuildAlias (xxx,-Define, ... )
514
#                   The way is should have been done  :(
515
#
516
# Inputs          : $alias          Name of alias to define
517
#                   arguments       Alias arguments; platforms or targets
518
#
519
sub BuildAliasDef()
520
{
521
    my( $alias, @arguments ) = @_;
522
    BuildAlias($alias . ',--Define', @arguments);
523
}
227 dpurdie 524
 
525
#-------------------------------------------------------------------------------
526
# Function        : Process_TargetAlias
527
#
528
# Description     : Post Process the --Target option for the build alias
529
#                   Filter all platforms and extract those with a matching targets
530
#
531
# Inputs          : None
532
#
533
# Returns         : Nothing
534
#
535
sub Process_TargetAlias
536
{
537
 
538
    #
539
    #   Merge any delayed aliases with the complete set of alias
540
    #   Delayed alias are not used in expansions during the processing
5410 dpurdie 541
    #   of platforms and targets, but can be used to pick up errors
227 dpurdie 542
    #
543
    while ( my($key,$value) = each(%BUILDALIAS_DELAY) )
544
    {
545
        if ( exists($BUILDALIAS{$key}) )
546
        {
5867 dpurdie 547
            abtWarning(0,"BuildAlias() duplicates internal alias '$key'");
227 dpurdie 548
            next;
549
        }
550
        $BUILDALIAS{$key} = $value;
551
    }
5410 dpurdie 552
    ErrorDoExit();
227 dpurdie 553
 
554
    foreach my $alias ( keys %BUILDALIAS_TARGETS )
555
    {
556
        Debug( "BuildTargetAlias($alias)" );
557
 
558
        #
559
        #   Replace the existing alias - it has done its JOB
560
        #
561
        my $arguments = delete $BUILDALIAS{ $alias } ;
562
 
563
        foreach my $arg ( split / /, $arguments )
564
        {
565
            if ( $arg =~ /^--/ )                # argument
566
            {
567
                #   Add arguments to BUILDALIAS as we see them
568
                #
569
                HashJoin( \%BUILDALIAS, ' ', $alias, $arg );
570
                next;
571
            }
572
 
573
            foreach my $platform ( keys %BUILDINFO )
574
            {
575
                foreach my $element ( qw (TARGET BASE ) )
576
                {
577
                    my $target = $BUILDINFO{$platform}{$element};
578
                    if ( $target && $target eq $arg )
579
                    {
580
                        HashUniqueJoin( \%BUILDALIAS, ' ', $alias, $platform );
581
                        Debug( "BuildTargetAlias: $alias, $target -> $platform" );
582
                    }
583
                }
584
            }
585
        }
586
    }
587
}
588
 
589
#-------------------------------------------------------------------------------
6133 dpurdie 590
# Function        : CleanUp_Aliases 
591
#
592
# Description     : Will fully expand aliases to simplify display and processing 
593
#                       Remove arguments that  start with a '-'
594
#                       Remove bits that start with a !
595
#
596
# Inputs          : 
597
#
598
# Returns         : 
599
#
600
sub CleanUp_Aliases
601
{
602
    #
603
    #   Clean up Aliases
604
    #
605
#DebugDumpData("BEFORE CleanUp_Aliases", \%BUILDALIAS);
606
    foreach my $alias ( keys %BUILDALIAS )
607
    {
608
        my @aliasList = split(/ /, $BUILDALIAS{$alias});
609
        my @expanded =  ExpandPlatforms(@aliasList);
610
 
611
        my %add;
612
        my %remove;
613
 
614
        foreach ( @expanded)
615
        {
616
            if (m/^-/) {
617
            } elsif (m/^!(.*)/) {
618
                $remove{$1} = 1;
619
            } else {
620
                $add{$_} = 1;
621
            }
622
        }
623
 
624
        #
625
        #   If there are NO additive expressions in the alias, then
626
        #   assume all the active targets
627
        #
628
        unless (keys %add) {
629
            foreach  ( @BUILD_ACTIVEPLATFORMS)
630
            {
631
                 $add{$_} = 1;
632
            }
633
        }
634
 
635
 
636
        foreach ( keys %remove) {
637
            delete $add { $_};
638
        }
639
 
640
        $BUILDALIAS{$alias} = join(' ',keys %add);
641
    }
642
#DebugDumpData("AFTER CleanUp_Aliases", \%BUILDALIAS);
643
}
644
 
645
 
646
#-------------------------------------------------------------------------------
227 dpurdie 647
# Function        : BuildProduct
648
#
649
# Description     : Create a family of Platforms with a common product line
650
#                   ie: Create two flavors of the TP5, one based on the MOSF and
651
#                   the othe based on the MOS68 toolset.
652
#
653
# Inputs          : $product[,opts]+    The name of the product
654
#                                       This will be the base name for the family
655
#                                       Allowed options are:
656
#                                           --NotDefault    : This is not a default build platform
657
#                                           --Uses=xxx      : All use another platform
5115 dpurdie 658
#                                           --Alias=yyy     : All alias to this name
227 dpurdie 659
#
660
#                   platforms           One or more root platforms, with options
661
#                                       The platform is macro expanded.
662
#                                       Options may be a part of the platform or
663
#                                       distinct.
664
#
665
# Returns         :
666
#
667
 
668
sub BuildProduct
669
{
670
    my( $product, @arguments ) = @_;
671
    my $notdefault = 0;
672
    my @uses = ();
5115 dpurdie 673
    my @alias = ();
227 dpurdie 674
 
675
    Debug( "BuildProduct($product, @arguments)" );
676
    Error( "BuildProduct must appear before BuildName()..." )
677
        if ( $BUILDNAME ne "" );
678
 
679
    #   Parse attributes
680
    #
681
    my( @attrs ) = split( ',', $product );
682
 
683
    $product = "";
684
    foreach ( @attrs ) {
685
        if ( /^--/ ) {
686
            if ( /^--NotDefault$/ ) {
687
                $notdefault++;
688
 
689
            } elsif ( /^--Uses=(.*)/ ) {
690
                UniquePush (\@uses, $1);
691
 
5115 dpurdie 692
            } elsif ( /^(--Alias=.*)/ ) {
693
                UniquePush (\@alias, $1);
694
 
227 dpurdie 695
            } else {
696
                Warning( "BuildProduct() unknown attribute: $_ -- ignored" );
697
            }
698
 
699
        } else {
700
            Error( "BuildProduct() multiple product specifications not allowed" )
701
                if ( $product ne "" );
702
            $product = $_;
703
        }
704
    }
705
 
706
    #
707
    #   Sanity test
708
    #
709
    Error( "BuildProduct() missing product specifications" )
710
        if ( $product eq "" );
711
 
712
    Error( "BuildProduct() product '$product' contains invalid characters" )
713
        if ( $product ne quotemeta( $product ) );
714
 
715
    Error( "BuildProduct() duplicate product '$product'" )
716
        if ( $BUILDPRODUCT{ $product } );
717
 
718
    Error( "BuildProduct() duplicate alias '$product'" )
719
        if ( $BUILDALIAS{ $product } );
720
 
721
    #
722
    #   Expand the user specified targets to allow the use of BuildAlias
723
    #   The (bad) side effect of this is that target options get reorganised
724
    #       PLATFORM,--Uses=ANOTHER  ==> PLATFORM --Uses=ANOTHER
725
    #
726
    #   Insert markers(++) into @aruments to mark when to process collected data
727
    #   Insert before each PLATFORM and at the end of the list
728
    #   platform specifier or the end of the list. Scan the arguments
729
    #
730
    @arguments = ExpandPlatforms( @arguments );
731
    my @new_args;
732
    foreach  ( @arguments )
733
    {
734
        push (@new_args, '++') unless ( m/^--/ );
735
        push (@new_args, $_ );
736
    }
737
    push (@new_args, '++');
738
    shift @new_args if $new_args[0] eq '++';
739
 
5115 dpurdie 740
    my @targs = @alias;
227 dpurdie 741
    my $target;
742
    my @tuses = @uses;
743
    foreach my $arg ( @new_args )
744
    {
745
        #
746
        #   Collect per-platform arguments
747
        #
748
        if ( $arg =~ /^--Uses=(.*)/ ) {
749
            UniquePush (\@tuses, $1);
750
            next;
751
 
752
        } elsif ( $arg =~ /^--/ ) {
753
            push @targs, $arg;
754
            next;
755
        }
756
 
757
        #
758
        #   Collect target(platform) name
759
        #
760
        unless ( $arg eq '++' )
761
        {
762
            $target = $arg;
763
            Error( "BuildProduct() cannot create a product based on a GENERIC platform" )
6133 dpurdie 764
                if ( PlatformConfig::targetHasTag($target,'GENERIC') );
227 dpurdie 765
            next;
766
        }
767
 
768
        #
769
        #   Infer a BuildPlatform
770
        #   Do not provide a platform name. This will be created later when the
771
        #   full name is known - or can be calculated.
772
        #
773
        CreateBuildPlatformEntry('BuildProduct', $notdefault, $product, $target, \@tuses, \@targs );
774
 
5115 dpurdie 775
        @targs = @alias;
227 dpurdie 776
        @tuses = @uses;
777
        $target = undef;
778
    }
779
}
780
 
781
#-------------------------------------------------------------------------------
782
# Function        : CreateBuildPlatformEntry
783
#
784
# Description     : Internal routine to create the Build Entry
785
#                   Single point to create a platform, whatever one of those is
786
#
787
# Inputs          : $fname                  - Name of invoking directive
788
#                   $notdefault             - True if the platform is not to be added to the
789
#                                             list of default platforms
790
#                   $product                - Optional product name
791
#                   $target                 - Target platform name
792
#                   $pUses                  - Ref to an array of 'Uses'
793
#                   $pArgs                  - Ref to an array of platform arguments
794
#
795
# Returns         :
796
#
797
 
798
sub CreateBuildPlatformEntry
799
{
800
    my ($fname, $notdefault, $product, $target, $pUses, $pArgs ) = @_;
801
    my %buildentry;
802
    my $platform;
803
 
804
    #
805
    #   Create a basic BUILDINFO entry
806
    #
807
    $buildentry{FNAME} = $fname;
808
    $buildentry{NOT_DEFAULT} = $notdefault;
809
    $buildentry{PRODUCT} = $product;
810
    $buildentry{TARGET} = $target;
811
    $buildentry{BASE} = $target;
812
    $buildentry{USES} = [ @$pUses ] if $pUses;
363 dpurdie 813
    foreach ( @$pArgs )
814
    {
815
        if ( m~^--Alias=(.+)~ ) {
6133 dpurdie 816
            foreach my $alias (split(',',$1))
817
            {
818
                Error ("$fname() attempt to alias a keyword: $alias")
819
                    if ( isKeyword($alias) );
820
                push @{$buildentry{USERALIAS}},$alias;
821
            }
822
        } else {
363 dpurdie 823
            push @{$buildentry{ARGS}}, $_;
824
        }
825
    }
227 dpurdie 826
 
4728 dpurdie 827
    #   Detect reserved words being misused as a platform name
6133 dpurdie 828
    #   At the moment, the value of NATIVE and TOOLSET are calculate towards the end of the
829
    #   build process so that it can be limited to platforms that are present.
830
    foreach my $reserved ( qw (NATIVE TOOLSET INSTRUMENT))
831
    {
832
        Error("Invalid use of the platform alias $reserved","The $reserved alias cannot be used to define build platforms")
833
            if (uc($target) eq uc($reserved));
834
    }
4728 dpurdie 835
 
227 dpurdie 836
    #
837
    #   Allow per-platform processing to be alter the basic information
838
    #   Special processing may be perform to extend the information
839
    #   Allows special processing to be enabled on a per-target basis
840
    #
841
    #   There are three forms of processing that have been allowed for:
842
    #       1) None:        There is not platform specific extension
843
    #       2) Basic:       The extension will add or extend build information
844
    #       3) Advanced:    The extension will generate additional build information
845
    #                       structures.
846
    #
847
 
848
    #
849
    #   Locate the optional PLATFORM configuration file
850
    #   If it does exist then it can alter build-time information
851
    #
852
    if ( my $build_cfg = Require( "$::GBE_CONFIG/PLATFORM", "$target.cfg"  ) )
853
    {
854
        Verbose ("Processing(new) Platform Configuration file: $build_cfg");
855
 
297 dpurdie 856
        #
303 dpurdie 857
        #   Create package name with an uppercase target
858
        #   Target should be UC, but under windows its not detected
859
        #   at this time
860
        #
861
        my $package_name = uc($target) . '_Build';
862
 
863
        #
4551 dpurdie 864
        #   Ensure that the CFG is correctly formed
297 dpurdie 865
        #       Perhaps the package that it implements was misnamed
866
        #
303 dpurdie 867
        Error ("INTERNAL: $target.cfg does not satisfy API " )
297 dpurdie 868
            unless ( $package_name->can('new_platform') || $package_name->can('add_platform') );
869
 
227 dpurdie 870
        if ( $package_name->can('new_platform') )
871
        {
872
            Verbose ("Processing(new) Platform Configuration: $package_name");
873
            $package_name->new_platform( \%buildentry );
874
        }
875
        else
876
        {
877
            Debug ("Processing(new) Platform Configuration: $package_name. 'new_platform' function not found");
878
        }
879
    }
880
 
881
    #
882
    #   Add the basic entry into the build system, unless its been
883
    #   flagged as a TEMPLATE
884
    #
885
    AddBuildPlatformEntry (\%buildentry )
886
        unless ( $buildentry{TEMPLATE} );
887
}
888
 
889
 
890
#-------------------------------------------------------------------------------
891
# Function        : AddBuildPlatformEntry
892
#
893
# Description     : Internal routine to add a Build Entry into the build system
894
#                   This function MAY be called from the build extensions
895
#
896
#                   NOTES:
897
#                   No processing of the info structure is performed. This MUST
898
#                   have been done before now.
899
#
900
#                   Additional information may be added to the structure.
901
#
902
#
903
# Inputs          : $pInfo              - Reference to a BuildInfo structure
904
#
905
# Returns         : Nothing
906
#
907
sub AddBuildPlatformEntry
908
{
909
    my ($pInfo) = @_;
910
    my $fname = $pInfo->{FNAME};
911
 
912
    #
913
    #   Locate the optional PLATFORM configuration file
914
    #   If it does exist then it can extend build-time information
915
    #
916
    my $target = $pInfo->{TARGET};
241 dpurdie 917
 
279 dpurdie 918
    #
919
    #   Yukky Kludge
920
    #   JATS has a mechanism whereby packages can create new platforms
921
    #   Luckily this has only been done for LMOS - don't every do it again
922
    #   One problem is that we can't validate the target name at this point
923
    #   in time: as the packages are loaded much later.
924
    #
925
    #   Kludge. Assume that a leading LMOS_ can be removed when determing
926
    #           validity of the target platform.
927
    #
928
    my $base_target = $target;
929
    $base_target =~ s~^LMOS_~~;
241 dpurdie 930
 
279 dpurdie 931
    #
4551 dpurdie 932
    #   Detect GENERIC targets
933
    #       The Build file is only allowed to have one that can be built on any one machine
934
    #
6133 dpurdie 935
    my $buildAvailability = PlatformConfig::targetHasTag( $base_target, 'KNOWN' );
936
    if (PlatformConfig::targetHasTag( $base_target, 'GENERIC' ) )
4551 dpurdie 937
    {
938
        UniquePush (\@GENERIC_TARGETS, $target );
6133 dpurdie 939
    }
940
 
941
    #
942
    #   Detect GENERIC_<machType> targets
943
    #
944
    if (PlatformConfig::targetHasTag( $base_target, 'GENERIC_MACHTYPE' ) )
945
    {
4551 dpurdie 946
        $pInfo->{IS_GENERIC} = 1;
6133 dpurdie 947
        $pInfo->{ALIAS} = 'GENERIC';
948
        $pInfo->{NOT_AVAILABLE} = 1 unless needToolset();
949
        $All = 1;
4551 dpurdie 950
    }
951
 
952
    #
279 dpurdie 953
    #   Ensure target is known to JATS
954
    #   Remove unknown targets from the build. Create a list of unknown
955
    #   targets and report them later.
956
    #
957
    #   If there are signs that the target has been processed, then it may be
958
    #   an alias that has not been expanded.
959
    #
960
    #   One result will be that alias platforms, such as DEVLINUX, that don't
961
    #   expand on WIN32 will be shown as DEVLINUX and not its components.
962
    #
6133 dpurdie 963
    unless ( $pInfo->{NOT_AVAILABLE} || exists $BUILDINFO{$target} || $pInfo->{IS_GENERIC} || ($base_target =~ m~^GENERIC_~) )
227 dpurdie 964
    {
279 dpurdie 965
        unless ( Exists( "$::GBE_CONFIG/PLATFORM", $base_target  ) )
966
        {
6133 dpurdie 967
            UniquePush (\@BUILD_BADNAME, $target ); 
279 dpurdie 968
            $pInfo->{NOT_AVAILABLE} = 1;
969
        }
970
    }
971
 
972
    #
4551 dpurdie 973
    #   Mark as NOT_AVAILABLE platforms that are not available on this machine
279 dpurdie 974
    #
975
    unless ($pInfo->{NOT_AVAILABLE} )
976
    {
977
        $pInfo->{NOT_AVAILABLE} = 1
4551 dpurdie 978
            if ($buildAvailability == 0 )
279 dpurdie 979
    }
980
 
981
    unless ($pInfo->{NOT_AVAILABLE} )
982
    {
4551 dpurdie 983
        my $target_cfg = $pInfo->{TARGET_CFG} || $target;
317 dpurdie 984
        if ( my $build_cfg = Require( "$::GBE_CONFIG/PLATFORM", "${target_cfg}.cfg"  ) )
227 dpurdie 985
        {
986
            Verbose ("Processing(add) Platform Configuration file: $build_cfg");
317 dpurdie 987
            my $package_name = "${target_cfg}_Build";
227 dpurdie 988
 
989
            if ( $package_name->can('add_platform') )
990
            {
991
                Verbose ("Processing(add) Platform Configuration: $package_name");
992
                $package_name->add_platform( $pInfo );
993
            }
994
            else
995
            {
996
                Debug ("Processing(add) Platform Configuration: $package_name. 'add_platform' function not found");
997
            }
998
        }
999
    }
1000
 
1001
    #
1002
    #   If a product name has been provided then the platform is a product
1003
    #   and will need additional processing
1004
    #
1005
    if ( $pInfo->{PRODUCT} )
1006
    {
1007
        #
1008
        #   Create the platform name. Derived from the product and the target
1009
        #
1010
        $pInfo->{PLATFORM} = $pInfo->{PRODUCT} . '_' . $pInfo->{TARGET};
1011
 
1012
        #
1013
        #   Remember the product name
1014
        #
1015
        $BUILDPRODUCT{ $pInfo->{PRODUCT} } = 1;
1016
 
1017
        #
1018
        #   Add platform name to the alias explansion being created
1019
        #   Allows the user to reference the entire FAMILY of platforms
1020
        #
1021
        HashJoin( \%BUILDALIAS, ' ', $pInfo->{PRODUCT}, $pInfo->{PLATFORM} );
1022
 
1023
        #
1024
        #   Create an element to assist in creating %ScmBuildProducts
1025
        #
1026
        $pInfo->{ISPRODUCT} = 1;
1027
        $BUILDPRODUCT_PARTS{$pInfo->{PLATFORM}} = "$pInfo->{PRODUCT},$pInfo->{TARGET}";
1028
    }
1029
    else
1030
    {
1031
        $pInfo->{PRODUCT} = $pInfo->{TARGET};
1032
        $pInfo->{PLATFORM} = $pInfo->{TARGET};
1033
    }
1034
 
1035
    #---------------------------------------------------------------------------
1036
    #   All the hard work has been done
1037
    #   We now know the platforms full name
1038
    #
1039
    #   Ensure that the target platform has not been been specified
1040
    #   Perhaps this should be an error
1041
    #
1042
    my $platform = $pInfo->{PLATFORM};
1043
 
5109 dpurdie 1044
    if ( defined ( $BUILDINFO{$platform}) && ! $Clobber)
227 dpurdie 1045
    {
5867 dpurdie 1046
        abtWarning(1,"$fname() duplicate platform '$platform'");
5429 dpurdie 1047
        return;
227 dpurdie 1048
    }
1049
 
1050
    #
1051
    #   Add platform (tag) to various lists
1052
    #
1053
    UniquePush( \@BUILDPLATFORMS, $platform );
1054
    UniquePush( \@DEFBUILDPLATFORMS, $platform ) unless ( $pInfo->{NOT_DEFAULT} );
1055
 
1056
    #
1057
    #   Create a simple alias if requested
1058
    #   Used if a platform creates multiple entires
1059
    #
1060
    if ( $pInfo->{ALIAS} )
1061
    {
317 dpurdie 1062
        HashJoin( \%BUILDALIAS_DELAY, ' ', $_, $platform )
1063
            foreach ( ArrayList($pInfo->{ALIAS}) );
227 dpurdie 1064
    }
1065
 
363 dpurdie 1066
    if ( $pInfo->{USERALIAS} )
1067
    {
1068
        HashJoin( \%BUILDALIAS_DELAY, ' ', $_, $platform )
1069
            foreach ( ArrayList($pInfo->{USERALIAS}) );
1070
    }
1071
 
227 dpurdie 1072
    #
1073
    #   Create a HARDWARE type alias if requested
1074
    #   ie: SOLARIS_SPARC or SOLARIS_X86
1075
    #
1076
    if ( $pInfo->{HARDWARE} )
1077
    {
1078
        HashJoin( \%BUILDALIAS_DELAY, ' ',  $pInfo->{BASE} . '_' . $pInfo->{HARDWARE}, $platform );
1079
    }
1080
 
1081
    #
1082
    #   Create the 'parts' of the platform. This is a list of unique
1083
    #   bits to search. It will consist of:
1084
    #       [0]     - platform
1085
    #       [1]     - product
1086
    #       ...     - Uses bits ...
1087
    #       [last]  - target
1088
    #
1089
    my @parts;
1090
 
379 dpurdie 1091
    if ( $pInfo->{USES_FIRST} )
1092
    {
1093
        UniquePush (\@parts, @{$pInfo->{USES_FIRST}} );
1094
    }
1095
 
1096
    UniquePush (\@parts, $platform);
1097
 
227 dpurdie 1098
    #
1099
    #   Include all the product extensions
1100
    #
1101
    if ( $pInfo->{ISPRODUCT}  )
1102
    {
1103
        UniquePush (\@parts, map {+ "$pInfo->{PRODUCT}_${_}" } @{$pInfo->{USES}});
1104
        UniquePush (\@parts, map {+ "$pInfo->{PRODUCT}_${_}" } @{$pInfo->{ALSO_USES}});
1105
        UniquePush (\@parts, $pInfo->{PRODUCT} );
1106
    }
1107
 
1108
    #
1109
    #   Add in non-product expanded parts
1110
    #
1111
    UniquePush (\@parts, @{$pInfo->{EXTRA_USES}});
1112
 
1113
    #
1114
    #   Create a structure to assist in search path resolution
1115
    #   The order is important. It sets the include search order for include
1116
    #   files and libraries
1117
    #   If A uses B then search in A_B, A, B
1118
    #       ie: GAK uses MOS68K Search stuff in GAK_MOS68K, GAK, MOS68K
1119
    #
1120
    #       Usage:  OBFTP uses TP5 on MOSCF(target)       (BuildProduct)
1121
    #       Expansion: OBFTP, TP5_MOSCF, TP5
1122
    #
1123
    #       Usage: VS2003(target) also uses WIN32(uses)     (BuildPlatform)
1124
    #       Expansion: VS2003, VS2003_WIN32, WIN32
1125
    #
1126
    if ( $pInfo->{ISPRODUCT}  )
1127
    {
1128
        UniquePush (\@parts, map {+ "${_}_$pInfo->{TARGET}", $_, $pInfo->{TARGET}} @{$pInfo->{USES}});
1129
        UniquePush (\@parts, map {+ "${_}_$pInfo->{TARGET}", $_, $pInfo->{TARGET}} @{$pInfo->{ALSO_USES}});
1130
    }
1131
    else
1132
    {
1133
        UniquePush (\@parts, map {+ "$pInfo->{TARGET}_${_}", $pInfo->{TARGET}, $_} @{$pInfo->{USES}});
1134
        UniquePush (\@parts, map {+ "$pInfo->{TARGET}_${_}", $pInfo->{TARGET}, $_} @{$pInfo->{ALSO_USES}});
1135
    }
1136
 
1137
    #
1138
    #   Finally - the target
1139
    #
1140
    UniquePush (\@parts, $pInfo->{TARGET} );
1141
 
1142
    #
1143
    #   Save the PARTS
1144
    #   Also saved as BUILDPLATFORM_PARTS for interface with older versions
1145
    #   of the deployments scripts.
1146
    #
1147
    $pInfo->{PARTS} = \@parts;
1148
 
1149
    #
1150
    #   Add any arguments to the platforms argument list
1151
    #
1152
    PlatformArgument( $platform, @{$pInfo->{ARGS}} ) if ( $pInfo->{ARGS} );
1153
 
1154
    #
1155
    #   Clean up and save
1156
    #
1157
    delete $pInfo->{TEMPLATE};
1158
    delete $pInfo->{FNAME};
1159
    $BUILDINFO{$platform} = $pInfo;
1160
#    DebugDumpData("BUILDINFO", \%BUILDINFO );
1161
}
1162
 
1163
 
1164
sub BuildArgument
1165
{
1166
    my( $platform, @arguments ) = @_;
1167
    my( @platforms );
1168
 
1169
    Debug( "BuildArgument($platform, @arguments)" );
1170
 
1171
    Error( "BuildArgument must appear before BuildName()..." )
1172
        if ( $BUILDNAME ne "" );
1173
 
1174
    #
1175
    #   Allow a wildcard to apply a single argument to all platforms
1176
    #   Should only be used AFTER all the platforms have been specified
1177
    #
1178
    if ( $platform eq '*' )
1179
    {
1180
        @platforms = @BUILDPLATFORMS;          # Simple Wildcard
1181
    }
1182
    else
1183
    {
1184
        @platforms = ExpandPlatforms( $platform );  # aliasing
1185
    }
1186
 
283 dpurdie 1187
    foreach my $platform ( @platforms )
227 dpurdie 1188
    {
1189
        next if ( $platform =~ /^--/ );         # argument, ignore
1190
 
1191
        PlatformArgument( $platform, @arguments );
1192
    }
1193
}
1194
 
1195
 
1196
sub BuildPlatforms
1197
{
1198
    my( @arguments ) = @_;
1199
    my $fname = "BuildPlatforms";
1200
 
1201
    Debug( "BuildPlatforms(@arguments)" );
1202
 
1203
    Error( "BuildPlatforms must appear before BuildName()..." )
1204
        if ( $BUILDNAME ne "" );
1205
 
1206
    #
1207
    #   Expand the user specified platforms to allow the use of BuildAlias
1208
    #   The (bad) side effect of this is that platform options get reorganised
1209
    #       PLATFORM,--Uses=ANOTHER  ==> PLATFORM --Uses=ANOTHER
1210
    #
1211
    #   Insert markers(++) into @aruments to mark when to process collected data
1212
    #   Insert before each PLATFORM and at the end of the list
1213
    #   platform specifier or the end of the list. Scan the arguments
1214
    #
1215
    @arguments = ExpandPlatforms( @arguments );
1216
    my @new_args;
1217
    foreach  ( @arguments )
1218
    {
1219
        push (@new_args, '++') unless ( m/^--/ );
1220
        push (@new_args, $_ );
1221
    }
1222
    push (@new_args, '++');
1223
    shift @new_args if $new_args[0] eq '++';
1224
 
1225
 
1226
    my $platform  = "";                         # current platform
1227
    my $notdefault  = 0;
1228
    my @uses = ();
1229
    my @pargs = ();
1230
 
1231
    foreach my $arg ( @new_args )
1232
    {
1233
        #
1234
        #   Extract known options
1235
        #   Unknown options bind to the current platform
1236
        #
1237
        if ( $arg =~ /^--/ ) {
1238
            if ( $arg =~ /^--NotDefault$/ ) {
1239
                $notdefault = 1;
1240
 
1241
            } elsif ( $arg =~/^--Uses=(.*)/ ) {
1242
                UniquePush (\@uses, $1);
1243
 
1244
            } elsif ( $arg =~/^--FunctionName=(.*)/ ) {
1245
                $fname = $1;
1246
 
1247
            } else {
1248
                push @pargs, $arg;
1249
            }
1250
            next;
1251
        }
1252
 
1253
        #
1254
        #   New platform. Save name for later. Collect arguments first
1255
        #
1256
        unless ( $arg eq '++' )
1257
        {
1258
            $platform = $arg;
1259
 
1260
            Error( "$fname() missing platform specification" )
1261
                unless ( $platform );
1262
 
1263
            Error( "$fname() product '$platform' contains invalid characters" )
1264
                unless ( $platform eq quotemeta( $platform ) );
1265
 
1266
            next;
1267
        }
1268
 
1269
        #
1270
        #   Create new platform
1271
        #   Have collected name and arguments
1272
        #
1273
        CreateBuildPlatformEntry($fname, $notdefault, undef, $platform, \@uses, \@pargs  );
1274
 
1275
        #
1276
        #   Reset collection variables for next platform
1277
        #
1278
        $platform = "";
1279
        $notdefault  = 0;
1280
        @uses = ();
1281
        @pargs = ();
1282
    }
1283
}
1284
 
1285
 
1286
#   PlatformArgument ---
1287
#       Append an argument list to the specified platform argument list.
1288
#       Internal use only
1289
#..
1290
 
1291
sub PlatformArgument
1292
{
1293
    my( $platform, @arguments ) = @_;
1294
 
1295
    Debug( "  PlatformArguments($platform, @arguments)" );
1296
 
1297
    HashJoin( \%BUILDPLATFORMARGS, $;, $platform, @arguments )
1298
        if ( $platform );
1299
}
1300
 
279 dpurdie 1301
#-------------------------------------------------------------------------------
5679 dpurdie 1302
# Function        : BuildExclude 
1303
#
1304
# Description     : Allow specific platforms to be excluded from the Build
1305
#                   Intended use:
1306
#                       Allow the use if a platform alias, but not all elements of it
1307
#                       ie: Use DEVLINUX, but not ARM9TDMI as we no longer support it 
1308
#                           in this version.
1309
#                   Multiple BuildExclude directives are allowed
1310
#                   Order or location is not important        
1311
#
1312
# Inputs          : Platforms names and options
1313
#                   Format:
1314
#                       --PLATFORM=xxxxx    (Marginal use)
1315
#                       --PRODUCT=yyyy      (Not very useful)
1316
#                       --TARGET=zzzz       (Default)
1317
#                       zzzz                (Same as --TARGET=ZZZZ)
1318
#                       
1319
#
1320
# Returns         : Nothing 
1321
#
1322
sub BuildExclude
1323
{
1324
    my( @arguments ) = @_;
1325
    Debug( "BuildExclude(@arguments)" );
1326
 
1327
    Error( "BuildExclude must appear before BuildName()..." )
1328
        if ( $BUILDNAME ne "" );
1329
 
1330
    #
1331
    #   Simply save the arguments for later
1332
    #   Allow multiple specs in the one definition
1333
    #
1334
    foreach ( @arguments)
1335
    {
5680 dpurdie 1336
        Error ("Invalid format: $_") if m/[,\s]/;
5679 dpurdie 1337
        UniquePush (\@BUILDEXCLUDE, split(/\s*,\s*/,$_));
1338
    }
1339
}
1340
 
1341
#-------------------------------------------------------------------------------
6133 dpurdie 1342
# Function        : BuildToolset 
1343
#
1344
# Description     : Indicate that this package will build binary parts of a JATS
1345
#                   toolset.
1346
#                   
1347
#                   Should be used to indicate that it building non-binary parts
1348
#                   too.
1349
#                   
1350
#                   Used as a sanity test.
1351
#
1352
# Inputs          : Options to limit the Machine Types affected 
1353
#
1354
# Returns         : 
1355
#
1356
sub BuildToolset
1357
{
1358
    my( @arguments ) = @_;
1359
    my ($exclude, $include, $including);
1360
 
1361
    $genToolsetPlatform = 1;
1362
    Debug( "BuildToolset(@arguments)" );
1363
    Error( "BuildToolset must appear before BuildName()..." )
1364
        if ( $BUILDNAME ne "" );
1365
 
1366
    #
1367
    #   Process TOOLSET specific options
1368
    #       --ExcludeMachType=xxxx,yyy
1369
    #       --MachType=xxxx,yyy
1370
    #
1371
    foreach ( @arguments )
1372
    {
1373
        if ( m~^--ExcludeMachType=(.+)~i ) {
1374
            foreach my $arch (split(',',$1))
1375
            {
1376
                if (uc($arch) eq uc($::GBE_MACHTYPE))
1377
                {
1378
                    Verbose("Exclude TOOLSET on this machine");
1379
                    $exclude = 1;
1380
                    last;
1381
                }
1382
            }
1383
        } elsif ( m~^--MachType=(.+)~i ) {
1384
            $including = 1;
1385
            foreach my $arch (split(',',$1))
1386
            {
1387
                if (uc($arch) eq uc($::GBE_MACHTYPE))
1388
                {
1389
                    Verbose("Include TOOLSET on this machine");
1390
                    $include = 1;
1391
                    last;
1392
                }
1393
            }
1394
 
1395
        } else {
1396
            Error ("BuildToolset: Unknown option: $_");
1397
        }
1398
    }
1399
 
1400
    #
1401
    #   Show we build for this architecture
1402
    #
1403
    $genToolsetActive = 0;
1404
    if ($exclude) {
1405
        $toolsetPlatform = 'Excluded';
1406
        return;
1407
    }
1408
 
1409
    if ($including) {
1410
        if ($include) {
1411
            $genToolsetActive = 1;
1412
        } else {
1413
            $toolsetPlatform = 'Not included';
1414
        }
1415
        return;
1416
    }
1417
 
1418
    $genToolsetActive = 1;
1419
    return;
1420
}
1421
 
1422
 
1423
#-------------------------------------------------------------------------------
279 dpurdie 1424
# Function        : BuildName
1425
#
1426
# Description     : Defines the package name and version
1427
#
1428
# Inputs          : build arguments
1429
#                   Various formats are allowed for backward compatability
1430
#                   Must support a number of different formats
1431
#                       "name nn.nn.nn prj"
1432
#                       "name nn.nn.nn.prj"
1433
#
1434
#                       "name nn.nn.nn prj", "nn.nn.nn"
1435
#                       "name nn.nn.nn.prj", "nn.nn.nn"
1436
#
1437
#                       "name", "nn.nn.nn.prj"
1438
#
1439
#                       "name", "nn.nn.nn", "prj", --RelaxedVersion
1440
#
1441
# Returns         : Nothing
1442
#
227 dpurdie 1443
sub BuildName
1444
{
1445
    my( @arguments ) = @_;
1446
    my $relaxed_version_name = 0;
1447
    my @args;
1448
 
1449
    Debug( "BuildName(@arguments)" );
315 dpurdie 1450
    Error( "Platform(s) not defined.",
227 dpurdie 1451
            "BuildAlias, BuildProduct and BuildPlatform directives must be defined prior to BuildName()." )
1452
        unless( scalar @BUILDPLATFORMS );
1453
 
1454
#.. Parse arguments
1455
#.
1456
    my $build_info = parseBuildName( @arguments );
1457
 
1458
    $BUILDNAME_PACKAGE = $build_info->{BUILDNAME_PACKAGE};
1459
    $BUILDNAME_VERSION = $build_info->{BUILDNAME_VERSION};
1460
    $BUILDNAME_PROJECT = $build_info->{BUILDNAME_PROJECT};
359 dpurdie 1461
    $BUILDNAME_SUFFIX  = $BUILDNAME_PROJECT ? '.' . $BUILDNAME_PROJECT : '';
227 dpurdie 1462
 
1463
    $BUILDNAME         = $build_info->{BUILDNAME};
1464
    $BUILDVERSION      = $build_info->{BUILDVERSION};
1465
 
1466
    $DEPLOY_PATCH      = $build_info->{DEPLOY_PATCH} || 0;
1467
 
1468
    #
1469
    #   Clobber processing done after values have been accumulated
1470
    #   as they may be used later
1471
    #
1472
    return if ( $Clobber );
6133 dpurdie 1473
    ToolsetFiles::AddFile('build.log');
4003 dpurdie 1474
 
227 dpurdie 1475
#.. Create build.log summary information
1476
#
261 dpurdie 1477
    my ($sep) = "\n".(" " x 11) . ". ";
227 dpurdie 1478
 
261 dpurdie 1479
    Log( "\nBuild configuration (version $::GBE_VERSION)" );
1480
    Log( "Name ....... $BUILDNAME ($ScmHost)" );
1481
    Log( "Version .... $BUILDNAME_VERSION" );
1482
    Log( "DeployPatch. $DEPLOY_PATCH" ) if ($DEPLOY_PATCH);
1483
    Log( "Project .... $BUILDNAME_PROJECT" )if ($BUILDNAME_PROJECT);
1484
    Log( "Project .... ****** Specifically supressed ******" )unless ($BUILDNAME_PROJECT);
1485
    Log( "DateTime ... $::CurrentTime" );
1486
    Log( "AutoBuild... Enabled:$::GBE_ABT" ) if defined($::GBE_ABT) ;
359 dpurdie 1487
    Log( "Build dir... $Cwd" ) if defined($::GBE_ABT) || $::GBE_DPKG_SBOX;
4161 dpurdie 1488
    Log( "Build Mach.. $::GBE_HOSTNAME" ) if defined($::GBE_ABT);
227 dpurdie 1489
 
359 dpurdie 1490
    Log( "PERL ....... $::GBE_PERL" );
261 dpurdie 1491
    Log( "BIN  ....... $::GBE_BIN" );
1492
    Log( "TOOLS ...... $::GBE_TOOLS" );
1493
    Log( "CONFIG ..... $::GBE_CONFIG" );
1494
    Log( "MACHTYPE ... $::GBE_MACHTYPE" );
227 dpurdie 1495
 
261 dpurdie 1496
    Log( "PLATFORM ... " . PrintList([split(' ', $::GBE_PLATFORM)], $sep) )    if defined ($::GBE_PLATFORM);
5708 dpurdie 1497
    Log( "EXCLUDE .... " . PrintList([@BUILDEXCLUDE], $sep) )    if (@BUILDEXCLUDE);
261 dpurdie 1498
    Log( "BUILDFILTER. " . PrintList([split(' ', $::GBE_BUILDFILTER)], $sep) ) if defined ($::GBE_BUILDFILTER);
227 dpurdie 1499
 
261 dpurdie 1500
    Log( "DPKG_STORE.. $::GBE_DPKG_STORE" );
1501
    Log( "DPKG ....... $::GBE_DPKG" );
4688 dpurdie 1502
    Log( "DPKG_REPLI . $::GBE_DPKG_REPLICA" );
261 dpurdie 1503
    Log( "DPKG_CACHE . $::GBE_DPKG_CACHE" );
1504
    Log( "DPKG_LOCAL . $::GBE_DPKG_LOCAL" );
1505
    Log( "DPKG_SBOX .. $::GBE_DPKG_SBOX" );
7301 dpurdie 1506
    Log( "Sandbox .... Development" );
3559 dpurdie 1507
    Log( "LocalFilter. $::GBE_SANDBOX/buildfilter") if ( $::GBE_SANDBOX && -f $::GBE_SANDBOX . '/buildfilter' );
227 dpurdie 1508
 
1509
    #
241 dpurdie 1510
    #   Generate a list of platforms that are completely unknown to JATS
4003 dpurdie 1511
    #   May be the result of a user typo or a guess
241 dpurdie 1512
    #
1513
    if ( @BUILD_BADNAME )
1514
    {
281 dpurdie 1515
        Log( "Unknown Pl . " . PrintPlatforms(\@BUILD_BADNAME, $sep) );
4551 dpurdie 1516
        Warning ("The following platform names are not known to JATS", "@BUILD_BADNAME");
241 dpurdie 1517
    }
4551 dpurdie 1518
 
241 dpurdie 1519
    #
4551 dpurdie 1520
    #   Detect multiple GENERIC targets
1521
    #       Only one such target can be processed on any one machine
1522
    #
1523
    if ($#GENERIC_TARGETS > 0)
1524
    {
1525
        Error ("Multiple GENERIC targets detected", PrintPlatforms(\@GENERIC_TARGETS, $sep));
1526
    }
1527
    if ($#GENERIC_TARGETS >= 0 )
1528
    {
1529
        $All = 1;
1530
    }
1531
 
1532
    #
227 dpurdie 1533
    #   Generate a list of active platforms
1534
    #   Ensure that there are some active platforms
1535
    #
1536
    GeneratePlatformList();
6133 dpurdie 1537
    Log( "Platforms .. " . PrintPlatforms(\@BUILDPLATFORMS, $sep) );
4551 dpurdie 1538
 
1539
    #
1540
    #   Detect a mix of Generic and non Generic targets
1541
    #       Cannot mix generic and non-generic targets
1542
    #
1543
    if ($#GENERIC_TARGETS >= 0 && $#BUILD_ACTIVEPLATFORMS >= 0)
1544
    {
1545
        if ($#BUILD_ACTIVEPLATFORMS != $#GENERIC_TARGETS )
1546
        {
1547
            Verbose("Active:", @BUILD_ACTIVEPLATFORMS);
1548
            Verbose("Generic:", @GENERIC_TARGETS);
1549
            Error("Cannot mix GENERIC and non-GENERIC targets in the one build");
1550
        }
1551
    }
1552
 
4778 dpurdie 1553
    #
6133 dpurdie 1554
    #   Build System Generic Sanity Test
4778 dpurdie 1555
    #       If Generic   then MUST be a GENERIC build
1556
    #       If NoGeneric then MUST not be a GENERIC build
1557
    #
1558
    if (defined $GenericBuild)
1559
    {
1560
        if ( scalar(@GENERIC_TARGETS) ne $GenericBuild)
1561
        {
1562
            Error("Generic build inconsistency",
1563
                  "Release Manager entry indicates: $GenericBuild",
1564
                  "Build File indicates: " . scalar(@GENERIC_TARGETS)
1565
                  );
1566
        }
1567
    }
1568
 
4003 dpurdie 1569
    unless( @BUILD_ACTIVEPLATFORMS )
1570
    {
5109 dpurdie 1571
        my $msg = 'GBE_BUILDFILTER prevents any targets being built';
7301 dpurdie 1572
        if (defined($::GBE_ABT) || 1) {
227 dpurdie 1573
 
4003 dpurdie 1574
            # Build filter on this machine prevents the package building
1575
            # On a Build System this is not an error
1576
            #   Create a dummy platform called NOBUILD
1577
            #   Do not populate the interface directory with package data
1578
            #   Flag for jmake to do very little
1579
            #
1580
            CreateBuildPlatformEntry('Internal', 0, undef, 'NOBUILD');
1581
            $IgnorePkgs = 1;
1582
            $NoBuild = 1;
5109 dpurdie 1583
            Log( "Build for .. ". PrintPlatforms(['NOBUILD - ' . $msg], $sep));
4003 dpurdie 1584
 
1585
        } else {
5109 dpurdie 1586
            Error( $msg );
4003 dpurdie 1587
        }
1588
    }
1589
    else
1590
    {
1591
        Log( "Build for .. ". PrintPlatforms(\@BUILD_ACTIVEPLATFORMS, $sep));
1592
    }
1593
 
6133 dpurdie 1594
    ProcessToolSetPlatform() if $genToolsetActive;
1595
    Log( "Toolset .... " . $toolsetPlatform ) if $genToolsetPlatform;
1596
    Error ("No suitable TOOLSET platform found") if (($genToolsetActive > 1) && $::GBE_ABT);
1597
 
227 dpurdie 1598
    #
1599
    #   Generate an error if nothing can be done because the GBE_PLATFORM
1600
    #   masks any useful operation.
1601
    #
1602
    if ( $::GBE_PLATFORM )
1603
    {
1604
        my @MAKE_PLATFORMS;
1605
        my %active_platforms;
1606
 
239 dpurdie 1607
        #
1608
        #   Create a hash of active platforms based on the array of
1609
        #   active platforms to simplify testing
1610
        #
1611
        $active_platforms{$_} = 1 foreach ( @BUILD_ACTIVEPLATFORMS  );
227 dpurdie 1612
 
4551 dpurdie 1613
        unless ( $#GENERIC_TARGETS >= 0 )
227 dpurdie 1614
        {
239 dpurdie 1615
            foreach  ( split( ' ', $::GBE_PLATFORM) )
1616
            {
1617
                push @MAKE_PLATFORMS, $_
1618
                    if ( $active_platforms{$_} );
1619
            }
227 dpurdie 1620
 
239 dpurdie 1621
            Error ("The GBE_PLATFORM filter prevents any targets being made",
1622
                   "GBE_PLATFORM: $::GBE_PLATFORM" ) unless ( @MAKE_PLATFORMS );
227 dpurdie 1623
 
261 dpurdie 1624
            Log( "Make for ... ". PrintPlatforms(\@MAKE_PLATFORMS, $sep));
239 dpurdie 1625
        }
227 dpurdie 1626
 
1627
    }
1628
 
1629
    return 1;
1630
}
1631
 
6133 dpurdie 1632
#-------------------------------------------------------------------------------
1633
# Function        : needToolset 
1634
#
1635
# Description     : Internal. Determine if this machine needs to build for
1636
#                   a TOOLSET or a GENERIC_<MachType>
1637
#                   
1638
#                   In Build System
1639
#                       BUILDFILTER must identify the machine performing TOOLSET builds
1640
#                       
1641
#                       The build filter MUST contain the psuedo platform TOOLSET in order for 
1642
#                       the alias to be created. This requires that the build daemons be configured to 
1643
#                       specify a TOOLSET. 
1644
#                       
1645
#                       Care MUST be taken to not configure multiple TOOLSET candiates 
1646
#                       on similar machine types.
1647
#                       
1648
#                   Non Build Sytem (User Development)
1649
#                       True    
1650
#
1651
# Inputs          : 
1652
#
1653
# Returns         : 
1654
#
1655
sub needToolset
1656
{
1657
    my $toolsetNeeded;
227 dpurdie 1658
 
6133 dpurdie 1659
    $toolsetNeeded = 1 if (!defined($::GBE_ABT));
1660
    if (!$toolsetNeeded && defined($::GBE_BUILDFILTER) ) {
1661
        $toolsetNeeded = grep( /^TOOLSET$/, split( ' ', $::GBE_BUILDFILTER ) );
1662
    }
1663
 
1664
    return $toolsetNeeded;
1665
}
1666
 
1667
#-------------------------------------------------------------------------------
1668
# Function        : ProcessToolSetPlatform 
1669
#
1670
# Description     : Locate the TOOLSET platform if required
1671
#                   In Build System
1672
#                       BUILDFILTER must identify the machine performing TOOLSET builds
1673
#                       The first suitable target will be chosen
1674
#                       
1675
#                       The build filter MUST contain the psuedo platform TOOLSET in order for 
1676
#                       the alias to be created. This requires that the build daemons be configured to 
1677
#                       specify a TOOLSET. 
1678
#                       
1679
#                       Care MUST be taken to not configure multiple TOOLSET candiates 
1680
#                       on similar machine types.
1681
#                       
1682
#                   Non Build Sytem (User Development)
1683
#                       The first suitable target will be chosen    
1684
#
1685
# Inputs          : 
1686
#
1687
# Returns         : 
1688
#
1689
sub ProcessToolSetPlatform
1690
{
1691
    my $toolsetNeeded;
1692
    my $toolset;
1693
 
1694
    #
1695
    #   User is not allowed to create a TOOLSET alias
1696
    #       This should be captured before here, but ...
1697
    #
1698
    if (exists $BUILDALIAS{TOOLSET})
1699
    {
1700
        Error('Internal: User has manually specified a TOOLSET alias' );
1701
    }
1702
 
1703
    #
1704
    #   Determine if we need to do any work
1705
    #
1706
    return unless needToolset();
1707
 
1708
    #
1709
    #   Need to ensure that we have a TOOLSET platform in the build set
1710
    #
1711
    my %activePlatformMap = map {$_ => 1} @BUILD_ACTIVEPLATFORMS;
1712
    my @toolsetTargets = PlatformConfig::getTargetsByTag('TOOLSET'); 
1713
    foreach my $item (@toolsetTargets)
1714
    {
1715
        if (exists($activePlatformMap{$item}))
1716
        {
1717
            #
1718
            #   Add TOOLSET arguments into the existing target
1719
            #   Really only expecting --OnlyProd
1720
            #
1721
            if ( @genToolsetArgs) {
1722
                PlatformArgument($item, @genToolsetArgs);
1723
            }
1724
 
1725
            # Update the displayed Toolset platform
1726
            $toolset = $item;
1727
            $toolsetPlatform = $toolset;
1728
            last;
1729
        }
1730
    }
1731
 
1732
    #
1733
    #   No toolset platform found in the current build set
1734
    #   
1735
    unless ($toolset) {
1736
        $toolsetPlatform = "None found in current build set"; 
1737
        $genToolsetActive = 2;
1738
        return;
1739
    }
1740
 
1741
    #
1742
    #   Insert alias information
1743
    #
1744
    $BUILDALIAS{TOOLSET} = $toolset;
1745
    push @{$BUILDINFO{$toolset}{USERALIAS}}, 'TOOLSET';
1746
}
1747
 
1748
#-------------------------------------------------------------------------------
1749
# Function        : BuildPreviousVersion 
1750
#
1751
# Description     : Deprecated. Do not use 
1752
#
1753
# Inputs          : 
1754
#
1755
# Returns         : 
1756
#
227 dpurdie 1757
sub BuildPreviousVersion
1758
{
1759
    my( $version ) = shift;
1760
 
1761
    $BUILDPREVIOUSVERSION = $version;
261 dpurdie 1762
    Log( "Previous Version ... $BUILDPREVIOUSVERSION" );
227 dpurdie 1763
 
1764
    return 1;
1765
}
1766
 
1767
 
1768
sub BuildInterface
1769
{
1770
    my( $ifdirname ) = @_;
1771
 
1772
    #
1773
    #   Clobber the directory - at the end.
1774
    #
1775
    if ( $Clobber )
1776
    {
1777
        #
1778
        #   If this Interface directory contains the Dpackage.cfg file
1779
        #   then JATS has created DPACKAGE and it needs to be clobbered
1780
        #   Flag that it needs to be done later - when we know where it is
1781
        #
1782
        $DeleteDPACKAGE = 1 if ( -f "$ifdirname/Dpackage.cfg" );
1783
    }
1784
 
1785
    #
6133 dpurdie 1786
    #   Generate the required directory
227 dpurdie 1787
    #
6133 dpurdie 1788
    BuildInterfaceInternal($ifdirname);
1789
    Log( "Interface .. $ifdirname" );
1790
    return 1;
1791
}
227 dpurdie 1792
 
6133 dpurdie 1793
#-------------------------------------------------------------------------------
1794
# Function        : BuildInterfaceInternal  
1795
#
1796
# Description     : Internal Use Only
1797
#                   Guts of the BuildInterface processing 
1798
#
1799
# Inputs          : $ifdirname  - Name of an interface directory
1800
#
1801
# Returns         : 
1802
#
1803
 
1804
sub BuildInterfaceInternal
1805
{
1806
    my( $ifdirname ) = @_;
1807
    my @createDirs;
1808
 
1809
    push @CLOBBERDIRS, $ifdirname;
1810
 
227 dpurdie 1811
    if ( $ifdirname eq "local" ) {
6133 dpurdie 1812
        push @createDirs, "$ifdirname/inc";
227 dpurdie 1813
        $BUILDLOCAL = "local";
1814
 
1815
    } else {
6133 dpurdie 1816
        push @createDirs, "$ifdirname/include";
227 dpurdie 1817
        $BUILDINTERFACE = $ifdirname;
1818
        $::ScmInterface = $ifdirname;
1819
    }
1820
 
6133 dpurdie 1821
    unless ($Clobber) {
1822
        push @createDirs, "$ifdirname/bin";
1823
        push @createDirs, "$ifdirname/lib";
1824
 
1825
        foreach my $dir ( @createDirs)
1826
        {
1827
            mkpath($dir);
1828
        }
1829
        ToolsetFiles::AddDir($ifdirname, 'Internal');
1830
    }
227 dpurdie 1831
}
1832
 
1833
 
6133 dpurdie 1834
 
227 dpurdie 1835
sub BuildDirTree
1836
{
1837
    my( $dirfile, $dirhead ) = @_;
1838
    my( $dirname, $c );
1839
 
1840
    $dirhead = '.'
1841
        unless defined( $dirhead );
1842
 
1843
    if ( $Clobber )                             # clobber mode ?
1844
    {
1845
        push @CLOBBERDIRS, $dirhead unless $dirhead eq '.';
1846
        return;
1847
    }
1848
 
1849
    #
1850
    #   Allow for an empty "dirfile". This will allow a directory to be created
1851
    #   without the overhead of the file
1852
    #
1853
    if ( ! $dirfile )
1854
    {
261 dpurdie 1855
        Log( "DirTree .... $dirhead" );
341 dpurdie 1856
        mkpath ( $dirhead );
227 dpurdie 1857
    }
1858
    else
1859
    {
261 dpurdie 1860
        Log( "DirTree .... $dirfile within $dirhead" );
341 dpurdie 1861
        mkpath ( $dirhead );
1862
 
283 dpurdie 1863
        open( DIRFILE, '<' ,$dirfile ) ||
227 dpurdie 1864
            Error( "cannot open '$dirfile'" );
1865
 
1866
        while( $dirname = <DIRFILE> )
1867
        {
1868
            chop $dirname;
1869
            $dirname =~ s/#.*//;
1870
            $c = $dirname =~ s/\s*(\S+).*/$1/g;
1871
 
1872
            next unless ( $c == 1 );
1873
 
1874
            if ( ! -d "$dirhead/$dirname" )
1875
            {
261 dpurdie 1876
                Log( "Dir ........ $dirhead/$dirname" );
341 dpurdie 1877
                mkpath ( "$dirhead/$dirname" );
227 dpurdie 1878
            }
1879
        }
1880
 
1881
        close( DIRFILE );
1882
    }
1883
    $BUILDDIRTREE = $dirhead;
1884
}
1885
 
1886
#-------------------------------------------------------------------------------
1887
# Function        : IncludePkg
1888
#
1889
# Description     : Examine a fully specified package directory for a file
1890
#                   that will specify packages to be included. This allows
1891
#                   a package to be simply a package of other packages
1892
#
1893
#                   Internal function. Not to be used by users
1894
#
1895
# Inputs          : Name of the package
1896
#                   Full directory path of the package to examine
1897
#
1898
# Returns         : Nothing
1899
#
1900
sub IncludePkg
1901
{
1902
    my ($name, $pkg) = @_;
1903
    my $file = "$pkg/incpkg";
1904
 
363 dpurdie 1905
    Debug ("IncludePkg: $name, $pkg" );
227 dpurdie 1906
 
1907
    #
1908
    #   Using a require will ensure that the package is only processed once
1909
    #   even though the function user may be called multiple times.
1910
    #   Also prevents recursion within included packages.
1911
    #
1912
    if ( -f $file  )
1913
    {
261 dpurdie 1914
        Log( "PackageIncludes. $name" ) unless ( $INC{$file} );
227 dpurdie 1915
        require $file;
1916
    }
1917
}
1918
 
1919
#-------------------------------------------------------------------------------
1920
# Function        : LinkPkgArchive
1921
#
1922
# Description     : Include an external package into the build sandbox
1923
#                   by extending the compiler and linker search paths to
1924
#                   include suitable directories found in the package
1925
#
1926
# Inputs          : package name
1927
#                   package version
1928
#
1929
sub LinkPkgArchive
1930
{
1931
    my( $name, $version ) = @_;
1932
 
1933
    return BuildPkgArchive( @_ )
1934
        if ( $ForceBuildPkg );                  # Forcing interface directory
1935
    return if ( $Clobber );                     # clobber mode ?
1936
 
1937
    Debug( "LinkPkgArchive:" );
1938
    Debug( "Name:      $name" );
1939
    Debug( "Version:   $version" );
1940
 
1941
    DataDirective("LinkPkgArchive");            # This directive allowed here
1942
 
7301 dpurdie 1943
#   if ( $IgnorePkgs )
1944
#   {
1945
#       Log( "LinkPkgArchive .. $name ($version) - Ignored" );
1946
#       return;
1947
#   }
2078 dpurdie 1948
 
227 dpurdie 1949
    #
1950
    #   Ensure that we have do not have multiple definitions
1951
    #
1952
    if ( PackageEntry::Exists( $name, $version ) )
1953
    {
261 dpurdie 1954
        Log( "Duplicate Package: $name, $version. Duplicate entry ignored" );
227 dpurdie 1955
        return;
1956
    }
1957
 
1958
    if ( $Cache && $::GBE_DPKG_CACHE )
1959
    {
1960
        my $mode = ($Cache > 1) ? "-refresh" : "";
331 dpurdie 1961
        Log( "LinkPkgArchive .. $name ($version) Update Cache" );
5744 dpurdie 1962
        System('--NoExit', "$::GBE_PERL $::GBE_TOOLS/cache_dpkg.pl $mode -wait -quiet $name/$version" );
227 dpurdie 1963
    }
1964
 
1965
    #
1966
    #   Locate the package ONCE
1967
    #
331 dpurdie 1968
    Log( "LinkPkgArchive .. $name ($version)" );
7301 dpurdie 1969
    my ($pkg, $local, $pkgSig ) = PackageLocate( $name, $version );
227 dpurdie 1970
    if ( $pkg )
1971
    {
1972
        #
1973
        #   Generate package rules for each active platform
1974
        #
363 dpurdie 1975
        IncludePkg ( $name, $pkg );
1976
        foreach my $platform ( @BUILD_ACTIVEPLATFORMS, '--' )
227 dpurdie 1977
        {
7301 dpurdie 1978
            LinkEntry( $platform, $pkg, $name, $version, 0, $local, $pkgSig );
227 dpurdie 1979
        }
1980
    }
1981
}
1982
 
1983
#-------------------------------------------------------------------------------
1984
# Function        : PackageLocate
1985
#
1986
# Description     : Locate a package
1987
#                   Once located a package will be processed for each
1988
#                   platform, but it need only be located ONCE
1989
#
1990
# Inputs          : package name
1991
#                   package version
1992
#
1993
# Returns         : path to the package
1994
#                   local       1 - From local package repository
7301 dpurdie 1995
#                   Package Signature
227 dpurdie 1996
#
1997
sub PackageLocate
1998
{
1999
    my ($name, $uversion ) = @_;
283 dpurdie 2000
    my $pkg;
227 dpurdie 2001
    my $local = 1;
7301 dpurdie 2002
    my $sandbox = 1;
227 dpurdie 2003
    my $isa_cache = 0;
2004
    my $version;
7302 dpurdie 2005
    my $pkgSig = 'Unknown';
227 dpurdie 2006
 
2007
    Debug( "PackageLocate: ($name/$uversion)" );
2008
 
2009
    #
7301 dpurdie 2010
    #   If we are in a SandBox, then we use package signatures to locate pre-built
2011
    #   packages.
2012
    #
2013
    if ($::GBE_SANDBOX)
2014
    {
2015
        my @ret = PackageLocateBySignature(@_);
2016
        if ($ret[0])
2017
        {
2018
            return @ret;
2019
        }
7303 dpurdie 2020
        Log ("                  Not found by signature - revert to package version");
7301 dpurdie 2021
    }
2022
 
2023
    #
227 dpurdie 2024
    #   Look in each package archive directory
2025
    #
2026
    foreach my $dpkg ( split( $::ScmPathSep, $::GBE_DPKG_SBOX),
2027
                       '--NotSandbox',
2028
                       split( $::ScmPathSep, $::GBE_DPKG_LOCAL),
2029
                       '--NotLocal',
2030
                       split( $::ScmPathSep, $::GBE_DPKG_CACHE),
2031
                       '--NotCache',
4688 dpurdie 2032
                       split( $::ScmPathSep, $::GBE_DPKG_REPLICA),
227 dpurdie 2033
                       split( $::ScmPathSep, $::GBE_DPKG),
313 dpurdie 2034
                       split( $::ScmPathSep, $::GBE_DPLY),
227 dpurdie 2035
                       split( $::ScmPathSep, $::GBE_DPKG_STORE) )
2036
    {
2037
 
2038
        #
2039
        #   Detect various tags that have been placed in the search list
2040
        #   to flag the end of the sandbox search and the end of the local
2041
        #   archive search
2042
        #
2043
        if ( $dpkg eq '--NotSandbox' )
2044
        {
2045
            $sandbox = 0;
2046
            next;
2047
        }
2048
        if ( $dpkg eq '--NotLocal' )
2049
        {
2050
            $local = 0;
2051
            $isa_cache = 1;
2052
            next;
2053
        }
2054
        if ( $dpkg eq '--NotCache' )
2055
        {
2056
            $isa_cache = 0;
2057
            next;
2058
        }
2059
 
2060
        #
2061
        #   If we are playing in a sandbox, then the version number is
2062
        #   not used. The Package suffix is still used so that we can
2063
        #   differentiate sysbasetypes.xxxxx.mas and sysbasetypes.xxxxx.syd
2064
        #
2065
        if ( $sandbox )
2066
        {
359 dpurdie 2067
            my ($pn, $pv, $ps ) = SplitPackage ($name, $uversion );
227 dpurdie 2068
            $version = 'sandbox';
2069
            $version .= '.' . $ps if ( $ps );
2070
        }
2071
        else
2072
        {
2073
            $version = $uversion;
2074
        }
2075
 
6133 dpurdie 2076
        $pkg = "$dpkg/$name/$version";
2077
        $pkg = "$dpkg/$name/$version.lnk"
2078
            if ( -e "$dpkg/$name/$version.lnk" );
2079
 
227 dpurdie 2080
        #
2081
        #   Using a soft link
2082
        #   Emulate a link in software. The link file contains one line
2083
        #   which is the real pathname of the package
2084
        #
2085
        if ( $pkg =~ m~(.*)\.lnk$~  )
2086
        {
2087
            #
2088
            #   Warn the user if both a link and a real directory
2089
            #   are both present - the link may well be incorrect
2090
            #
2091
            my $non_link = $1;
2092
            Warning ("Suspect package link: $pkg",
2093
                     "Both a link and a package where found - using the link" )
2094
                                                            if ( -d $non_link );
2095
 
2096
            Debug( "           link found -> $pkg" );
2097
            my $link_src = $pkg;
6133 dpurdie 2098
            $pkg = TagFileRead($pkg);
2099
            $pkg =~ s~\\~/~g;
5819 dpurdie 2100
            if ($pkg =~ s~^GBE_SANDBOX/~$::GBE_SANDBOX/~)
2101
            {
2102
                    # If the target sandbox is in the 'deploymode' then the package
2103
                    # will not be in the expected location. It will be in a 'build/deploy'
2104
                    # subdir. Remove the pkg/name dir to get to the root of the package
2105
                    my @dirs = File::Spec->splitdir( $pkg );
2106
                    splice(@dirs, -2);
2107
                    my $deployBox = catdir(@dirs, 'build', 'deploy');
2108
                    $pkg = $deployBox if ( -d $deployBox);
2109
            }
227 dpurdie 2110
 
2078 dpurdie 2111
            unless ( -d $pkg )
2112
            {
2113
                Error ("Broken link: $pkg",
2114
                       "Source link: $link_src",
2115
                       "Try deleting the .lnk file" ) unless ( $NoPackageError );
2116
 
2117
                Warning ("Package not available. Broken link: $pkg");
2118
            }
227 dpurdie 2119
        }
2120
 
2121
        Debug( "           searching $pkg" );
2122
 
2123
        #   Does the package directory exist?
2124
        #   Terminate the directory name with a "/" to detect hidden spaces
2125
        #..
2126
        $pkg =~ s~//~/~g;
2127
        next unless ( -d "$pkg/" );             # exists ?
2128
 
2129
        #
2130
        #   If the package exists within the dpkg_archive cache then mark the
2131
        #   version as having been used. Used by cache cleanup algorithms
2132
        #
2133
        if ( $isa_cache  )
2134
        {
2135
            TouchFile ( "$pkg/used.cache", "Marks the cache copy as being used");
2136
        }
2137
 
2138
        #
2139
        #   Use the first suitable package found
2140
        #..
2141
 
2142
        Debug( "           importing $pkg" );
7301 dpurdie 2143
        return $pkg, $local, $pkgSig;
227 dpurdie 2144
    }
2145
 
2146
    #
2147
    #   Package not found
2148
    #   This is an error, although it can be bypassed
2149
    #
261 dpurdie 2150
    Error ("Required package not found: '$name/$version'" ) unless ( $NoPackageError );
227 dpurdie 2151
 
261 dpurdie 2152
    Log( "WARNING .... Package not available: '$name/$version'" );
283 dpurdie 2153
    return;
227 dpurdie 2154
}
2155
 
7301 dpurdie 2156
#-------------------------------------------------------------------------------
2157
# Function        : PackageLocateBySignature
2158
#
2159
# Description     : Locate a package via its signature
2160
#                   In a monoRepo sandbox pre-build package artifacts are located
2161
#                   via the signature of the source package. This must be generated
2162
#                   before it can be used.
2163
#                   
2164
#                   At the moment we simply generate an error if the signature cannot be
2165
#                   found. We could be clever and invoke jats to generate the required 
2166
#                   signature.
2167
#                   
2168
#
2169
# Inputs          : package name
2170
#                   package version
2171
#
2172
# Returns         : path to the package
2173
#                   local       1 - From local package repository
2174
#                   Package Signature
2175
#
2176
sub PackageLocateBySignature
2177
{
2178
    my ($name, $uversion ) = @_;
2179
    my $prj = '';
2180
    my $pkg;
2181
    my $local = 1;
2182
    my $in_sandbox = 1;
2183
    my $isa_cache = 0;
2184
    my $version;
7302 dpurdie 2185
    my $pkgSig = 'Unknown';
227 dpurdie 2186
 
7301 dpurdie 2187
    Debug( "PackageLocateBySignature: ($name/$uversion)" );
2188
 
2189
    # 
2190
    #   We are in a sandbox and expect to find a interface/Package.sig file
2191
    #   This will allow us to locate the package in the package store
2192
    #   
2193
    #   If there is no interface/Package.sig, then the user must build (not make)
2194
    #   the package in the sandbox.
2195
    #   
2196
    #   ie: the interface/Package.sig file allows us to use the package from package cache
2197
    #       or indicates that the user has not yet built the package
2198
    #       
2199
    #
2200
    #   First locate the packages interface directory
2201
    #   We have a nice link from the sandbox to assist in this
2202
    #
2203
    my ($pn, $pv, $ps ) = SplitPackage ($name, $uversion );
2204
    $version = 'sandbox';
2205
    $prj = '.' . $ps if ( $ps ); 
2206
    $version .= $prj;
2207
 
2208
    my $ifaceDir = catdir($::GBE_SANDBOX, 'sandbox_dpkg_archive', $name, $version . '.int');
2209
    $ifaceDir = TagFileRead($ifaceDir);
2210
    $ifaceDir =~ s~\\~/~g;
2211
    $ifaceDir =~ s~GBE_SANDBOX/~$::GBE_SANDBOX/~;
2212
    my $pkgSigFile = catfile( $ifaceDir, 'Package.sig');
2213
 
2214
    return unless -f $pkgSigFile; 
2215
 
2216
    Error("Package signature not found for $name/$version", "You must 'build' the package before using it")
2217
        unless ( -f $pkgSigFile);
2218
    $pkgSig = TagFileRead($pkgSigFile);
2219
    Error("Package signature invalid for $name/$version", "Signature: $pkgSig") 
7302 dpurdie 2220
        if((length($pkgSig) != 40) && $pkgSig !~ m~^MSG:~) ;
7301 dpurdie 2221
 
2222
    #
2223
    #   Look in each package archive directory
2224
    #
2225
    foreach my $dpkg ( split( $::ScmPathSep, $::GBE_DPKG_SBOX),
2226
                       '--NotSandbox',
2227
                       split( $::ScmPathSep, $::GBE_DPKG_LOCAL),
2228
                       '--NotLocal',
2229
                       split( $::ScmPathSep, $::GBE_DPKG_CACHE),
2230
                       '--NotCache',
2231
                       split( $::ScmPathSep, $::GBE_DPKG_REPLICA),
2232
                       split( $::ScmPathSep, $::GBE_DPKG),
2233
                       split( $::ScmPathSep, $::GBE_DPLY),
2234
                       split( $::ScmPathSep, $::GBE_DPKG_STORE) )
2235
    {
2236
 
2237
        #
2238
        #   Detect various tags that have been placed in the search list
2239
        #   to flag the end of the sandbox search and the end of the local
2240
        #   archive search
2241
        #
2242
        if ( $dpkg eq '--NotSandbox' )
2243
        {
2244
            $in_sandbox = 0;
2245
            next;
2246
        }
2247
        if ( $dpkg eq '--NotLocal' )
2248
        {
2249
            $local = 0;
2250
            $isa_cache = 1;
2251
            next;
2252
        }
2253
        if ( $dpkg eq '--NotCache' )
2254
        {
2255
            $isa_cache = 0;
2256
            next;
2257
        }
2258
 
2259
        $pkg = "$dpkg/$name$prj/$pkgSig";
2260
        $pkg = "$dpkg/$name/$version.lnk"
2261
            if ( -e "$dpkg/$name/$version.lnk" );
2262
 
2263
        #
2264
        #   If we are scanning the sandbox archive itself, then we can will override the signature
2265
        #   if the package has been built within the sandbox. This is indicated by the presence of a
2266
        #   valid .lnk file.
2267
        #   
2268
        #       Note: The .lnk file may be present, but it won't point to anything valid until
2269
        #             the package has been built.
2270
        #
2271
        if ($in_sandbox)
2272
        {
2273
            my $pkgLinkFile = $pkg;
2274
            $pkgLinkFile =~ s~pkgsig$~lnk~;
2275
 
2276
            if ( -f $pkgLinkFile )
2277
            {
2278
                Debug( "           link found -> $pkg" );
2279
                my $pkgLink = TagFileRead($pkgLinkFile);
2280
                $pkgLink =~ s~\\~/~g;
2281
                if ($pkgLink =~ s~^GBE_SANDBOX/~$::GBE_SANDBOX/~)
2282
                {
2283
                        # If the target sandbox is in the 'deploymode' then the package
2284
                        # will not be in the expected location. It will be in a 'build/deploy'
2285
                        # subdir. Remove the pkg/name dir to get to the root of the package
2286
                        my @dirs = File::Spec->splitdir( $pkgLink );
2287
                        splice(@dirs, -2);
2288
                        my $deployBox = catdir(@dirs, 'build', 'deploy');
2289
                        $pkgLink = $deployBox if ( -d $deployBox);
2290
                }
2291
 
2292
                # 
2293
                #   Handle badly formed packages - test for descpkg file
2294
                #   Or those have the body of the code in the pkg directory
2295
                #   
2296
                my $pkgDescpkg = catfile( $pkgLink, 'descpkg');
2297
                if (-d $pkgLink && -f $pkgDescpkg)
2298
                {
2299
                    $pkg = $pkgLink;
2300
Debug0("============== From Sandbox: $pkgSig");
2301
#                    $pkgFromSandbox++;
2302
                }
2303
            }
2304
        }
2305
 
2306
        Debug( "           searching $pkg" );
2307
 
2308
        #   Does the package directory exist?
2309
        #   Terminate the directory name with a "/" to detect hidden spaces
2310
        #..
2311
        $pkg =~ s~//~/~g;
2312
        next unless ( -d "$pkg/" );             # exists ?
2313
 
2314
        #
2315
        #   If the package exists within the dpkg_archive cache then mark the
2316
        #   version as having been used. Used by cache cleanup algorithms
2317
        #
2318
        if ( $isa_cache  )
2319
        {
2320
            TouchFile ( "$pkg/used.cache", "Marks the cache copy as being used");
2321
        }
2322
 
2323
        #
2324
        #   Use the first suitable package found
2325
        #..
2326
 
2327
        Debug( "           importing $pkg" );
2328
        return $pkg, $local, $pkgSig;
2329
    }
2330
 
2331
    #
2332
    #   Package not found
2333
    #   This is an error, although it can be bypassed
2334
    #
2335
    Error ("Required package not found: '$name/$version'" ) unless ( $NoPackageError );
2336
 
2337
    Log( "WARNING .... Package not available: '$name/$version'" );
2338
    return;
2339
}
2340
 
227 dpurdie 2341
#-------------------------------------------------------------------------------
2342
# Function        : LinkEntry
2343
#
2344
# Description     : Scan a package an locate platform specific directories
2345
#                   Create data structures to capture the information
2346
#                   This function is used by LinkPkgArchive and LinkSandbox
2347
#                   to perfom the bulk of package inclusion work.
2348
#
2349
# Inputs          : platform being processed
2350
#                   path to the package
2351
#                   name of the package
2352
#                   version of the package
2353
#                   sandbox support (non-zero)
331 dpurdie 2354
#                   local package
7301 dpurdie 2355
#                   package Signature
227 dpurdie 2356
#
2357
sub LinkEntry
2358
{
7301 dpurdie 2359
    my( $platform, $pkg, $name, $version, $sandbox, $local, $pkgSig ) = @_;
227 dpurdie 2360
    my( $entry );
2361
 
2362
    #   Create entry record
2363
    #
2364
    #..
7301 dpurdie 2365
    $entry = PackageEntry::New( $pkg, $name, $version, $sandbox, 'link', $local, $pkgSig );
227 dpurdie 2366
 
2367
    #   Populate includes:
2368
    #
2369
    #   - include/$platform                 (eg include/solaris)
2370
    #   - inc/$platform                     (eg inc/solaris)
2371
    #   - include.$platform                 (eg include.solaris)
2372
    #   - inc.$platform                     (eg inc.solaris)
2373
    #   - include                           (eg include)
2374
    #   - inc                               (eg inc)
2375
    #
2376
    #   plus, product specialisation directores
2377
    #
2378
    #   eg. BuildProduct( 'IDFC', 'WIN32' );
2379
    #
2380
    #   - inc/IDFC_WIN32                    <- derived platform
2381
    #   - inc/IDFC                          <- product
2382
    #   - inc/WIN32                         <- target
2383
    #..
2384
    my $parts = $BUILDINFO{$platform}{PARTS};
2385
 
2386
    foreach my $part ( @$parts )
2387
    {
2388
        $entry->RuleInc( "/include." . $part ) if ( !$sandbox );
2389
        $entry->RuleInc( "/inc." . $part )     if ( !$sandbox );
2390
        $entry->RuleInc( "/include/" . $part ) if ( !$sandbox );
2391
        $entry->RuleInc( "/inc/" . $part );
2392
    }
2393
 
2394
    #
2395
    #   Also search the root include directory - last
2396
    #
2397
    $entry->RuleInc( "/include" )               if ( !$sandbox );
2398
    $entry->RuleInc( "/inc" );
2399
 
2400
    #   Populate libraries:
2401
    #
2402
    #   - lib/lib.$platform[D|P]            (eg lib/lib.sparcD)
2403
    #   - lib/$platform[D|P]                (eg lib/lib.sparc)
2404
    #   - lib.$platform[D|P]                (eg lib.sparcD)
2405
    #
2406
    #   plus, product specialisation directores
2407
    #
2408
    #   eg. BuildProduct( 'IDFC', 'WIN32' );
2409
    #
2410
    #   - lib/IDFC_WIN32                    <- derived platform
2411
    #   - lib/IDFC                          <- product
2412
    #   - lib/WIN32                         <- target
2413
    #..
2414
    $parts = $BUILDINFO{$platform}{PARTS};
2415
 
2416
    foreach my $part ( @$parts )
2417
    {
2418
        $entry->RuleLib("/lib" . ".$part" )     if ( !$sandbox );
2419
        $entry->RuleLib("/lib" . "/lib.$part" ) if ( !$sandbox );
2420
        $entry->RuleLib("/lib" . "/$part" );
2421
    }
2422
 
2423
    #
2424
    #   Some extra places to search
2425
    #   None. This is good as it indicates that all locations are described in PARTS
2426
    #
2427
    #   Do NOT search in /lib. There are no libraries that work on all platforms
2428
    #   Libraries are binaries!
2429
    #
2430
    #    $entry->RuleLib( "/lib" );
2431
 
2432
    #   Tools:
2433
    #
2434
    #   Tools provide an extensible search path for tools and
2435
    #   utilities used to build programs. These are tools that
2436
    #   are executable on the current host machine and are
2437
    #   independent of the toolset.
2438
    #
2439
    #..
2440
    $entry->ExamineToolPath();
2441
    $entry->ExamineThxPath($platform);
2442
    $entry->Cleanup();                          # cleanup tables
2443
 
2444
    #
2445
    #   Add the package entry to the array of such entries for
2446
    #   the current platform. Maintain the discovery order
2447
    #
2448
    #..
2449
    push ( @{$PKGRULES{$platform}}, $entry );
2450
}
2451
 
2452
 
2453
#-------------------------------------------------------------------------------
2454
# Function        : BuildPkgArchive
2455
#
2456
# Description     : Include an external package into the build sandbox
2457
#                   by copying the packages files into the interface directory
2458
#
2459
# Inputs          : package name
2460
#                   package version
2461
#
2462
sub BuildPkgArchive
2463
{
2464
    my( $name, $version ) = @_;
2465
 
2466
    return if ( $Clobber );                     # clobber mode ?
2467
 
2468
    Debug( "BuildPkgArchive:" );
2469
    Debug( "Name:      $name" );
2470
    Debug( "Version:   $version" );
2471
 
2472
    DataDirective("BuildPkgArchive");           # This directive allowed here
2473
 
7301 dpurdie 2474
#   if ( $IgnorePkgs )
2475
#   {
2476
#       Log( "BuildPkgArchive . $name ($version) - Ignored" );
2477
#       return;
2478
#   }
2078 dpurdie 2479
 
227 dpurdie 2480
    #
2481
    #   Ensure that we have do not have multiple definitions
2482
    #
2483
    if ( PackageEntry::Exists( $name, $version ) )
2484
    {
261 dpurdie 2485
        Log( "Duplicate Package: $name, $version. Duplicate entry ignored" );
227 dpurdie 2486
        return;
2487
    }
2488
 
2489
    if ( $Cache && $::GBE_DPKG_CACHE )
2490
    {
2491
        my $mode = ($Cache > 1) ? "-refresh" : "";
261 dpurdie 2492
        Log( "BuildPkgArchive . $name ($version) Update Cache" );
5744 dpurdie 2493
        System('--NoExit', "$::GBE_PERL $::GBE_TOOLS/cache_dpkg.pl $mode -wait -quiet $name/$version" );
227 dpurdie 2494
    }
2495
 
2496
    #
2497
    #   Locate the package
6133 dpurdie 2498
    #   Use the first instance of the package that is found
227 dpurdie 2499
    #
261 dpurdie 2500
    Log( "BuildPkgArchive . $name ($version)" );
7301 dpurdie 2501
    my ( $pkg, $local, $pkgSig ) = PackageLocate( $name, $version );
227 dpurdie 2502
    if ( $pkg )
2503
    {
2504
        #
2505
        #   Create a Package Entry
2506
        #
7301 dpurdie 2507
        my $entry = PackageEntry::New( $pkg, $name, $version, 0, 'build', $local, $pkgSig );
227 dpurdie 2508
 
2509
        #
2510
        #   Determine if the package needs to be installed:
2511
        #       If the package is a 'local' package then force transfer
2512
        #       If the user has specified --cache then force transfer
2513
        #       If package is newer that copy, then force transfer
2514
        #       If copy does not exist, then force a transfer
2515
        #
2516
        my $tag_dir = "$Cwd/$BUILDINTERFACE/BuildTags";
2517
        my $tag_file = "$tag_dir/${name}_${version}.tag";
6073 dpurdie 2518
        my $arglist = GenerateInstallArgumentList();
227 dpurdie 2519
 
2520
        my $package_installed;
2521
        $package_installed = 1
2522
            if ( !$local &&
2523
                 !$Cache &&
6073 dpurdie 2524
                 !FileIsNewer( $entry->GetBaseDir('descpkg'), $tag_file ) &&
2525
                 TagFileMatch( $tag_file, $arglist)
2526
                  );
227 dpurdie 2527
 
2528
        #
2529
        #   Determine the package format and use the appropriate installer
2530
        #   Supported formats
6133 dpurdie 2531
        #       1) Package has a descpkg file (only style currently supported)
227 dpurdie 2532
        #
2533
        if ( $package_installed ) {
2534
            Verbose ("Package already installed: $name, $version");
2535
 
2536
        } else {
261 dpurdie 2537
            Log( "                . installing '$pkg'" );
2538
            Log( "                . -> " . readlink($pkg) ) if ( -l $pkg );
227 dpurdie 2539
 
2540
            if ( -e "$pkg/descpkg" )
2541
            {
2542
 
2543
                #
2544
                #   If forcing a BuildPkg, then don't use symlinks
2545
                #   to files in dpkg_archive
2546
                #
331 dpurdie 2547
                my @opts;
2548
                push @opts, "--NoSymlinks" if ( $ForceBuildPkg );
2549
                push @opts, "--AllowOverWrite" if ( $local );
227 dpurdie 2550
 
2551
                #
2552
                #   Determine all the Platforms, Products and Targets
2553
                #   that need to be installed
2554
                #
6073 dpurdie 2555
 
331 dpurdie 2556
                System( "cd $pkg; $::GBE_PERL $::GBE_TOOLS/installpkg.pl $Cwd/$BUILDINTERFACE $Cwd @opts $arglist");
227 dpurdie 2557
                Error( "Package installation error" ) if ( $? != 0 );
2558
            }
2559
            else
2560
            {
2561
                Error ("Unknown package format for package $name/$version found in $pkg");
2562
            }
2563
 
2564
            #
2565
            #   Tag the package as installed - after it has been transferred
2566
            #
2567
            mkdir ( $tag_dir );
6073 dpurdie 2568
            FileCreate( $tag_file, $arglist );
227 dpurdie 2569
        }
2570
 
2571
        #
2572
        #   Process package
2573
        #
2574
        IncludePkg ( $name, $pkg );
2575
 
2576
        #
2577
        #   Complete the creation of the package entry
2578
        #   Add the information for all platforms
2579
        #
2580
        $entry->Cleanup();
2581
        for my $platform (@BUILD_ACTIVEPLATFORMS)
2582
        {
2583
            $entry->ExamineToolPath();
2584
            $entry->ExamineThxPath($platform);
2585
            push ( @{$PKGRULES{$platform}}, $entry );
2586
        }
2587
    }
2588
}
2589
 
2590
#-------------------------------------------------------------------------------
311 dpurdie 2591
# Function        : CreateInterfacePackage
2592
#
2593
# Description     : Create a dummy package entry to describe the Interface
2594
#                   This is done AFTER all the BuildPkgArchive directives have
2595
#                   been processed so that the interface directory is fully
2596
#                   processed
2597
#
2598
# Inputs          : None
2599
#
2600
# Returns         : 
2601
#
2602
sub CreateInterfacePackage
2603
{
2604
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
2605
    {
2606
        my $entry = PackageEntry::Interface( "$::Cwd/$BUILDINTERFACE" );
2607
 
2608
        #
2609
        #   Locate include and lib bits within the interface
2610
        #   This is much simpler than for a LinkPkgArchive as the form
2611
        #   has been sanitized
2612
        #
2613
        my $parts = $BUILDINFO{$platform}{PARTS};
2614
 
2615
        foreach my $part ( @$parts )
2616
        {
2617
            $entry->RuleInc( "/include/" . $part );
2618
        }
2619
        $entry->RuleInc( "/include" );
2620
 
2621
        foreach my $part ( @$parts )
2622
        {
2623
            $entry->RuleLib("/lib/" . $part );
2624
        }
2625
 
2626
        $entry->ExamineToolPath();
2627
        $entry->ExamineThxPath($platform);
2628
        $entry->Cleanup();
2629
 
2630
        #
2631
        #   Add the package entry to the array of such entries for
2632
        #   the current platform. Force it to be the first one as
2633
        #   the interface directory will be scanned first
2634
        #
2635
        unshift ( @{$PKGRULES{$platform}}, $entry );
2636
    }
2637
}
2638
 
2639
#-------------------------------------------------------------------------------
227 dpurdie 2640
# Function        : GenerateInstallArgumentList
2641
#
2642
# Description     : Generate an argument list for the installpkg.pl script
2643
#                   The argument list is of the form
2644
#                       --Platform:xx[:xx[:xx]] --Platform:yy[:yy[:yy]] ...
2645
#                   Where xx is:
2646
#                       * a 'part' of the target platform
2647
#                         Order is: platform, product, ...  target( in that order )
2648
#                       * --Option[=yyy]
2649
#                        An option to be passed to the script. These are bound only
2650
#                        to the enclosed platform.
2651
# Inputs          :
2652
#
2653
# Returns         : See above
2654
#
2655
sub GenerateInstallArgumentList
2656
{
2657
    my @arglist;
2658
 
2659
    #
2660
    #   Generate the argument list as an array
2661
    #
2662
    for (@BUILD_ACTIVEPLATFORMS)
2663
    {
2664
        my @args = '--Platform';
2665
        push @args, @{$BUILDINFO{$_}{PARTS}};
2666
        push @arglist, join (":" , @args );
2667
    }
2668
 
2669
    return "@arglist";
2670
}
2671
 
2672
#-------------------------------------------------------------------------------
2673
# Function        : GeneratePlatformList
2674
#
2675
# Description     : Return a list of platforms that should particiate in this
2676
#                   build. This is a function of
2677
#                       1) Platforms defined in the build.pl file
5679 dpurdie 2678
#                       2) Platforms excluded in the build.pl file
2679
#                       3) User filter defined in GBE_BUILDFILTER
227 dpurdie 2680
#
2681
#                   The primary use of this function is to limit the creation
2682
#                   of makefiles to those that have supported compilers on
2683
#                   the underlying machine.
2684
#
2685
#                   GBE_BUILDFILTER is a space seperated string of words
2686
#                   Each word may be one of
2687
#                       OPTION=TAG or OPTION=!TAG
2688
#                       TAG or !TAG. This is the same as --TARGET=TAG
2689
#
2690
#                   Bare tags are taken to be TARGETS.
2691
#
2692
#                   Where OPTION may be one of
2693
#                       --PLATFORM
2694
#                       --PRODUCT
2695
#                       --TARGET
5679 dpurdie 2696
#                   For a BuildProduct( AA,BB,CC)
2697
#                       Product     - AA
2698
#                       Targets     - BB, CC
2699
#                       Platforms   - AA_BB, AA_CC
227 dpurdie 2700
#
2701
#                   Special cases
2702
#                   1) If GBE_BUILDFILTER is empty, then all available platforms are used
2703
#                      The global $All is set, then all available platforms are used
2704
#                   2) If the first word of GBE_BUILDFILTER is a negative filter,
2705
#                      ie is used the !xxxx or yyy=!xxxx construct, then it is assumed
2706
#                      that the filter will start with all available platforms
2707
#                   3) The special word --ALL forces selection of ALL platforms
2708
#                      and may reset any existing scanning
2709
#                   4) GBE_BUILDFILTER is parsed left to right. It is possible to add and
2710
#                      subtract items from the list.
2711
#                   5) OPTIONS are case insensitive
2712
#                      TAGS are case sensitive
2713
#
2714
#
2715
# Inputs          : GBE_BUILDFILTER from the environment
2716
#
2717
# Returns         : An array of platforms to include in the build
2718
#                   Maintains @BUILD_ACTIVEPLATFORMS  - the last calculated result
2719
#                   Ensures that @DEFBUILDPLATFORMS is a subset of @BUILD_ACTIVEPLATFORMS
2720
#
2721
sub GeneratePlatformList
2722
{
2723
    #
2724
    #   Return the cached result for speed
2725
    #   The value need only be calculated once
2726
    #
2931 dpurdie 2727
    unless ( @BUILD_ACTIVEPLATFORMS )
227 dpurdie 2728
    {
2729
        my ($platform_filter);
2730
        my %result;
2731
        my %part_to_platform;
2732
 
2733
        #
2734
        #   Create a data structure to assist in the production of the platform list
2735
        #   The structure will be a hash of hashes of arrays
2736
        #
2737
        #   The first level hash will be keyed by the word TARGET, PRODUCT or PLATFORM
2738
        #   The second level of the hash will keyed by available targets, products or platforms
2739
        #   The value of the field will be an array of platforms that match the keyword
2740
        #
2741
        for my $platform (keys (%::BUILDINFO))
2742
        {
2743
            my $pParts = $::BUILDINFO{$platform};
2744
 
2745
            #
2746
            #   Skip platforms that are known to be unavailable on this build
2747
            #   machine. Self configure
2748
            #
2749
            next if ( $pParts->{NOT_AVAILABLE} );
2750
 
2751
            my $target  = $pParts->{TARGET};
2752
            my $product = $pParts->{PRODUCT};
2753
 
2754
            push @{$part_to_platform{'PLATFORM'}{$platform}}, $platform;
2755
            push @{$part_to_platform{'TARGET'}  {$target}}  , $platform;
2756
            push @{$part_to_platform{'PRODUCT'} {$product}} , $platform;
2757
        }
2758
        #
2759
        #   Determine the source of the filter
2760
        #   If the user provides one, then use it.
2761
        #   Otherwise its taken from the environment.
2762
        #
2763
        #   Global build all platforms - Kill any user filter
2764
        #
2765
        if ( $All )
2766
        {
2767
            $platform_filter = "";
2768
        }
2769
        else
2770
        {
2771
            $platform_filter = "";
2772
            $platform_filter = $::GBE_BUILDFILTER
2773
                if ( defined($::GBE_BUILDFILTER) );
2774
        }
2775
        Debug( "GeneratePlatformList: Filter:$platform_filter" );
2776
 
2777
        #
2778
        #   Detect the special cases
5679 dpurdie 2779
        #       1) No user definition
227 dpurdie 2780
        #       2) First word contains a subtractive element
5679 dpurdie 2781
        #   And assume all platforms    
227 dpurdie 2782
        #
2783
        my (@filter) = split( ' ', $platform_filter );
2784
 
2785
        if ( !scalar @filter || $filter[0] =~ m/^$/ || $filter[0] =~ m/!/ )
2786
        {
2787
            %result = %{$part_to_platform{'PLATFORM'}}
2788
                if exists $part_to_platform{'PLATFORM'} ;
2789
        }
5679 dpurdie 2790
 
227 dpurdie 2791
#DebugDumpData( "PartToPlatform", \%part_to_platform );
2792
 
2793
        #
2794
        #   Process each element in the user filter list
2795
        #   Expand platforms into known aliases
2796
        #
2797
        for my $word (@filter)
2798
        {
2799
            my $platform;
2800
 
2801
            if ( $word =~ m/^--ALL/i )
2802
            {
2803
                %result = %{$part_to_platform{'PLATFORM'}};
2804
            }
2805
            elsif ( $word =~ m/^--(TARGET)=(!?)(.*)/i ||
2806
                    $word =~ m/^--(PRODUCT)=(!?)(.*)/i ||
2807
                    $word =~ m/^--(PLATFORM)=(!?)(.*)/i ||
2808
                    ( $word !~ m/^-/ && $word =~ m/()(!?)(.*)/ )
2809
                )
2810
            {
2811
                my $table = uc($1);
2812
                $table = "TARGET"
2813
                    unless ( $1 );
2814
 
2815
                #
2816
                #   Expand PLATFORMs into known aliases
2817
                #   Alias will expand to PLATFORMs so it won't work unless we are
6133 dpurdie 2818
                #   processing PLATFORMs.
227 dpurdie 2819
                #
2820
                my @taglist = ( $table eq "PLATFORM" ) ? ExpandPlatforms($3) : $3;
2821
 
2822
                #
2823
                #   Add / Remove items from the result
2824
                #
2825
                for my $item ( @taglist )
2826
                {
2827
                    my $plist = $part_to_platform{$table}{$item};
2828
                    for ( @{$plist})
2829
                    {
6133 dpurdie 2830
                        if ( $2 ) {
227 dpurdie 2831
                            delete $result{$_};
6133 dpurdie 2832
                        } else {
227 dpurdie 2833
                            $result{$_} = 1;
2834
                        }
2835
                    }
2836
                }
2837
            }
2838
            else
2839
            {
2840
                print "GBE_BUILDFILTER filter term not understood: $word\n";
2841
            }
2842
        }
2843
 
2844
        #
5679 dpurdie 2845
        #   Process BuildExclude
6133 dpurdie 2846
        #   A list of targets to be excluded
2847
        #       INSTRUMENT is a key word
5679 dpurdie 2848
        #
2849
        for my $word (@BUILDEXCLUDE)
2850
        {
2851
            my $platform;
2852
 
2853
            Error('BuildExclude: Unknown option: ' . $word) if ($word =~ m~^-~);
2854
            Error('BuildExclude: Invalid format: ' . $word) if ($word =~ m~^!~);
2855
 
2856
            #
6133 dpurdie 2857
            #   INSTRUMENT is a key word
2858
            #       Remove all instrumented builds
5679 dpurdie 2859
            #
6133 dpurdie 2860
            if ($word eq 'INSTRUMENT')
5679 dpurdie 2861
            {
6133 dpurdie 2862
                for ( keys %result) {
2863
                    if ( PlatformConfig::targetHasTag( $_, 'INSTRUMENT') ) {
2864
                        delete $result{$_} ;
2865
                    }
2866
                }
5679 dpurdie 2867
            }
6133 dpurdie 2868
            else
2869
            {
2870
                #
2871
                #   Remove items from the result
2872
                #
2873
                my $table = "PLATFORM";
2874
                my $plist = $part_to_platform{$table}{$word};
2875
                if ($plist) {
2876
                    for ( @{$plist}) {
2877
                        delete $result{$_};
2878
                    }
2879
                }
2880
                else  {
2881
                    Warning('BuildExclude: Unknown target:' . $word ) 
2882
                        unless exists $::BUILDINFO{$word};
2883
                }
2884
            }
5679 dpurdie 2885
        }
2886
 
2887
        #
227 dpurdie 2888
        #   Return an array of platforms to process
2889
        #
2890
        @BUILD_ACTIVEPLATFORMS = sort keys %result;
2891
 
2892
        #
2893
        #   Ensure that DEFBUILDPLATFORMS is a subset of build active platforms
2894
        #
2895
        my @NEW_DEFBUILDPLATFORMS;
2896
        foreach ( @DEFBUILDPLATFORMS )
2897
        {
2898
            push @NEW_DEFBUILDPLATFORMS, $_
2899
                if ( exists $result{$_} );
2900
        }
2901
        @DEFBUILDPLATFORMS = @NEW_DEFBUILDPLATFORMS;
2902
    }
2903
 
2904
    Debug("GeneratePlatformList: Result:@BUILD_ACTIVEPLATFORMS");
2905
    return @BUILD_ACTIVEPLATFORMS;
2906
}
2907
 
2908
#-------------------------------------------------------------------------------
2909
# Function        : PrintPlatforms
2910
#
2911
# Description     : Petty print the specified platform list, breaking line
2912
#                   on either a primary key change or length width >78.
2913
#
2914
# Returns         : Formated string
2915
#
2916
# Example Output :
2917
#
2918
#           DDU_LMOS_WIN32 DDU_LMOS_linux_armv4 DDU_LMOS_linux_i386
2919
#           IDFC_LMOS_WIN32 IDFC_LMOS_linux_armv4 IDFC_LMOS_linux_i386
2920
#           LMOS_WCEPSPC_ARM LMOS_WCEPSPC_EMU LMOS_WIN32 LMOS_linux_armv4
2921
#           LMOS_linux_i386
2922
#..
2923
sub PrintPlatforms
2924
{
2925
    my ($platforms, $nl) = @_;
2926
    my ($string) = "";                          # result
2927
 
2931 dpurdie 2928
    if ( @$platforms )
227 dpurdie 2929
    {
2930
        my ($key_run) = 0;
2931
        my ($pkey);                             # previous key
2932
 
2933
        #   Perform a simple formatting and determine if there is key 
2934
        #   change greater then 1 or whether the total length exceeds 78.
2935
        #
2936
        #   If the line exceeds 78, the printer shall then reformat 
2937
        #   breaking based on line length and possiblity keys.
2938
        #
2939
        $pkey = "";
2940
        for my $k (sort @$platforms) 
2941
        {
2942
            my ($d);                            # delimitor
2943
 
2944
            if (($d = index( $k, '_' )) != index( $pkey, '_' ) ||
2945
                    substr( $k, 0, $d ) ne substr( $pkey, 0, $d )) {
2946
                $key_run = 1
2947
                    if ($key_run <= 1);         # change, reset run if <= 1
2948
            } else {
2949
                $key_run++;                     # same primary key
2950
            }
2951
 
2952
            $string .= " " if ($pkey);
2953
            $string .= $k;
2954
            $pkey = $k;
2955
        }
2956
 
2957
        #   Reprint if required.
2958
        #
2959
        if (length($nl)+length($string) > 78)
2960
        {
2961
            my ($llen);                         # line length
2962
 
2963
            $llen = length($nl);
2964
 
2965
            $pkey = "";
2966
            $string = "";
2967
 
2968
            for my $k (sort @$platforms)
2969
            {
2970
                my ($klen, $d);                 # key length, delimitor
2971
 
2972
                $klen = length($k);
2973
                if ($pkey ne "")
2974
                {
2975
                    if ($llen + $klen > 78 ||
2976
                        ($key_run > 1 && (
2977
                            ($d = index( $k, '_' )) != index( $pkey, '_' ) ||
2978
                            substr( $k, 0, $d ) ne substr( $pkey, 0, $d ) )) )
2979
                    {                           # line >70 or key change
2980
                        $string .= $nl;
2981
                        $llen = length($nl);
2982
                    }
2983
                    else
2984
                    {
2985
                        $string .= " ";
2986
                        $llen++;
2987
                    }
2988
                }
2989
                $string .= $k;
2990
                $pkey = $k;
2991
                $llen += $klen;
2992
            }
2993
        }    
2994
    }
2995
    return $string;
2996
}
241 dpurdie 2997
#-------------------------------------------------------------------------------
2998
# Function        : PrintList
2999
#
3000
# Description     : Pretty format an array to fit within 80 char line
3001
#                   Perform wrapping as required
3002
#
3003
# Inputs          : $list           - Reference to an array
3004
#                   $nl             - New line stuff.
3005
#                                     Use to prefix new lines
3006
#
3007
# Returns         : string
3008
#
3009
sub PrintList
3010
{
3011
    my ($list, $nl) = @_;
3012
    my ($string) = '';                          # result
3013
    my $sep;
227 dpurdie 3014
 
241 dpurdie 3015
    if ( @$list )
3016
    {
3017
        my ($llen) = length($nl);
227 dpurdie 3018
 
241 dpurdie 3019
        for my $k (@$list)
3020
        {
3021
            my $klen = length($k);
3022
            if ($llen + $klen > 78 )
3023
            {
3024
                $string .= $nl;
3025
                $llen = length($nl);
3026
            }
3027
            else
3028
            {
3029
                if ( $sep )
3030
                {
3031
                    $string .= $sep;
3032
                    $llen++;
3033
                }
3034
                else
3035
                {
3036
                    $sep = ' ';
3037
                }
3038
            }
3039
            $string .= $k;
3040
            $llen += $klen;
3041
        }
3042
    }
3043
    return $string;
3044
}
3045
 
305 dpurdie 3046
#-------------------------------------------------------------------------------
3047
# Function        : BuildReleaseFile
3048
#
3049
# Description     : Legacy function
3050
#                   Don't know what it was meant to do
3051
#                   Unfortunately it is present in a lot of build.pl files
3052
#
3053
#                   Not well supported on all machine types
3054
#
331 dpurdie 3055
# Inputs          : None that are used
305 dpurdie 3056
#
331 dpurdie 3057
# Returns         : Undefined
305 dpurdie 3058
#
227 dpurdie 3059
sub BuildReleaseFile
3060
{
3061
}
3062
 
305 dpurdie 3063
#-------------------------------------------------------------------------------
3064
# Function        : BuildSnapshot
3065
#
3066
# Description     : Legacy function
3067
#                   Don't know what it was meant to do
3068
#                   Unfortunately it is present in a lot of build.pl files
3069
#
3070
# Inputs          : None that are used
3071
#
3072
# Returns         : Undefined
3073
#
227 dpurdie 3074
sub BuildSnapshot
3075
{
3076
}
3077
 
305 dpurdie 3078
#-------------------------------------------------------------------------------
3079
# Function        : BuildSrcArchive
3080
#
3081
# Description     : Create a source snapshot of the build source
3082
#                   Designed to provide a source image for packaging
3083
#                   examples
3084
#
3085
#                   Should be platform independent
3086
#
3087
#                   Creates an archive file and places it into the
3088
#                   interface directory. The archive will be packaged
3089
#                   automatically by the build process
3090
#
3091
#                   Use the 'pax' utility
3092
#                       1) Can massage the file path such that the stored
3093
#                          directory image contains the package name and version
3094
#
3095
#                   Directive can be used at any time before the BuildMake
3096
#
3097
#                   Will handle the existence of an auto.pl file by inserting
3098
#                   it as build.pl.
3099
#
6133 dpurdie 3100
# Inputs          : $platform   - In ABT mode. Process under this platform name
305 dpurdie 3101
#
3102
#
3103
# Returns         : 
3104
#
3105
sub BuildSrcArchive
3106
{
6133 dpurdie 3107
    my ($platform) = @_;
3108
    Error ("BuildSrcArchive requires one platform specifier") unless (defined $platform);
3109
 
3110
 
305 dpurdie 3111
    #
3112
    #   If we are clobbering, then there is nothing to do
3113
    #   The generated file is placed within the interface
3114
    #   directory and that directory will be deleted during the clobber
3115
    #
3116
    return if ( $Clobber );
3117
    DataDirective("BuildSrcArchive");
227 dpurdie 3118
 
305 dpurdie 3119
    #
6133 dpurdie 3120
    #   If not in ABT mode, then build archive on developers machine
3121
    #   In ABT mode only build the archive on a machine whose platform name is in the build filter
3122
    #
3123
    my $doBuild;
3124
    if (defined($::GBE_ABT))
3125
    {
3126
        if (defined ($::GBE_BUILDFILTER))
3127
        {
3128
            $doBuild  = grep( /^$platform/, split( ' ', $::GBE_BUILDFILTER ) );
3129
        }
3130
        unless ( $doBuild )
3131
        {
3132
            Log( "SrcPackage . Not on this machine" );
3133
            return; 
3134
        }
3135
    }
3136
 
3137
 
3138
    #
305 dpurdie 3139
    #   Currently this operation is only supported of some platforms
3140
    #   Only supported on Unix platforms
3141
    #   Uses the 'pax' utility
3142
    #
3143
    unless ( LocateProgInPath ( 'pax', '--All' ) && ( $ScmHost eq "Unix" ) )
3144
    {
3145
        Log( "SrcPackage . Not supported" );
3146
        return;
3147
    }
3148
 
3149
    #
3150
    #   Only allow one instance of the directive
3151
    #
3152
    Error ("Multiple BuildSrcArchive directives not supported")
3153
        if ( $build_source_pkg );
3154
 
3155
    #
3156
    #   Create the name of the archive
3157
    #       Based on the package name and version
3158
    #       Has no spaces
3159
    #
3160
    my $build_name = $BUILDNAME;
3161
    $build_name =~ s~\s+~_~g;
3162
 
3163
    #
3164
    #   Create the archive in the interface directory
3165
    #   Don't need to clobber it as the entire interface directory
3166
    #   will be clobbered
3167
    #
3168
    $build_source_pkg = $build_name;
3169
}
3170
 
3171
#-------------------------------------------------------------------------------
3172
# Function        : BuildSrcArchiveBody
227 dpurdie 3173
#
305 dpurdie 3174
# Description     : Function to implement the body of the BuildSrcArchive
3175
#                   operation. Will be invoked during BuildMake
3176
#
3177
# Inputs          : None
3178
#
3179
# Returns         : 
3180
#
3181
sub BuildSrcArchiveBody
3182
{
3183
    return unless ( $build_source_pkg );
3184
 
3185
    my $archive_dir = "pkg/$BUILDNAME_PACKAGE/src";
3186
    my $archive_file = "$build_source_pkg" . '.tar';
3187
 
3188
    Log( "SrcPackage . $archive_file.gz" );
3189
    unlink "$archive_dir/$archive_file";
3190
    unlink "$archive_dir/$archive_file.gz";
3191
    mkpath($archive_dir, 0, 0775);
3192
 
3193
    #
3194
    #   Create a list of files and top-level dirs to add to source archive
3195
    #   Many files are ignored
3196
    #   Should only be executed on the first 'build' thus many internal
3197
    #   directories will not be present
3198
    #
3199
    my @flist;
3200
    my $auto_pl;
3201
    opendir (my $tp, '.' ) or Error ("Cannot read current directory");
3202
    while ( $_ = readdir($tp) )
3203
    {
3204
        next if ( m/^\.$/ );
3205
        next if ( m'^\.\.$' );
3206
        next if ( m'^build\.log$' );
3207
        next if ( m'\.gbe$' );
6133 dpurdie 3208
        next if ( m'\.svn$' );
3209
        next if ( m'\.git$' );
3210
        next if ( m'\.cvs$' );
3211
        next if ( m'local_dpkg_archive$' );
3212
        next if ( m'\.jats.packageroot$' );
305 dpurdie 3213
        next if ( m'^local$' );
3214
        next if ( m'^pkg$' );
3215
        next if ( m/^$BUILDINTERFACE$/ );
3216
        $auto_pl = 1, next  if ( m'^auto\.pl$' );
3217
        next if (  m'^build\.pl$' );
3218
        next if ( m/^$build_source_pkg$/ );
3219
        push @flist, $_;
3220
    }
3221
    closedir $tp;
3222
 
3223
    #
3224
    #   If we don't have an auto.pl, then we add the build.pl file
3225
    #   If we do have a auto.pl - it gets tricky. Its don't after the
3226
    #   initial pax command
3227
    #
3228
    unless ( $auto_pl )
3229
    {
3230
        push @flist, 'build.pl';
3231
    }
3232
 
3233
    #
3234
    #   Create the command to be executed
3235
    #   Prefix archive paths with build_name
3236
    #
3237
    my @command = ( 'pax', '-w', '-f', "$archive_dir/$archive_file" );
3238
    System( '--NoShell' , @command, '-s', "~^~$build_source_pkg/~", @flist );
3239
 
3240
    #
3241
    #   If we have an auto.pl file, then we need to add it to the archive
3242
    #   but it needs to be called build.pl
3243
    #
3244
    if ( $auto_pl )
3245
    {
3246
        System( '--NoShell' , @command, '-a', '-s', "~^auto.pl~$build_source_pkg/build.pl~" , 'auto.pl' );
3247
    }
3248
 
3249
    #
3250
    #   Must now zip the file
3251
    #   Can't zip and append at the same time
3252
    #
3253
    System( '--NoShell' , 'gzip', "$archive_dir/$archive_file" );
3254
 
3255
    #
3256
    #   Display the results
3257
    #
3258
    System ('--NoShell', 'pax', '-z', "-f$archive_dir/$archive_file.gz")
3259
        if (IsVerbose (1));
3260
}
3261
 
3262
#-------------------------------------------------------------------------------
3263
# Function        : BuildAccessPerms
3264
#
3265
# Description     : Check if access/permissions setting requested...
3266
#                   Legacy
3267
#
331 dpurdie 3268
#                   Don't know what it was meant to do
3269
#                   Unfortunately it is present in a lot of build.pl files
305 dpurdie 3270
#
331 dpurdie 3271
# Inputs          : None that are used
305 dpurdie 3272
#
331 dpurdie 3273
# Returns         : Undefined
3274
#
227 dpurdie 3275
sub BuildAccessPerms
3276
{
3277
}
3278
 
3279
 
3280
sub BuildSetenv
3281
{
3282
    push( @BUILDSETENV, @_ );
3283
}
3284
 
3285
#-------------------------------------------------------------------------------
3286
# Function        : DataDirective
3287
#
3288
# Description     : Called by data collection directives to ensure that we are
3289
#                   still collecting data and that we have collected other data
3290
#
3291
# Inputs          : $dname              - Directive Name
3292
#
3293
# Returns         : Will error if we are not
3294
#
3295
sub DataDirective
3296
{
3297
    my ($dname) = @_;
3298
 
3299
    Error( "$dname() must appear after BuildName()...")
3300
        if ( $BUILDNAME eq "" );
3301
 
3302
    Error( "$dname() must appear after BuildInterface()...")
3303
        unless( $BUILDINTERFACE );
3304
 
3305
    Error( "$dname() not allowed after BuildDescpkg, BuildIncpkg, BuildVersion or BuildMake")
3306
        if( $BUILDPHASE);
3307
}
3308
 
3309
#-------------------------------------------------------------------------------
3310
# Function        : StartBuildPhase
3311
#
3312
# Description     : Called by directives that deal with the building phases
3313
#                   to perform common initialisation and to ensure that
3314
#                   directives that collect data are no longer called
3315
#
305 dpurdie 3316
# Inputs          : last                - True: Last directive expected
227 dpurdie 3317
#
3318
# Returns         : May generate an error
3319
#
3320
sub StartBuildPhase
3321
{
305 dpurdie 3322
    my ($last) = @_;
3323
 
227 dpurdie 3324
    #
305 dpurdie 3325
    #   Ensure directive is allowed
3326
    #       $BUILDPHASE >  1     - No more directives allowed
3327
    #       $BUILDPHASE == 1     - Allowed directive
3328
    #
3329
    if ( $BUILDPHASE > 1 )
3330
    {
3331
        my $function = (caller(1))[3];
3332
        $function =~ s~.*::~~;
3333
        Error ("Directive not allowed: $function","'BuildMake' must be the last directive in the build file");
3334
    }
3335
 
3336
    #
227 dpurdie 3337
    #   Only do it once
3338
    #
305 dpurdie 3339
    return if ( $BUILDPHASE  );
3340
    $BUILDPHASE = 1;
227 dpurdie 3341
 
3342
    #
341 dpurdie 3343
    #   If we are not performing a ForceBuild, then we don't need to continue
3344
    #   We have updated the interface directory with BuildPkgArchive
3345
    #   information.
3346
    #
3347
    TestForForcedBuild();
3348
 
3349
    #
6133 dpurdie 3350
    #   Calculate the aliases that are being extracted from targets
227 dpurdie 3351
    #
3352
    Process_TargetAlias();
3353
 
3354
    #
6133 dpurdie 3355
    #   Calculate NATIVE and INSTRUMENT alias
3356
    #       Limit the Aliases to active platforms
7300 dpurdie 3357
    #       Another LMOS kudge. LMOS targets pick up alias from their base target
4728 dpurdie 3358
    #
7300 dpurdie 3359
    foreach my $alias (qw( NATIVE INSTRUMENT PKG_WIN PKG_RPM PKG_DEB))
4728 dpurdie 3360
    {
6133 dpurdie 3361
        if (exists $BUILDALIAS{$alias})
4728 dpurdie 3362
        {
6133 dpurdie 3363
            Warning("User has manually specified a $alias alias",'Default alias will not be set.');
4728 dpurdie 3364
        }
6133 dpurdie 3365
        else
3366
        {
7300 dpurdie 3367
            my %activePlatformMap;
3368
            foreach my $item (@BUILD_ACTIVEPLATFORMS) {
3369
                if ($item =~ m~^LMOS_(.*)~) {
3370
                    $activePlatformMap{$1} = $item;
3371
                } else {
3372
                    $activePlatformMap{$item} = $item;
3373
                }
3374
            }
3375
 
6133 dpurdie 3376
            my @activeAliases;
3377
            foreach my $item (PlatformConfig::getTargetsByTag($alias))
3378
            {
7300 dpurdie 3379
                push (@activeAliases, $activePlatformMap{$item}) if exists($activePlatformMap{$item});
6133 dpurdie 3380
            }
3381
            $BUILDALIAS{$alias} = join(' ', @activeAliases) if (@activeAliases);
3382
 
3383
            #
3384
            #   Add to the build entry too
3385
            #
3386
            foreach my $aliasTarget (@activeAliases)
3387
            {
3388
                push @{$BUILDINFO{$aliasTarget}{USERALIAS}}, $alias;
3389
            }
3390
        }
4728 dpurdie 3391
    }
6133 dpurdie 3392
    CleanUp_Aliases();
4728 dpurdie 3393
 
3394
    #
311 dpurdie 3395
    #   Create dummy package to describe the Interface directory
3396
    #
3397
    CreateInterfacePackage();
3398
 
3399
    #
227 dpurdie 3400
    #   Sanity test the users packages
6133 dpurdie 3401
    #       In a sandbox all bet are off
227 dpurdie 3402
    #
6133 dpurdie 3403
    PackageEntry::SanityTest() unless ($Clobber || $::GBE_SANDBOX);
227 dpurdie 3404
 
3405
    #
3406
    #   Validate the $Srcdir before its first real use
3407
    #   This is calculated from the user directives
3408
    #
3409
 
3410
    #.. Determine default "source" root
3411
    #
3412
    if ( $Srcdir eq "" )
3413
    {
3414
        Warning( "Both the directories 'src' and 'SRC' exist ....." )
3415
            if ( $ScmHost eq "Unix" && -e "src" && -e "SRC" );
3416
 
3417
        if ( -e "src" ) {
3418
            $Srcdir = "src";
3419
        } else {
3420
            ( -e "SRC" ) ||
3421
                Error( "Neither the directory 'src' nor 'SRC' exist ....." );
3422
            $Srcdir = "SRC";
3423
        }
3424
    }
3425
 
3426
    #
3427
    #   Must have a valid Srcdir
3428
    #
3429
    Error ("Source directory not found: $Srcdir")
3430
        unless ( $Srcdir && -d $Srcdir );
3431
 
305 dpurdie 3432
    #
3433
    #   Create source package
3434
    #
3435
    BuildSrcArchiveBody();
3436
 
227 dpurdie 3437
    return $Srcdir;
3438
}
3439
 
3440
#-------------------------------------------------------------------------------
341 dpurdie 3441
# Function        : TestForForcedBuild
3442
#
3443
# Description     : If a non-forced build has been requested, then see
3444
#                   if a build is required ( ie: build.pl modified )
6133 dpurdie 3445
#                   
3446
#                   Check:
3447
#                       Time stamp of build.pl
3448
#                       Time stamp of Makefile.gbe
3449
#                       BuildFilter has not changed
3450
#                       Signature of dependencies has not changed
3451
#                       No packages consumed from within the sandbox
341 dpurdie 3452
#
3453
# Inputs          : None
3454
#
3455
# Returns         : May not return
6133 dpurdie 3456
#                   Will return if we need to perform a build
341 dpurdie 3457
#
3458
sub TestForForcedBuild
3459
{
3460
    #
3461
    #   Always return if in clobber mode
3462
    #
3463
    return if ( $Clobber );
3464
 
3465
    if ( ! $ForceBuild  )
3466
    {
3467
        my @build_warn;
3468
        my $bstamp = -M "$Cwd/$ScmBuildSrc";
3469
        my $tstamp = -M "$Cwd/Makefile.gbe";
3470
 
3471
        push @build_warn, "Missing: Makefile.gbe" unless ( defined $tstamp );
3472
        push @build_warn, "Modified build file ($ScmBuildSrc)" if ( $tstamp && $bstamp < $tstamp );
3473
 
363 dpurdie 3474
        #
3475
        #   Ensure that the build filter has not changed
3476
        #   If the user has changed the buildfilter, then we need to
3477
        #   force a build.
3478
        #
6133 dpurdie 3479
        #   The root Makefile.gbe will have a $ScmBuildFilter entry
363 dpurdie 3480
        #
3481
        unless ( @build_warn )
3482
        {
3483
            use JatsMakeInfo;
3484
            ReadMakeInfo();
5726 dpurdie 3485
            my $line = $::ScmBuildFilter || '';
3486
            $line =~ s~\s+~ ~g;
363 dpurdie 3487
 
5726 dpurdie 3488
            my $filter = $::GBE_BUILDFILTER || '';
3489
            $filter =~ s~\s+~ ~g;
3490
            if ( $line ne $filter )
3491
            {
3492
                push @build_warn, "Build filter has changed";
3493
                Verbose2 ("Buildfilter Test: Was:$line, Is:$::GBE_BUILDFILTER");
3494
            }
363 dpurdie 3495
        }
3496
 
6133 dpurdie 3497
        #
7301 dpurdie 3498
        #   See if the dependencies have changed
3499
        #   
3500
        my $BuildpkgSig = Digest::SHA->new;
3501
        $BuildpkgSig->add("PKGNAME: $BUILDNAME_PACKAGE $BUILDNAME_VERSION $BUILDNAME_SUFFIX");
3502
 
3503
        #
3504
        #   Include the signature of ALL dependent packages
3505
        #   Ie: The build fingerprint is a function of the source and its dependents
3506
        #
3507
        my $depTagFile = catfile($ScmInterface, 'build.bfp');
3508
        unless (-f $depTagFile) {
3509
            push @build_warn, "Missing: $depTagFile";
3510
        }
3511
        else
3512
        {
3513
            foreach my $tag ( PackageEntry::GetPackageList() )
3514
            {
3515
                my $pkgSig = PackageEntry::GetPackageSignature($tag);
3516
                $BuildpkgSig->add("PKGSIGNATURE: $pkgSig");
3517
            }
3518
            my $depSha1 =  $BuildpkgSig->hexdigest;
3519
            Debug2("DepSha1: $depSha1");
3520
            unless (TagFileMatch ($depTagFile, $depSha1))
3521
            {
3522
                push @build_warn, "Dependency signatures have changed";
3523
            }
3524
        }
3525
 
3526
        #
6133 dpurdie 3527
        #   If any of the imported packages are from a sandbox, then we must force a build
3528
        #   and a make.
3529
        #
3530
        if ($pkgFromSandbox)
3531
        {
3532
            push @build_warn, "Consuming packages from within the sandbox";
3533
        }
3534
 
341 dpurdie 3535
        if ( @build_warn )
3536
        {
363 dpurdie 3537
            Verbose ("Forcing Build.", @build_warn );
341 dpurdie 3538
        }
3539
        else
3540
        {
3541
            Verbose ("No build performed. Build files up to date");
3542
            Log ("Build files up to date") if $::GBE_SANDBOX;
3543
            exit 0;
3544
        }
3545
    }
3546
}
3547
 
3548
#-------------------------------------------------------------------------------
305 dpurdie 3549
# Function        : LastBuildDirective
3550
#
3551
# Description     : No more build directives allowed
3552
#
3553
# Inputs          : 
3554
#
3555
# Returns         : 
3556
#
3557
sub LastBuildDirective
3558
{
3559
    $BUILDPHASE = 2;
3560
}
3561
 
3562
#-------------------------------------------------------------------------------
227 dpurdie 3563
# Function        : BuildPackageLink
3564
#
3565
# Description     : Create a soft link from sandbox_dpkg_archive to the package
3566
#                   being created by this build
3567
#
3568
#                   For backward compatability.
3569
#                   If GBE_DPKG_SBOX is not defined, then use GBE_DPKG_LOCAL
3570
#
3571
#                   This will allow multiple components to work together
3572
#
3573
#                   Note: When called in Clobber-mode the link will be deleted
3574
#
3575
# Inputs          : $BUILDNAME              - The package name
3576
#                   $BUILDNAME_PROJECT      - Project extension
3577
#                   $::GBE_DPKG_SBOX        - Path of sandbox_dpkg_archive
3578
#                   $::GBE_DPKG_LOCAL       - Path of local_dpkg_archive
3579
#                   $::GBE_DPKG             - Main repository
3580
#
3581
# Returns         : Nothing
3582
#
3583
sub BuildPackageLink
3584
{
3585
    my $target_archive;
3586
    my $target_archive_name;
3587
    my $link_file;
3588
    my $tag;
371 dpurdie 3589
    my $root_path;
227 dpurdie 3590
 
3591
    #
3592
    #   Determine the path (and name) of the target archive
3593
    #   Use sandbox_dpkg_archive if it exists
3594
    #   Use local_dpkg_acrhive for backward compatability (should be removed after JATS 2.64.2+)
3595
    #
3596
    if ( $target_archive = $::GBE_DPKG_SBOX )
3597
    {
3598
        $target_archive_name = "sandbox_dpkg_archive";
3599
        $tag = "Sandbox";
7301 dpurdie 3600
        $link_file  = 'sandbox' . ${BUILDNAME_SUFFIX} . '.lnk';
371 dpurdie 3601
        $root_path = 'GBE_SANDBOX' . substr($Cwd, length($::GBE_SANDBOX));
3602
        Verbose2("Root Path: $::GBE_SANDBOX, $root_path");
227 dpurdie 3603
    }
3604
    elsif ( $target_archive = $::GBE_DPKG_LOCAL )
3605
    {
3606
        $target_archive_name = "local_dpkg_archive";
3607
        $link_file = "$BUILDVERSION.lnk";
3608
        $tag = "Local";
371 dpurdie 3609
        $root_path = $Cwd;
227 dpurdie 3610
    }
3611
    else
3612
    {
3613
        Verbose("Cannot locate local or sandbox archive")
3614
            unless $Clobber;
3615
        return;
3616
    }
3617
 
3618
    #
3619
    #   Santity test
3620
    #   Target must be a directory
3621
    #
3622
    unless ( -d $target_archive )
3623
    {
241 dpurdie 3624
        Warning("$target_archive_name is not a directory: $target_archive")
227 dpurdie 3625
            unless $Clobber;
3626
        return;
3627
    }
3628
 
3629
    my $link_dir = "$target_archive/$BUILDNAME_PACKAGE";
3630
    my $link_path = "$link_dir/$link_file";
3631
 
6133 dpurdie 3632
    if ( $Clobber || $NoBuild )
227 dpurdie 3633
    {
3634
        unlink $link_path;          # Delete the link
3635
        rmdir $link_dir;            # Delete only if empty
3636
    }
3637
    else
3638
    {
261 dpurdie 3639
        Log( "Local Link . $BUILDNAME_PACKAGE/$link_file ($tag)");
3640
        mkdir $link_dir unless -d $link_dir;
371 dpurdie 3641
        FileCreate ( $link_path, "$root_path/pkg/$BUILDNAME_PACKAGE");
227 dpurdie 3642
    }
3643
}
3644
 
3645
#-------------------------------------------------------------------------------
3646
# Function        : BuildSandboxData
3647
#
3648
# Description     : Create data structures to allow this package to be built
3649
#                   within a multi-package sandbox.
3650
#
3651
#                   This will allow multiple components to work together
6133 dpurdie 3652
#                   Creates:
3653
#                       sandbox.int     - Rel path to the packages interface
3654
#                       sandbox.ffp     - Fast FingerPrint over the package body
3655
#                       sandbox.nob     - No Build marker
227 dpurdie 3656
#
3657
#                   Note: When called in Clobber-mode the link will be deleted
3658
#
3659
# Inputs          : $BUILDNAME              - The package name
3660
#                   $BUILDNAME_PROJECT      - Project extension
3661
#                   $::GBE_DPKG_SBOX        - Path of sandbox_dpkg_archive
3662
#                   $::GBE_DPKG             - Main repository
3663
#
3664
# Returns         : Nothing
3665
#
3666
sub BuildSandboxData
3667
{
3668
    my $sandbox_dpkg_archive = $::GBE_DPKG_SBOX;
3669
    return unless ( $sandbox_dpkg_archive );
3670
 
3671
    unless ( -d $sandbox_dpkg_archive )
3672
    {
241 dpurdie 3673
        Error("sandbox_dpkg_archive is not a directory: $sandbox_dpkg_archive")
227 dpurdie 3674
            unless $Clobber;
3675
        return;
3676
    }
3677
 
3678
    #
3679
    #   Create a name for this package in the sandbox
3680
    #   Must use the package name and extension. Don't use the version
3681
    #   information as this will not be correct
3682
    #
3683
    #   PACKAGE/sandbox.PRJ.cfg
3684
    #
3685
    my $link_dir = "$sandbox_dpkg_archive/$BUILDNAME_PACKAGE";
6133 dpurdie 3686
    my $base = 'sandbox' . ${BUILDNAME_SUFFIX}; 
359 dpurdie 3687
 
6133 dpurdie 3688
    my $nob_path  = $base . ".nob";
3689
    my $ffp_path  = $base . ".ffp";
3690
    my $int_path  = $base . ".int";
227 dpurdie 3691
 
6133 dpurdie 3692
    $nob_path = "$link_dir/$nob_path";
3693
    $ffp_path = "$link_dir/$ffp_path";
3694
    $int_path = "$link_dir/$int_path";
3695
 
227 dpurdie 3696
    if ( $Clobber )
3697
    {
3698
        rmdir $link_dir;            # Delete only if empty
3699
    }
3700
    else
3701
    {
6133 dpurdie 3702
        ToolsetFiles::AddFile($nob_path);
3703
        ToolsetFiles::AddFile($ffp_path);
3704
        ToolsetFiles::AddFile($int_path);
3705
 
3706
        #Log( "Sandbox Data. $base");
3707
        unlink $int_path;
227 dpurdie 3708
        mkdir $link_dir;
3709
 
3710
        #
6133 dpurdie 3711
        #   File with path to the interface directory
3712
        #   Relative to the base of the sandbox
227 dpurdie 3713
        #
6133 dpurdie 3714
        FileCreate($int_path, catdir('GBE_SANDBOX',RelPath($Cwd,$::GBE_SANDBOX),$BUILDINTERFACE ));
227 dpurdie 3715
 
3716
        #
6133 dpurdie 3717
        #   Indicate packages not build on this machine
227 dpurdie 3718
        #
6133 dpurdie 3719
        unlink $nob_path;           # Delete the NoBuild marker
3720
        if ($NoBuild) {
3721
            TouchFile($nob_path);
3722
        }
227 dpurdie 3723
    }
3724
}
3725
 
3726
 
3727
#-------------------------------------------------------------------------------
3728
# Function        : BuildMake
3729
#
3730
# Description     : Generate the makefiles
3731
#                   This directive MUST be the last directive in the build.pl
3732
#                   file. The directive triggers the processing of all the
3733
#                   information that has been collected
3734
#
3735
#
3736
# Inputs          : None
3737
#
3738
# Returns         : Nothing
3739
#
3740
 
3741
sub BuildMake
3742
{
3743
    my( $argc, $platform );
3744
 
3745
    #
3746
    #   Must have a valid $BUILDINTERFACE
3747
    #   Normally this is held in the interface directory, but this is not
3748
    #   always created. If there is no $BUILDINTERFACE, then use the
3749
    #   build directory
3750
    #
6133 dpurdie 3751
    BuildInterfaceInternal($::ScmInterface) unless ( $BUILDINTERFACE );
227 dpurdie 3752
 
6133 dpurdie 3753
 
227 dpurdie 3754
    #.. Starting the build phase. No more data collection
3755
    #
305 dpurdie 3756
    StartBuildPhase();
3757
    LastBuildDirective();
227 dpurdie 3758
 
5109 dpurdie 3759
    #
3760
    #   Now that the bulk of the information has been displayed
3761
    #   we can display captured messages. These warnings will be 
3762
    #   at the end of the log so that users can see them.
3763
    DumpCapture();
3764
 
227 dpurdie 3765
    sub DeleteCfg
3766
    {
3767
        #
3768
        #   Delete files that will be re-created
3769
        #   Some of these files are read and written.
3770
        #   Errors in the files are solved by deleting the files now.
3771
        #
3772
        unlink "$BUILDINTERFACE/build.cfg";
3773
        unlink "$BUILDINTERFACE/Makefile.cfg";
3774
        unlink glob ("$BUILDINTERFACE/Makefile*.cfg");
3775
        unlink "$BUILDINTERFACE/Buildfile.cfg";
3776
        unlink "$BUILDINTERFACE/Dpackage.cfg";
3777
    }
3778
 
3779
    if ( $Clobber )                             # clobber mode ?
3780
    {
4003 dpurdie 3781
        #
3782
        #   Unmake all the makefiles
3783
        #   No longer needed as we track the file that are created
3784
        #
3785
        #if ( -e "Makefile.gbe" )
3786
        #{
3787
        #    JatsTool ( 'jmake.pl', 'unmakefiles');
3788
        #}
3789
 
3790
        #
3791
        #   Delete my own configuration files
3792
        #
227 dpurdie 3793
        DeleteCfg();
3794
 
3795
        #
3796
        #   JATS creates a 'pkg' directory for the target package
3797
        #
3798
        push @CLOBBERDIRS, "pkg";
3799
 
3800
        #
3801
        #   Deployment creates a 'build/deploy' directory
375 dpurdie 3802
        #   The 'build' directory may contain user files - only remove if empty
227 dpurdie 3803
        #
3804
        push @CLOBBERDIRS, "build/deploy";
375 dpurdie 3805
        push @REMOVEDIRS, "build";
227 dpurdie 3806
 
3807
        #
6133 dpurdie 3808
        #   List of files maintained by the build system
3809
        #
3810
        my @toolsetFiles = ToolsetFiles::GetFiles();
3811
 
3812
        #
227 dpurdie 3813
        #   Delete interface directories and other directories that have been
375 dpurdie 3814
        #   marked to be clobbered
227 dpurdie 3815
        #
3816
        foreach my $dir ( @CLOBBERDIRS )
3817
        {
3818
            next if ( $dir eq '.' );
3819
            next if ( $dir eq '..' );
3820
            if ( -d $dir )
3821
            {
361 dpurdie 3822
                RmDirTree ( $dir );
227 dpurdie 3823
            }
3824
        }
3825
 
375 dpurdie 3826
        foreach my $dir ( @REMOVEDIRS )
3827
        {
3828
            next if ( $dir eq '.' );
3829
            next if ( $dir eq '..' );
3830
            if ( -d $dir )
3831
            {
3832
                rmdir ( $dir ); # Only if empty
3833
            }
3834
        }
3835
 
6133 dpurdie 3836
        foreach my $file (@toolsetFiles)
227 dpurdie 3837
        {
6133 dpurdie 3838
            RmDirTree ( $file ) if ( -f $file );
227 dpurdie 3839
        }
3840
 
3841
        #
3842
        #   DPACKAGE may be a user file, Only delete it if we created it
3843
        #
299 dpurdie 3844
        unlink "$Srcdir/DPACKAGE.$::GBE_MACHTYPE" if $DeleteDPACKAGE;
227 dpurdie 3845
 
3846
        BuildPackageLink();
3847
        BuildSandboxData();
3848
        return;
3849
    }
3850
 
3851
    #.. Build support files
3852
    #
3853
    DeleteCfg();
3854
    BuildConfig();
3855
    BuildSharedLibFiles();
3856
    WriteParsedBuildConfig();
3857
    BuildPackageLink();
3858
    BuildSandboxData();
4003 dpurdie 3859
    NoBuildMarker();
227 dpurdie 3860
 
3861
    #
3862
    #  ONLY (re)building interface dir
3863
    #
3864
    return
3865
        if ( $Interface );
3866
 
3867
    #---------------------------------------------------------------------------
3868
    #
3869
    #.. Make bootstrap "makefile",
3870
    #   Simulate a top level makefile
3871
    #       Pass argumenst to makelib
3872
    #       Sumulate SubDir() operations
3873
    #       Sumulate a Platform(*);
3874
    #
3875
    #       Due to the normal way that makelib.pl is executed,
3876
    #       the following substitutions are done.
3877
    #
3878
    @ARGV = ();
3879
    $0 = "makefile.pl ";
3880
    push @ARGV, "$Cwd";                         # current working directory
331 dpurdie 3881
    push @ARGV, "$::GBE_TOOLS/makelib.pl";     # makelib.pl image
227 dpurdie 3882
    push @ARGV, "--interface=$BUILDINTERFACE"
261 dpurdie 3883
        if ($BUILDINTERFACE);
227 dpurdie 3884
 
3885
    Debug( "ARGV:      @ARGV" );
3886
 
3887
    #.. (re)Build root makefile
3888
    #
3889
    $ScmBuildlib = 0;                           # clear Buildlib flag for 'makelib.pl'
3890
    RootMakefile();                             # inform 'makelib.pl'
3891
    MakeLibInit();                              # run initialisation
3892
 
3893
    #.. Register subdir(s)
3894
    #
3895
    UniquePush (\@BUILDSUBDIRS, $Srcdir );
3896
    SubDir( @BUILDSUBDIRS );
3897
    Platform( @BUILD_ACTIVEPLATFORMS );
3898
 
3899
    #.. (re)build src makefiles and associated information
367 dpurdie 3900
    #   JatsTool will not return on error
227 dpurdie 3901
    #
263 dpurdie 3902
    my @cmds = ('jmake.pl', 'rebuild');
227 dpurdie 3903
    push @cmds, 'NORECURSE=1' if ( $RootOnly );
263 dpurdie 3904
    JatsTool ( @cmds);
305 dpurdie 3905
 
3906
    #
7301 dpurdie 3907
    #   Generate package signature
3908
    #
6133 dpurdie 3909
    ErrorConfig( 'name' => 'buildlib')   ;
7301 dpurdie 3910
    BuildSignature();
3911
 
3912
    #
305 dpurdie 3913
    #   Generate some warnings that will be seen at the end of the build
3914
    #
3915
    Warning ("BuildSrcArchive Directive Present","Read JATS Manual for correct usage")
3916
        if ($build_source_pkg);
227 dpurdie 3917
}
3918
 
7301 dpurdie 3919
#-------------------------------------------------------------------------------
3920
# Function        : BuildSignature 
3921
#
3922
# Description     : Generate a package 'signature' for this package
3923
#               
3924
#                   The signature is used to bypass the entire Make processing in a sandbox
3925
#                   If we can find a matching package in the package store then we don't 
3926
#                   need to 'make' this package.
3927
#
3928
#                   There are two scenarios:
3929
#                       In a GIT enabled sandbox
3930
#                       Without GIT
3931
#                       
3932
#                   In a GIT enabled sandbox the signature allows the use of a pre-built 
3933
#                   package - even if the package has been built on a different branch.
3934
#                   
3935
#                       The signature includes:
3936
#                           The name of this package
3937
#                           The GIT sha1 of the directory trees that contain this package
3938
#                           The package signatures of all dependent packages
3939
#                           
3940
#                   In a Non-GIT enabled sandbox the package signature will be set such that
3941
#                   the package will never be found in the package store and the package MUST
3942
#                   be built within the sandbox.
3943
#                   
7302 dpurdie 3944
#                   The hard part is determing the directory trees that contains this package
7301 dpurdie 3945
#                   Ideally this is a single dir-tree, but this cannot be enforced.
3946
#                   
3947
#                   Source directories have been gathered during makefile generation
3948
#                   
3949
#                   This suits most cases, but there are a few where the user needs
3950
#                   to give JATS a hint. Use the AsdSrcDir directive to extend
3951
#                   the signature paths to directories not under the build.pl
3952
#                   or any makefile included by the build.pl
3953
#                       
3954
# Inputs          : 
3955
#
3956
# Returns         : 
3957
#
3958
sub BuildSignature
3959
{
3960
    my %sigExcludeDirs;
3961
    my %sigExcludeFiles;
3962
    my $BuildSignatureSha1;
3963
    my $signatureFile = catfile($Cwd, $BUILDINTERFACE, 'Package.sig');
3964
    my $sigDebugFile  = catfile($Cwd, $BUILDINTERFACE, 'Package.dsig');
3965
    my @sigList;
227 dpurdie 3966
 
7301 dpurdie 3967
    #
3968
    #   Only create the Signature file ONCE
3969
    #   Done on first build (after a clobber)
3970
    #
3971
#   if (-f $signatureFile)
3972
#   {
3973
#       Message("Generate Package Signature - Already generated");
3974
#       return;
3975
#   }
3976
 
3977
    Message("Generate Package Signature");
3978
 
3979
    #
3980
    #   Determine if this is a GIT enabled sandbox build
3981
    #   Need a .git directory or file in the root of the sandbox
3982
    #
3983
    my $gitEnabled;
3984
    if ($::GBE_SANDBOX && -e catfile ($::GBE_SANDBOX, '.git') )
3985
    {
3986
        $gitEnabled = 1;
3987
    }
3988
 
3989
    #
3990
    #   Start generating the signature
3991
    #       Include the package Name,Version and Project
3992
    #
3993
    $BuildSignatureSha1 = Digest::SHA->new;
3994
    $BuildSignatureSha1->add("PKGNAME: $BUILDNAME_PACKAGE $BUILDNAME_VERSION $BUILDNAME_SUFFIX");
3995
    push @sigList, "PKGNAME: $BUILDNAME_PACKAGE $BUILDNAME_VERSION $BUILDNAME_SUFFIX: " . $BuildSignatureSha1->clone->hexdigest;
3996
 
3997
    #
3998
    #   Include the signature of ALL dependent packages
3999
    #   Ie: The package signature is a function of the source and its dependents
4000
    #
4001
    foreach my $tag ( PackageEntry::GetPackageList() )
4002
    {
4003
        my $pkgSig = PackageEntry::GetPackageSignature($tag);
4004
        $BuildSignatureSha1->add("PKGSIGNATURE: $pkgSig");
7302 dpurdie 4005
        push @sigList, sprintf("PKGSIGNATURE: [%s] %s: %s", PackageEntry::GetNameVersion($tag), $pkgSig , $BuildSignatureSha1->clone->hexdigest);
7301 dpurdie 4006
    }
4007
 
4008
    #
4009
    #   Save the signature of the package header and the dependencies
4010
    #   This will be used for a simple test to see in we need to rebuild the build file 
4011
    #
4012
    my $depSha1 =  $BuildSignatureSha1->clone->hexdigest;
4013
    Debug2("DepSha1: $depSha1");
4014
    FileCreate( catfile($ScmInterface, 'build.bfp'), $depSha1 );
4015
 
4016
    if ($gitEnabled)
4017
    {
4018
        #
4019
        #   Include the sha1 of all 'git' tree items that form the complete source image
4020
        #
4021
        my @relDirList = map { my $relName = $_; $relName =~ s~^$::GBE_SANDBOX/~~; $relName  } ToolsetFiles::GetSubTrees(); 
4022
        my @cmdList = map { 'HEAD:' . $_  } @relDirList;
4023
Debug0(" GIT DIR: @relDirList" );
4024
Debug0(" GIT CMD: " . "git rev-parse @cmdList" );
4025
        my $index = 0;
4026
 
4027
        my $callback = sub {
4028
            my ($cdata, $line) = @_;
4029
            $line =~ s~\s+$~~;
4030
Debug0(" GIT OUT: " . $line  );
4031
            $BuildSignatureSha1->add($line);
4032
            push @sigList, "PKGSRC: $relDirList[$index++]: $line: " . $BuildSignatureSha1->clone->hexdigest;
4033
            return 0;
4034
        };
4035
 
4036
        GitCmd('rev-parse', @cmdList, { process => $callback } );
4037
        $BUILDSIGNATURE =  $BuildSignatureSha1->hexdigest;
4038
    }
4039
    else
4040
    {
7302 dpurdie 4041
        $BUILDSIGNATURE = 'MSG: Sandbox is not git enabled';
7301 dpurdie 4042
    }
4043
 
4044
    Message("Signature: $BUILDSIGNATURE");
4045
    push @sigList, "Signature: $BUILDSIGNATURE";
4046
    FileCreate( $signatureFile, $BUILDSIGNATURE );
4047
    FileCreate( $sigDebugFile, @sigList );
4048
Debug0("sigDebugFile: $sigDebugFile");
4049
 
4050
    #
4051
    #   Create the descpkg file - to include the signature
4052
    #
4053
    BuildDescpkg('Internal');
4054
}
4055
 
227 dpurdie 4056
#-------------------------------------------------------------------------------
7301 dpurdie 4057
# Function        : GitCmd
4058
#
4059
# Description     : Run a Git Command and capture/process the output
4060
#
4061
#                   Based on JatsSvnCore:GitCmd
4062
#
4063
# Inputs          : Command
4064
#                   Command arguments
4065
#                   Last argument may be a hash of options.
4066
#                       nosavedata  - Don't save the data
4067
#                       process     - Callback function
4068
#                       printdata   - Print data
4069
#                       error       - Error Message
4070
#                                     Used as first line of an Error call
4071
#
4072
# Returns         : non-zero on errors detected
4073
#
4074
sub GitCmd
4075
{
4076
    my $self;           # Local storage
4077
    Debug ("GitCmd");
4078
 
4079
    #
4080
    #   Locate essential tools
4081
    #
4082
    our $GBE_SVN_PATH;
4083
    EnvImportOptional('GBE_GIT_PATH', '');
4084
    Debug ("GBE_GIT_PATH", $::GBE_GIT_PATH);
4085
 
4086
    my $stdmux = LocateProgInPath ( 'stdmux');
4087
    my $git    = LocateProgInPath ( 'git', '--All', '--Path=' . $::GBE_GIT_PATH );
4088
 
4089
    #
4090
    #   Extract arguments and options
4091
    #   If last argument is a hash, then its a hash of options
4092
    #
4093
    my $opt;
4094
    $opt = pop @_
4095
        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH'));
4096
 
4097
    $self->{PRINTDATA} = $opt->{'printdata'} if ( exists $opt->{'printdata'} );
4098
 
4099
    Verbose2 "GitCmd $git @_";
4100
 
4101
    #
4102
    # Useful debugging
4103
    #
4104
    # $self->{LAST_CMD} = [$svn, @_];
4105
 
4106
    #
4107
    #   Reset command output data
4108
    #
4109
    $self->{ERROR_LIST} = [];
4110
    $self->{RESULT_LIST} = [];
4111
#    $self->{LAST_CMD} = \@_;
4112
 
4113
    #
4114
    #   Make use of a wrapper program to mux the STDERR and STDOUT into
4115
    #   one stream (STDOUT). #   This solves a lot of problems
4116
    #
4117
    #   Do not use IO redirection of STDERR because as this will cause a
4118
    #   shell (sh or cmd.exe) to be invoked and this makes it much
4119
    #   harder to kill on all platforms.
4120
    #
4121
    #   Use open3 as it allows the arguments to be passed
4122
    #   directly without escaping and without any shell in the way
4123
    #
4124
    local (*CHLD_OUT, *CHLD_IN);
4125
    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, '>&STDERR', $stdmux, $git, @_);
4126
 
4127
    #
4128
    #   Looks as though we always get a PID - even if the process dies
4129
    #   straight away or can't be found. I suspect that open3 doesn't set
4130
    #   $! anyway. I know it doesn't set $?
4131
    #
4132
    Debug ("Pid: $pid");
4133
    Error ("Can't run command: $!") unless $pid;
4134
 
4135
    #
4136
    #   Close the input handle
4137
    #   We don't have anything to send to this program
4138
    #
4139
    close(CHLD_IN);
4140
 
4141
    #
4142
    #   Monitor the output from the utility
4143
    #   Have used stdmux to multiplex stdout and stderr
4144
    #
4145
    #   Note: IO::Select doesn't work on Windows :(
4146
    #   Note: Open3 will cause blocking unless both streams are read
4147
    #         Can read both streams becsue IO::Select doesn't work
4148
    #
4149
    #   Observation:
4150
    #       svn puts errors to STDERR
4151
    #       svn puts status to STDOUT
4152
    #
4153
    while (<CHLD_OUT>)
4154
    {
4155
        s~\s+$~~;
4156
        tr~\\/~/~;
4157
 
4158
 
4159
        Verbose3 ( "GitCmd:" . $_);
4160
        m~^STD(...):(.+)~;
4161
        my $data = $1 ? $2 : $_;
4162
        next unless ( $data );
4163
 
4164
        if ( $1 && $1 eq 'ERR' )
4165
        {
4166
            #
4167
            #   Process STDERR output
4168
            #
4169
            push @{$self->{ERROR_LIST}}, $data;
4170
        }
4171
        else
4172
        {
4173
            #
4174
            #   Process STDOUT data
4175
            #
4176
            push @{$self->{RESULT_LIST}}, $data unless ($opt->{'nosavedata'});
4177
 
4178
            #
4179
            #   If the user has specified a processing function then pass each
4180
            #   line to the specified function.  A non-zero return will
4181
            #   be taken as a signal to kill the command.
4182
            #
4183
            if ( exists ($opt->{'process'}) && $opt->{'process'}($self, $data) )
4184
            {
4185
                kill 9, $pid;
4186
                sleep(1);
4187
                last;
4188
            }
4189
        }
4190
    }
4191
 
4192
    close(CHLD_OUT);
4193
 
4194
    #
4195
    #   MUST wait for the process
4196
    #   Under Windows if this is not done then we eventually fill up some
4197
    #   perl-internal structure and can't spawn anymore processes.
4198
    #
4199
    my $rv = waitpid ( $pid, 0);
4200
 
4201
    #
4202
    #   If an error condition was detected and the user has provided
4203
    #   an error message, then display the error
4204
    #
4205
    #   This simplifies the user error processing
4206
    #
4207
    if ( @{$self->{ERROR_LIST}} && $opt->{'error'}  )
4208
    {
4209
        Error ( $opt->{'error'}, @{$self->{ERROR_LIST}} );
4210
    }
4211
 
4212
    #
4213
    #   Exit status has no meaning since open3 has been used
4214
    #   This is because perl does not treat the opened process as a child
4215
    #   Not too sure it makes any difference anyway
4216
    #
4217
    #
4218
    Debug ("Useless Exit Status: $rv");
4219
    my $result = @{$self->{ERROR_LIST}} ? 1 : 0;
4220
    Verbose3 ("Exit Code: $result");
4221
 
4222
    return $result;
4223
}
4224
 
4225
 
4226
#-------------------------------------------------------------------------------
227 dpurdie 4227
# Function        : BuildVersion
4228
#
4229
# Description     : Generate version.c and version.h files
4230
#
4231
# Inputs          : Options
4232
#                       --Prefix=prefix         Text prepended to variables created
4233
#                                               as a part of the "C" versions
4234
#                       --Type=type             Type of "C" style data
4235
#                                               Allowed types are: array
4236
#                       --Defs=name             Generate a "C" definitions file.
4237
#                                               This file simply contains definitions
4238
#                       --Defs                  Same as --Defs=defs
4239
#                       --Style=style           Output file style
4240
#                                               Supported styles:
4241
#                                                   "C" - Default
4242
#                                                   "CSharp"
4243
#                                                   "WinRC"
289 dpurdie 4244
#                                                   "Delphi"
315 dpurdie 4245
#                                                   "VB"
227 dpurdie 4246
#                       --File=name             Specifies the output file name
4247
#                                               Default is determined by the style
4248
#
4249
#                   Also allows for an 'old' style format in which
4250
#                   the first three arguments are prefix,type and defs
4251
# Returns         :
4252
#
4253
 
4254
sub BuildVersion
4255
{
4256
    my ( $Prefix, $Type, $Mode ) = @_;
4257
    my $ModePrefix;
4258
    my $Style = "C";
4259
    my $FileName;
4260
    my $VersionFiles;
267 dpurdie 4261
    my @opts;
4262
    my $supports_opts;
227 dpurdie 4263
 
4264
    StartBuildPhase();                          # Starting the build phase. No more data collection
4265
 
279 dpurdie 4266
    if ( defined($Prefix) && $Prefix =~ /^-/ )
227 dpurdie 4267
    {
4268
        $Prefix = undef;
4269
        $Type = undef;
4270
        $Mode = undef;
4271
        foreach  ( @_ )
4272
        {
4273
            if (      /^--Prefix=(.*)/ ) {
4274
                $Prefix = $1;
4275
                $VersionFiles = 1;
4276
 
4277
            } elsif ( /^--Type=(.*)/ ) {
4278
                $Type = $1;
4279
                $VersionFiles = 1;
4280
 
4281
            } elsif ( /^--Defs=(.*)/ ) {
4282
                $Mode = $1;
4283
                $ModePrefix = "_$1";
4284
 
4285
            } elsif ( /^--Defs$/ ) {
4286
                $Mode = 'defs';
4287
                $ModePrefix = "";
4288
 
4289
            } elsif ( /^--Style=(.*)/ ) {
4290
                $Style = $1;
279 dpurdie 4291
                $VersionFiles = 1;
267 dpurdie 4292
                $supports_opts = 1 if ( $Style =~ /^WinRC/i );
227 dpurdie 4293
 
4294
            } elsif ( /^--File=(.*)/ ) {
4295
                $FileName = $1;
4296
 
267 dpurdie 4297
            } elsif ($supports_opts ) {
4298
                push @opts, $_;
235 dpurdie 4299
 
227 dpurdie 4300
            } else {
4301
                Error ("BuildVersion: Unknown option: $_");
4302
 
4303
            }
4304
        }
4305
    }
4306
    else
4307
    {
4308
        #
4309
        #   Old style positional arguments.
4310
        #
4311
        $VersionFiles = 1;
4312
        if ( defined( $Mode ) )
4313
        {
4314
            if ( $Mode =~ m/^defs(=(.*))?$/i )
4315
            {
4316
                $Mode       = $2 ? $2    : 'defs';
4317
                $ModePrefix = $2 ? "_$2" : "";
4318
            }
4319
            else
4320
            {
4321
                Error ("BuildVersion: Bad Mode argument. Need 'defs' or 'defs=name'");
4322
            }
4323
        }
4324
    }
4325
 
4326
    #
4327
    #   Determine the style of version file to create
4328
    #
4329
    if ( $Style =~ /^CSharp/i ) {
4330
        BuildVersionCSharp( $FileName );
4331
 
229 dpurdie 4332
    } elsif ( $Style =~ /^Properties/i ) {
4333
        BuildVersionProperties( $FileName, $Prefix );
4334
 
227 dpurdie 4335
    } elsif ( $Style =~ /^WinRC/i ) {
267 dpurdie 4336
        BuildVersionWinRC( $FileName, @opts );
227 dpurdie 4337
 
289 dpurdie 4338
    } elsif ( $Style =~ /^Delphi/i ) {
4339
        BuildVersionDelphi( $FileName, $Prefix );
315 dpurdie 4340
 
4341
    } elsif ( $Style =~ /^VB/i ) {
4342
        BuildVersionVB( $FileName, $Prefix );
289 dpurdie 4343
 
227 dpurdie 4344
    } elsif ( $Style eq "C" ) {
289 dpurdie 4345
        BuildVersionC    ( $FileName, $Prefix, $Type )     if ( $VersionFiles );
4346
        BuildVersionCdefs( $FileName, $Mode, $ModePrefix ) if ( $Mode );
227 dpurdie 4347
 
4348
    } else {
4349
        Error("BuildVersion: Unknown style: $Style");
4350
    }
4351
}
4352
 
4353
#-------------------------------------------------------------------------------
4354
# Function        : BuildDescpkg
4355
#
4356
# Description     : Create a package description file
4357
#                   The format of this file matches that generated by JANTS
4358
#                   Take care when extending the format
4359
#
4360
#                   NOTE: It turns out that JANTS is not a standard and the
4361
#                         implementors (of JANTS) kept on changing it.
4362
#
7301 dpurdie 4363
# Inputs          : $mode - 'Internal' - Skip sanity test
227 dpurdie 4364
#
4365
# Returns         :
4366
#
4367
sub BuildDescpkg
4368
{
7301 dpurdie 4369
    my ($mode) = @_;
4370
    unless ($mode && $mode eq 'Internal')
4371
    {
4372
        StartBuildPhase();                  # Starting the build phase. No more data collection
4373
    }
4003 dpurdie 4374
    return if ( $Clobber );                 # clobber mode ?
227 dpurdie 4375
 
247 dpurdie 4376
    #
4377
    #   Store the files location for use at runtime
4378
    #   It will be a file that is 'known' to JATS
4379
    #
4003 dpurdie 4380
    my $pkgfile = BuildAddKnownFile ( $NoBuild ? $Cwd : $Srcdir, 'descpkg' );
227 dpurdie 4381
 
261 dpurdie 4382
    my @desc;
279 dpurdie 4383
    push @desc, "Package Name:  $BUILDNAME_PACKAGE";
4384
    push @desc, "Version:       $BUILDVERSION";
7301 dpurdie 4385
    push @desc, "Signature:     $BUILDSIGNATURE" if defined $BUILDSIGNATURE;
279 dpurdie 4386
    push @desc, "Released By:   $::USER";
4387
    push @desc, "Released On:   $::CurrentTime";
4388
    push @desc, "Build Machine: $::GBE_HOSTNAME";
4389
    push @desc, "Path:          $Cwd";
4390
    push @desc, "Jats Version:  $::GBE_VERSION";
4391
    push @desc, "Jats Path:     $::GBE_CORE";
261 dpurdie 4392
    push @desc, "";
4393
    push @desc, "Build Dependencies:";
4394
    push @desc, "";
227 dpurdie 4395
 
4396
    foreach my $tag ( PackageEntry::GetPackageList )
4397
    {
4398
        my ($name, $version, $type) = PackageEntry::GetPackageData($tag);
4399
 
4400
        my @attributes;
4401
 
4402
        push @attributes, "name=\"$name\"";
4403
        push @attributes, "version=\"$version\"";
4404
        push @attributes, "build=\"true\"" if $type =~ /Build/i;
4405
 
261 dpurdie 4406
        push @desc, "<sandbox @attributes/>";
227 dpurdie 4407
    }
247 dpurdie 4408
 
261 dpurdie 4409
    FileCreate ($pkgfile, \@desc );
227 dpurdie 4410
}
4411
 
4412
#-------------------------------------------------------------------------------
4003 dpurdie 4413
# Function        : NoBuildMarker
4414
#
4415
# Description     : Maintain the nobuild marker
4416
#                   This is file placed in the interface directory simply
4417
#                   to indicate to the 'create_dpkg' utility that this build
4418
#                   does not do anything useful.
4419
#
6133 dpurdie 4420
#                   It will only be used on a build machine by the build daemon
4003 dpurdie 4421
#
4422
#                   Its not placed in the interface directory as it would be
4423
#                   harder for create_dpkg to find it.
4424
#
4425
# Inputs          : None
4426
# Globals         : $NoBuild, $Clobber
4427
#
4428
# Returns         : Nothing
4429
#
4430
sub NoBuildMarker
4431
{
4432
    return if ( $Clobber );
4433
 
4434
    # Always delete the file - in case we toggle build forms
4435
    #
5986 dpurdie 4436
    my $markerFile = BuildAddKnownFile( $::ScmRoot, 'noBuild.gbe');
4003 dpurdie 4437
    unlink($markerFile);
4438
 
4439
    TouchFile($markerFile)
4440
        if ($NoBuild);
4441
}
4442
 
4443
#-------------------------------------------------------------------------------
227 dpurdie 4444
# Function        : BuildIncpkg
4445
#
4446
# Description     : Create a package inclusion file
4447
#
4448
# Inputs          :
4449
#
4450
# Returns         :
4451
#
4452
sub BuildIncpkg
4453
{
4454
    StartBuildPhase();                          # Starting the build phase. No more data collection
4455
    if ( $Clobber )                             # clobber mode ?
4456
    {
361 dpurdie 4457
        RmDirTree( "$Srcdir/incpkg" );
227 dpurdie 4458
        return;
4459
    }
4460
 
4461
    my $fh = ConfigurationFile::New( "$Srcdir/incpkg" );
4462
    $fh->Header( "buildlib (Version $BuildVersion)",
4463
                              "Package inclusion list" );
4464
 
4465
    foreach my $tag ( PackageEntry::GetPackageList )
4466
    {
4467
        my ($name, $version, $type) = PackageEntry::GetPackageData($tag);
4468
        $type = ($type =~ /build/i) ? "Build" : "Link";
4469
 
4470
        $fh->Write( "${type}PkgArchive( '$name', '$version' );\n" );
4471
    }
4472
 
4473
    $fh->Close();
4474
}
4475
 
4476
#-------------------------------------------------------------------------------
4477
# Function        : BuildConfig
4478
#
4479
# Description     : Create the file interface/build.cfg
4480
#                   This file contains information gathered by the build process
4481
#                   that is to be used when makefiles are created and re-created
4482
#
4483
# Inputs          : None
4484
#
4485
# Returns         : Nothing
4486
#
283 dpurdie 4487
sub BuildConfig
227 dpurdie 4488
{
4489
    Error( "No BuildInterface directive encountered\n" )
4490
        unless ($BUILDINTERFACE);
4491
 
4492
    my $fh = ConfigurationFile::New( "$BUILDINTERFACE/build.cfg");
4493
    $fh->Header( "buildlib (Version $BuildVersion)",
4494
                              "Makelib configuration file", "
4495
\$ScmBuildMachType              = \"$::GBE_MACHTYPE\";
4496
\$ScmInterfaceVersion           = \"$::InterfaceVersion\";
4497
\$ScmBuildName                  = \"$BUILDNAME\";
4498
\$ScmBuildPackage               = \"$BUILDNAME_PACKAGE\";
4499
\$ScmBuildVersion               = \"$BUILDNAME_VERSION\";
4500
\$ScmBuildProject               = \"$BUILDNAME_PROJECT\";
4501
\$ScmBuildVersionFull           = \"$BUILDVERSION\";
4502
\$ScmBuildPreviousVersion       = \"$BUILDPREVIOUSVERSION\";
4503
\$ScmLocal                      = \"$BUILDLOCAL\";
4504
\$ScmDeploymentPatch            = \"$DEPLOY_PATCH\";
4505
\$ScmSrcDir                     = \"$Srcdir\";
4506
\$ScmBuildSrc                   = \"$ScmBuildSrc\";
4507
\$ScmExpert                     = \"$Expert\";
261 dpurdie 4508
\$ScmAll                        = \"$All\";
4003 dpurdie 4509
\$ScmNoBuild                    = \"$NoBuild\";
7300 dpurdie 4510
\$ScmBuildUuid                  = \"$BUILD_UUID\";
227 dpurdie 4511
");
4512
 
4513
#.. Alias
4514
#
4515
    $fh->DumpData(
4516
        "\n# Aliases.\n#\n",
4517
        "ScmBuildAliases", \%BUILDALIAS );
4518
 
4519
#.. Products
4520
#
4521
    $fh->DumpData(
4522
        "# Product mapping.\n#\n",
4523
        "ScmBuildProducts", \%BUILDPRODUCT_PARTS );
4524
 
4525
#.. Create ScmBuildPlatforms
4526
#
4527
    my( @platforms_merged, %platform_args ) = ();
4528
 
4529
    UniquePush ( \@platforms_merged, @BUILDPLATFORMS );
4530
 
4531
    foreach my $key ( keys %BUILDPRODUCT ) {
4532
        my( @list ) = split( ' ', $BUILDALIAS{ $key } || '' );
4533
        my( $platform );
4534
 
4535
        foreach my $elem ( @list ) {
4536
            if ( $elem =~ /^--/ ) {             # argument
4537
                HashJoin( \%platform_args, $;, $platform, $elem )
4538
                    if ( defined($platform) );
4539
                next;
4540
            }
4541
            $platform = $elem;                  # platform
4542
            UniquePush( \@platforms_merged, $elem );
4543
        }
4544
    }
4545
 
4546
#.. Create ScmBuildPlatforms
4547
#   Contains per platform options extracted from alias and platform args
4548
#
4549
    my %ScmBuildPlatforms;
4550
    foreach my $key ( @platforms_merged ) {
4551
 
4552
        my( @arguments ) = ();
4553
        UniquePush( \@arguments, split( /$;/, $BUILDPLATFORMARGS{ $key } ))
4554
            if ( exists $BUILDPLATFORMARGS{ $key } );
4555
 
4556
        UniquePush( \@arguments, split( /$;/, $platform_args{ $key } ))
4557
            if ( exists $platform_args{ $key } );
4558
 
4559
        $ScmBuildPlatforms{$key} = join "$;", @arguments;
4560
    }
4561
 
4562
    $fh->DumpData(
4563
        "# Platform and global argument list.\n#\n",
4564
        "ScmBuildPlatforms", \%ScmBuildPlatforms );
4565
 
4566
 
4567
# .. Create BuildPkgRules
4568
#
367 dpurdie 4569
#    This is most of the information contained within %PKGRULES, which
227 dpurdie 4570
#    requires additional processing within makelib.
4571
#
367 dpurdie 4572
#   Need the True Path for windows.
4573
#       Some makefile functions (wildcard) only work as expected
4574
#       if the case of the pathname is correct. Really only a problem
4575
#       with badly formed legecy packages where the Windows user
4576
#       guessed at the package format.
4577
#
227 dpurdie 4578
    my %ScmBuildPkgRules;
4579
    foreach my $platform ( keys %PKGRULES )
4580
    {
4581
        foreach my $package ( @{$PKGRULES{$platform}} )
4582
        {
4583
            my %entry;
4584
 
367 dpurdie 4585
            $entry{ROOT}     = TruePath( $package->{'base'} );
227 dpurdie 4586
            $entry{NAME}     = $package->{'name'};
4587
            $entry{VERSION}  = $package->{'version'};
4588
            $entry{DNAME}    = $package->{'dname'};
4589
            $entry{DVERSION} = $package->{'dversion'};
4590
            $entry{DPROJ}    = $package->{'dproj'};
4591
            $entry{TYPE}     = $package->{'type'};
4592
            $entry{CFGDIR}   = $package->{'cfgdir'} if ( defined( $package->{'cfgdir'} ) );
4593
 
367 dpurdie 4594
            foreach my $dir (qw (TOOLDIRS) )
227 dpurdie 4595
            {
4596
                $entry{$dir} = $package->{$dir} ;
4597
            }
4598
 
367 dpurdie 4599
            my $baselen = length($package->{'base'});
4600
            foreach my $dir (qw (PINCDIRS PLIBDIRS THXDIRS) )
4601
            {
4602
                $entry{$dir} = [];
4603
                foreach my $file ( @{$package->{$dir}} )
4604
                {
4605
                    push @{$entry{$dir}}, substr TruePath($package->{'base'} . $file ), $baselen;
4606
                }
4607
            }
4608
 
227 dpurdie 4609
            push @{$ScmBuildPkgRules{$platform}}, \%entry;
4610
        }
4611
    }
4612
 
4613
    $fh->DumpData(
4614
        "# Imported packages.\n#\n",
4615
        "ScmBuildPkgRules", \%ScmBuildPkgRules );
4616
 
4617
#
4618
#   BUILDPLATFORMS,
4619
#       The value that is saved only contains the active platforms
4620
#
4621
#   DEFBUILDPLATFORMS,
4622
#       The value that is matchs the wildcard specification for Platform 
4623
#       directives.
4624
#
4625
    $fh->DumpData(
4626
        "# A list of platforms active within the view.\n#\n",
4627
        "BUILDPLATFORMS", \@BUILD_ACTIVEPLATFORMS );
4628
 
4629
    $fh->DumpData(
4630
        "# A list of default platforms within the view.\n#\n",
4631
        "DEFBUILDPLATFORMS", \@DEFBUILDPLATFORMS );
4632
 
4633
#
4634
#   BUILDTOOLS
4635
#       A list of toolset extension paths
4636
#
4637
    $fh->DumpData(
4638
        "# A list of paths with toolset extension programs.\n#\n",
4639
        "BUILDTOOLSPATH", \@BUILDTOOLS );
4640
 
4641
#
4642
#   BUILDPLATFORM_PARTS
4643
#       A subset of BUILDINFO exported as BUILDPLATFORM_PARTS
4644
#       This exists only for backward compatability with existing code
4645
#       in external packages ( deployfiles).
4646
#
4647
#   Only save those parts that are part of the current build
4648
#   This will prevent users attempting to build for platforms that have not
4649
#   been correctly constructed.
4650
#
4651
    my %active =  map { ${_} => 1 } @BUILD_ACTIVEPLATFORMS;
4652
    my %active_buildplatform_parts;
4653
    my %active_build_info;
4654
    foreach ( keys %BUILDINFO )
4655
    {
4656
        next unless ( $active{$_} );
4657
        $active_buildplatform_parts{$_} = $BUILDINFO{$_}{PARTS};
4658
        $active_build_info{$_}          = $BUILDINFO{$_};
4659
    }
4660
 
4661
    $fh->DumpData(
4662
        "# Parts of all platforms.\n#\n",
4663
        "BUILDPLATFORM_PARTS", \%active_buildplatform_parts );
4664
#
4665
#   BUILDINFO
4666
#       Complete TARGET Information
4667
#
4668
    $fh->DumpData(
4669
        "# Extended build information.\n#\n",
4670
        "BUILDINFO", \%active_build_info );
4671
 
4672
#
247 dpurdie 4673
#   BUILD_KNOWNFILES
4674
#       All paths are relative to the project root directory
4675
#       ie: The directory that conatins the build.pl file
4676
#
4677
    $fh->DumpData(
4678
        "# Generated Files that may be known when used as Src files.\n#\n",
4679
        "BUILD_KNOWNFILES", \%BUILD_KNOWNFILES );
4680
 
4681
#
227 dpurdie 4682
#   Close out the file
4683
#
4684
    $fh->Close();
363 dpurdie 4685
 
227 dpurdie 4686
}
4687
 
4688
#-------------------------------------------------------------------------------
4689
# Function        : WriteParsedBuildConfig
4690
#
4691
# Description     : Write all the parsed build.pl data to a single file
4692
#                   Its all in there for use
4693
#
4694
# Inputs          : 
4695
#
4696
# Returns         : 
4697
#
4698
sub WriteParsedBuildConfig
4699
{
4700
    my $cfg_file = "$::BUILDINTERFACE/Buildfile.cfg";
4701
    my %cf_build_info = ();
4702
 
4703
    #
4704
    #   Examine the symbol table and capture most of the entries
4705
    #
4706
    foreach my $symname (keys %main::)
4707
    {
4708
        next if ( $symname =~ m/::/  );                 # No Typeglobs
4709
        next if ( $symname =~ m/^cf_build_info/  );     # Not myself
4710
        next unless ( $symname =~ m/^[A-Za-z]/  );      # No system type names
4711
        next if ( $symname =~ m/^SIG$/  );              # Useless
4712
        next if ( $symname =~ m/^ENV$/  );              # Don't keep the user ENV
4713
        next if ( $symname =~ m/^INC$/  );              # Don't keep the INC paths
4714
        next if ( $symname =~ m/^DEFINES/  );           # Don't keep
4715
        next if ( $symname =~ m/^TOOLSETRULES/  );      # Don't keep
4716
 
331 dpurdie 4717
        no strict 'vars';
227 dpurdie 4718
        local *sym = $main::{$symname};
4719
 
331 dpurdie 4720
        $cf_build_info{"\$$symname"} =  $sym if defined $sym;
369 dpurdie 4721
        $cf_build_info{"\@$symname"} = \@sym if @sym;
4722
        $cf_build_info{"\%$symname"} = \%sym if %sym;
331 dpurdie 4723
        use strict 'vars';
227 dpurdie 4724
    }
4725
 
4726
    #
4727
    #   Dump out the configuration information
4728
    #
4729
    my $fh = ConfigurationFile::New( "$cfg_file" );
4730
    $fh->Header( "buildlib (version $::BuildVersion)",
4731
                              "Buildfile configuration" );
4732
    $fh->Dump( [\%cf_build_info], [qw(*cf_build_info)] );
4733
    $fh->Close();
4734
}
4735
 
4736
 
4737
#-------------------------------------------------------------------------------
4738
# Function        : BuildSharedLibFiles
4739
#
4740
# Description     : Create a file in the interface directory that will specify
4741
#                   the locations of shared libraries.
4742
#
4743
#                   Note: Always create a file as makefile targets depend on it.
4744
#
4745
#                   This is a bit ugly.
4746
#
4747
#                   There needs be an association between the build machine and
4748
#                   the target platform. Need to know if the current target is
4749
#                   native to the current build machine. If it is then we can
4750
#                   run tests on the machine and we then need to extend the
4751
#                   search path for the target.
4752
#
4753
#                   The BUILDINFO{EXT_SHARED} is used to control the creation of
4754
#                   the files by specifying the extension of the file.
4755
#
4756
# Inputs          : None
4757
#
4758
# Returns         :
4759
#
4760
sub BuildSharedLibFiles
4761
{
4762
    if ( $ScmHost eq "DOS" || $ScmHost eq "WIN" ) {
4763
        BuildSharedLibFiles_WIN(@_);
4764
 
4765
    } elsif ( $ScmHost eq "Unix" ) {
4766
        BuildSharedLibFiles_Unix(@_);
4767
 
4768
    } else {
4769
        Error("Cannot build. Unknown machine type: $ScmHost",
4770
              "Need WIN, DOS or Unix" );
4771
    }
4772
}
4773
 
4774
#-------------------------------------------------------------------------------
4775
# Function        : BuildSharedLibFiles_WIN
4776
#
4777
# Description     : Implementation of BuildSharedLibFiles for Windows
4778
#
4779
# Inputs          : None
4780
#
4781
sub BuildSharedLibFiles_WIN
4782
{
4783
 
4784
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
4785
    {
4786
        next unless ( exists $BUILDINFO{$platform}{EXT_SHARED} );
4787
        my @dos_paths = BuildSharedLibFiles_list( $platform, $BUILDINFO{$platform}{EXT_SHARED} );
4788
 
4789
        #
4790
        #   Create a .bat file for WIN32
4791
        #   This may be consumed by user wrapper programs
4792
        #
229 dpurdie 4793
        #   Features: No Echo
4794
        #             Use of SETLOCAL to prevent pollution of environment
4795
        #
227 dpurdie 4796
        my $fh = ::ConfigurationFile::New( "$BUILDINTERFACE/set_$platform.bat", '--NoEof', '--Type=bat' );
229 dpurdie 4797
        $fh->Write ( "\@echo off\n");
227 dpurdie 4798
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
229 dpurdie 4799
        $fh->Write ( "\nSETLOCAL\n");
227 dpurdie 4800
        foreach ( reverse @dos_paths )
4801
        {
4802
            $_ =~ s~/~\\~g;
4803
            $fh->Write ( "PATH=$_;\%PATH\%\n" );
4804
        }
4805
        $fh->Write ( "\n%*\n" );
229 dpurdie 4806
        $fh->Write ( "\nENDLOCAL\n");
231 dpurdie 4807
        $fh->Write ( "EXIT /B %ERRORLEVEL%\n");
227 dpurdie 4808
        $fh->Close();
4809
 
4810
        #
4811
        #   Create a .sh file for WIN32
4812
        #   This may be consumed by a shell - as used within JATS
4813
        #
4814
        $fh = ::ConfigurationFile::New( "$BUILDINTERFACE/set_$platform.sh", '--NoEof', '--Type=sh' );
4815
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
4816
        foreach ( reverse @dos_paths )
4817
        {
4818
            tr~\\/~/~s;
4819
            $fh->Write ( "PATH=$_\\;\$PATH\n" );
4820
        }
287 dpurdie 4821
        $fh->Write ( "\n" . '[ -n "$*" ] && "$@"'  ."\n" );
227 dpurdie 4822
        $fh->Close();
4823
    }
4824
}
4825
 
4826
#-------------------------------------------------------------------------------
4827
# Function        : BuildSharedLibFiles_Unix
4828
#
4829
# Description     : Implementation of BuildSharedLibFiles for Unix
4830
#                   Extend the Shared Library search path via LD_LIBRARY_PATH
5877 dpurdie 4831
#                   
4832
#                   Create sonames for all external shared libraries
227 dpurdie 4833
#
4834
# Inputs          : None
4835
#
4836
sub BuildSharedLibFiles_Unix
4837
{
4838
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
4839
    {
4840
        next unless ( exists $BUILDINFO{$platform}{EXT_SHARED} );
4841
        my @unix_paths = BuildSharedLibFiles_list( $platform, $BUILDINFO{$platform}{EXT_SHARED} );
4842
 
4843
        #
5877 dpurdie 4844
        #   Create sonames for all shared libraries
4845
        #   Append to the begging of the search list - so that it will rendered last
4846
        #   
4847
        my $sodir = BuildSoNameLinks_Unix($platform, @unix_paths);
4848
        unshift( @unix_paths, $sodir ) if defined $sodir;
4849
 
4850
        #
227 dpurdie 4851
        #   Create a .sh file for Unix
4852
        #
229 dpurdie 4853
        my $file = "$BUILDINTERFACE/set_$platform.sh";
4854
        my $fh = ::ConfigurationFile::New( $file , '--NoEof', '--Type=sh' );
227 dpurdie 4855
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
4856
        foreach ( reverse @unix_paths )
4857
        {
4858
            $fh->Write ( "export LD_LIBRARY_PATH=$_:\$LD_LIBRARY_PATH\n" );
4859
        }
275 dpurdie 4860
        $fh->Write ( "\n\"\$\@\"\n" );
227 dpurdie 4861
        $fh->Close();
229 dpurdie 4862
 
4863
        #
4864
        #   Make the file executable under unix
4865
        #
4866
        chmod 0755, $file;
227 dpurdie 4867
    }
4868
}
4869
 
4870
#-------------------------------------------------------------------------------
5877 dpurdie 4871
# Function        : BuildSoNameLinks_Unix 
4872
#
4873
# Description     : Generate soname links for all shared libraries from external
4874
#                   packages.
4875
#                   
4876
#                   There is a bit of a cheat. We don't examine the library to determine
4877
#                   the soname. We simple create all possible sonames to the library
4878
#
4879
# Inputs          : $platform       - Target platform
4880
#                   @paths          - Array of paths to scan for libraries 
4881
#
4882
# Returns         : soLinkDir       - Absolute path to the directory of gernerated
4883
#                                     symlinks
4884
#
4885
sub BuildSoNameLinks_Unix
4886
{
4887
    my ($platform, @paths) = @_;
4888
    my $soLinkDir = catdir($BUILDINTERFACE, 'soLinks', $platform );
4889
 
4890
    Verbose("Create Unix SoName links - $soLinkDir");
4891
    RmDirTree( $soLinkDir );
4892
 
4893
    #
4894
    #   Search provided library paths for shared libaries
4895
    #       These are names of the form *.so.* ie : libz.so.1.2.5
4896
    #
4897
    foreach my $path (@paths)
4898
    {
4899
        foreach my $file (glob(catdir($path, '*.so.*')))
4900
        {
4901
            #
4902
            #   Skip the debug symbol files
4903
            #
4904
            next if $file =~ m~\.debug$~;
4905
            next if $file =~ m~\.dbg$~;
4906
 
4907
            #
4908
            #   Generate all possible sonames by removing .nnnn from the 
4909
            #   end of the file name
4910
            #   
4911
            my $sofile = $file;
4912
            while ($sofile =~ m~(.*)\.\d+$~)
4913
            {
4914
                $sofile = $1;
4915
                unless (-f $sofile) {
4916
                    Verbose2("Need Soname: $sofile");
4917
 
4918
                    #
4919
                    #   Create link from soname to full name
4920
                    #   
4921
                    mkpath ( $soLinkDir ) unless -d $soLinkDir;
4922
                    my $sofilename = $sofile;
4923
                    $sofilename =~ s~.*/~~;
4924
                    $sofilename = catdir($soLinkDir, $sofilename);
4925
                    unless (-f $sofilename) {
4926
                        symlink ($file, $sofilename) || Error ("Cannot create symlink to $sofilename. $!"); 
4927
                    }
4928
                }
4929
            }
4930
        }
4931
    }
4932
 
4933
    #
4934
    #   Return the path the generated soLink dir
4935
    #
4936
    return AbsPath($soLinkDir) if (-d $soLinkDir);
4937
    return undef;
4938
}
4939
 
4940
#-------------------------------------------------------------------------------
227 dpurdie 4941
# Function        : BuildSharedLibFiles_list
4942
#
4943
# Description     : Determine a list of Shared Library paths that can be used
4944
#                   by the current target
4945
#
4946
# Inputs          : $platform       - Current platform
4947
#                   $so             - Shared object extensions
4948
#
4949
# Returns         : List of search paths
4950
#
4951
sub BuildSharedLibFiles_list
4952
{
4953
    my ($platform, $so ) = @_;
4954
    my @paths;
4955
    my @parts = @{$BUILDINFO{$platform}{PARTS}};
4956
 
4957
    #
4958
    #   Paths from the current build
4959
    #       Local directory         - for installed components
4960
    #       Interface directory     - for BuildPkgArchives
4961
    #
4962
    if ( $BUILDLOCAL )
4963
    {
5986 dpurdie 4964
        my @localParts;
4965
        UniquePush \@localParts, $BUILDINFO{$platform}{PLATFORM} , $BUILDINFO{$platform}{PRODUCT}, $BUILDINFO{$platform}{TARGET};
4966
        foreach ( @localParts )
227 dpurdie 4967
        {
4968
            push @paths, AbsPath("$BUILDLOCAL/lib/$_");
4969
        }
4970
    }
4971
 
4972
    foreach ( @parts )
4973
    {
4974
            push @paths, AbsPath("$BUILDINTERFACE/lib/$_");
4975
    }
4976
 
4977
    #
4978
    #   For each LinkPkgArchive
4979
    #
4980
    foreach my $package ( @{$PKGRULES{$platform}} )
4981
    {
4982
        next unless ( $package->{'type'} eq 'link' );
4983
 
4984
        my $base = $package->{'base'};
4985
        for my $path ( @{$package->{'PLIBDIRS'}} )
4986
        {
289 dpurdie 4987
            my @so_libs;
317 dpurdie 4988
            push @so_libs, glob ( "$base$path/*$_") foreach ( ArrayList($so) );
227 dpurdie 4989
            next unless scalar @so_libs;
4990
            push @paths, $base . $path;;
4991
        }
4992
    }
4993
 
4994
    #
4995
    #   Returns paths found
4996
    #
4997
    return @paths;
4998
}
4999
 
5000
#-------------------------------------------------------------------------------
247 dpurdie 5001
# Function        : BuildAddKnownFile
5002
#
5003
# Description     : Save the file as a file that will be known  to the JATS
5004
#                   makefiles. It will be available SRCS, but will not be a
5005
#                   part of any object list.
5006
#
5007
#                   Known Files will be deleted on clobber
5008
#
5009
# Inputs          : $path
5010
#                   $file
289 dpurdie 5011
#                   $noadd                    - Don't add to known
247 dpurdie 5012
#
5013
# Returns         : Path and filename
5014
#
5015
 
5016
sub BuildAddKnownFile
5017
{
289 dpurdie 5018
    my ($path, $file, $noadd) = @_;
247 dpurdie 5019
    $path .= '/'. $file;
2450 dpurdie 5020
    $path =~ tr~/~/~s;
289 dpurdie 5021
    $BUILD_KNOWNFILES {$file} = $path
5022
        unless ( defined($noadd) && $noadd);
4003 dpurdie 5023
 
6133 dpurdie 5024
    ToolsetFiles::AddFile( $path )
3967 dpurdie 5025
        unless ($Clobber);
5026
 
247 dpurdie 5027
    return $path;
5028
}
5029
 
5030
#-------------------------------------------------------------------------------
5969 dpurdie 5031
# Function        : WinPath 
5032
#
5033
# Description     : Covert path to a windows formatted path
5034
#
5035
# Inputs          : One path element
5036
#
5037
# Returns         : One ugly path element
5038
#
5039
 
5040
sub WinFullPath
5041
{
5042
    my ($path) = @_;
5043
    $path = FullPath($path);
5044
    $path =~ tr~\\/~\\~s;
5045
    return $path;
5046
}
5047
 
5048
#-------------------------------------------------------------------------------
5049
# Function        : BuildPropertyPages 
5050
#
5051
# Description     : Create a props file suitable for use by VS2010, VS2012 (possibly others)
5052
#                   Only supported for C/C++ projects
5053
#                   Provide info for:
5054
#                       Include Search paths
5055
#                       Library search paths
5056
#                       Nice Macros 
5057
#
5058
# Inputs          : 
5059
#
5060
# Returns         : 
5061
#
5062
sub BuildPropertyPages
5063
{
5064
    StartBuildPhase();                      # Starting the build phase. No more data collection
5986 dpurdie 5065
    return if $Clobber;
5969 dpurdie 5066
    foreach my $platform ( keys %BUILDINFO )
5067
    {
5068
        next unless $BUILDINFO{$platform}{MSBUILDPROPS};
5986 dpurdie 5069
        my $propsFile = BuildAddKnownFile ($Srcdir, 'jats_'. $BUILDINFO{$platform}{TARGET} . '.props');
5070
 
5969 dpurdie 5071
        Message("BuildPropertyPages: $propsFile");
5072
 
5073
        my %macros;
5074
        my @libpaths;
5075
        my @incpaths;
5076
        my @parts = @{$BUILDINFO{$platform}{PARTS}};
5077
 
5078
        #
5079
        #   Basic definitions
5080
        #   
5081
        $macros{'GBE_ROOT'}     = WinFullPath(".");
5082
        $macros{'GBE_PLATFORM'} = $BUILDINFO{$platform}{PLATFORM};
5083
        $macros{'GBE_PRODUCT'}  = $BUILDINFO{$platform}{PRODUCT};
5084
        $macros{'GBE_TARGET'}   = $BUILDINFO{$platform}{TARGET};
5085
        $macros{'GBE_MACHTYPE'} = $::GBE_MACHTYPE;
5086
        $macros{'GBE_PKGDIR'}   = WinFullPath('./pkg/' . $BUILDNAME_PACKAGE);
5087
        $macros{'GBE_BUILDNAME'}= $BUILDNAME_PACKAGE;
5088
 
5089
        #
5090
        #   Paths from the current build
5091
        #       Local directory         - for installed components
5092
        #       Interface directory     - for BuildPkgArchives
5093
        #
5094
        if ( $BUILDLOCAL )
5095
        {
5096
            my $macroName = 'GBE_LOCALDIR';
5097
            $macros{$macroName} = WinFullPath("$BUILDLOCAL") ;
5098
            $macroName = '$(' . $macroName . ')';
5986 dpurdie 5099
            my @localParts;
5100
            UniquePush \@localParts, $BUILDINFO{$platform}{PLATFORM} , $BUILDINFO{$platform}{PRODUCT}, $BUILDINFO{$platform}{TARGET};
5101
            foreach ( @localParts )
5969 dpurdie 5102
            {
5103
                push @libpaths, catdir($macroName, 'lib', $_);
5104
                push @incpaths, catdir($macroName ,'include' ,$_);
5105
            }
5106
            push @incpaths, catdir($macroName ,'include');
5107
        }
5108
 
5109
        my $macroName = 'GBE_INTERFACEDIR';
5110
        $macros{$macroName} = WinFullPath("$BUILDINTERFACE") ;
5111
        $macroName = '$(' . $macroName . ')';
5112
 
5113
        foreach ( @parts )
5114
        {
5115
                push @libpaths, catdir($macroName, 'lib' , $_);
5116
                push @incpaths, catdir($macroName ,'include' ,$_);
5117
        }
5118
        push @incpaths, catdir($macroName ,'include');
5119
 
5120
        #
5121
        #   For each LinkPkgArchive
5122
        #
5123
        foreach my $package ( @{$PKGRULES{$platform}} )
5124
        {
5125
            next unless ( $package->{'type'} eq 'link' );
5126
 
5127
            my $macroName = 'GBE_PACKAGE_'.$package->{'name'};
5128
            $macros{$macroName} = WinFullPath($package->{'base'}) ;
5129
            $macroName = '$(' . $macroName . ')';
5130
 
5131
            for my $path ( @{$package->{'PLIBDIRS'}} )
5132
            {
5133
                push @libpaths, catdir($macroName, $path);
5134
            }
5135
            for my $path ( @{$package->{'PINCDIRS'}} )
5136
            {
5137
                push @incpaths, catdir($macroName, $path);
5138
            }
5139
        }
5140
 
5141
        my $AdditionalIncludeDirectories = join(';', @incpaths );
5142
        my $AdditionalLibraryDirectories = join(';', @libpaths);
5143
        my $PreprocessorDefinitions = 'JATS=1';
5144
 
5145
        #
5146
        #   Create a props file formatted for VS2012
5147
        #
5148
        open (my $XML, '>', $propsFile) || Error ("Cannot create output file: $propsFile", $!);
5149
 
5150
        my $writer = XML::Writer->new(OUTPUT => $XML, UNSAFE => 0, DATA_INDENT => 4, DATA_MODE => 1);
5151
        $writer->xmlDecl("UTF-8");
5152
        $writer->comment('This file is generated by JATS build');
5153
        $writer->comment('Do not edit this file');
5154
        $writer->comment('Do not version control this file');
5155
        $writer->startTag('Project', "ToolsVersion", "4.0", "xmlns", "http://schemas.microsoft.com/developer/msbuild/2003");
5156
        $writer->emptyTag('ImportGroup', 'Label' , "PropertySheets");
5157
 
5158
        #
5159
        #   Special Macro for handling production/debug libraries
5160
        #
5161
        $writer->startTag('PropertyGroup', 'Label' , "UserMacros", 'Condition', "'\$(Configuration)' == 'Debug'");
5162
        $writer->dataElement('GBE_TYPE', 'D');
5163
        $writer->endTag('PropertyGroup');
5164
 
5165
        $writer->startTag('PropertyGroup', 'Label' , "UserMacros", 'Condition', "'\$(Configuration)' != 'Debug'");
5166
        $writer->dataElement('GBE_TYPE', 'P');
5167
        $writer->endTag('PropertyGroup');
5168
 
5169
        #
5170
        #   Define macros
5171
        #   
5172
        $writer->startTag('PropertyGroup', 'Label' , "UserMacros");
5173
        foreach my $key ( sort keys %macros)
5174
        {
5175
            $writer->dataElement($key, $macros{$key});
5176
        }
5177
        $writer->endTag('PropertyGroup');
5178
        $macros{'GBE_TYPE'}     = 1;
5179
 
5180
        #
5181
        #   Extend the search paths for includes and libaraies
5182
        #   
5183
        #$writer->emptyTag('ItemDefinitionGroup');
5184
        $writer->startTag('ItemDefinitionGroup');
5185
 
5186
        $writer->startTag('ClCompile');
5187
        $writer->dataElement('AdditionalIncludeDirectories', $AdditionalIncludeDirectories . ';%(AdditionalIncludeDirectories)');
5188
        $writer->dataElement('PreprocessorDefinitions', $PreprocessorDefinitions . ';%(PreprocessorDefinitions)');
5189
        $writer->endTag('ClCompile');
5190
 
5191
        $writer->startTag('Link');
5192
        $writer->dataElement('AdditionalLibraryDirectories', $AdditionalLibraryDirectories . ';%(AdditionalLibraryDirectories)');
5193
        $writer->endTag('Link');
5194
        $writer->endTag('ItemDefinitionGroup');
5195
 
5196
        #
5197
        #   Specify all macro names
5198
        #
5199
        $writer->startTag('ItemGroup');
5200
        foreach my $key ( sort keys %macros)
5201
        {
5202
            $writer->startTag('BuildMacro', 'Include' , $key);
5203
            $writer->dataElement('Value', '$(' . $key . ')');
5204
            $writer->endTag('BuildMacro');
5205
        }
5206
 
5207
        #
5208
        #   Close tags and write the XML file
5209
        #
5210
        $writer->endTag('ItemGroup');
5211
        $writer->endTag('Project');
5212
        $writer->end();
5213
    }
5214
}
5215
 
5216
 
5217
#-------------------------------------------------------------------------------
227 dpurdie 5218
# Function        : Usage
5219
#
5220
# Description     : Display program usage information
5221
#
5222
# Inputs          : args            - Text message to display
5223
#
5224
#                   $opt_help       - Level of verbose ness
5225
#
5226
# Returns         : Does not return
5227
#                   This function will exit
5228
#
5229
sub Usage
5230
{
5231
    my( $msg ) = @_;
5232
    my %usage_args;
5233
 
5234
    #
5235
    #   Create a hash of arguments for the pod2usage function
5236
    #
5237
    $usage_args{'-input'} = __FILE__;
5238
    $usage_args{'-exitval'} = 42;
5239
    $usage_args{'-message'} = "\nbuildlib $msg\n" if $msg;
5240
    $usage_args{'-verbose'} = $opt_help < 3 ? $opt_help - 1 : 3 if ( $opt_help );
5241
 
5242
    #
5243
    #   Generate nice help
5244
    #
5245
    pod2usage(\%usage_args);
5246
}
5247
 
5248
#-------------------------------------------------------------------------------
5249
#   Documentation
5250
#
5251
 
5252
=pod
5253
 
361 dpurdie 5254
=for htmltoc    JATS::build
5255
 
227 dpurdie 5256
=head1 NAME
5257
 
361 dpurdie 5258
build - Build Environment and Makefiles
227 dpurdie 5259
 
5260
=head1 SYNOPSIS
5261
 
5262
jats build [options] [command]
5263
 
5264
     [perl buildlib.pl [options] PWD [command]]
5265
 
5266
 Options:
331 dpurdie 5267
    -help          - Display terse usage
361 dpurdie 5268
    -help -help    - Display verbose usage
331 dpurdie 5269
    -man           - Display internal manual
5270
    -verbose[=n]   - Set level of progress verbosity
5271
    -debug[=n]     - Set the debug level
5272
    -cache         - Cache packages in the local dpkg_package cache
361 dpurdie 5273
    -cache -cache  - Forced refresh dependent packages in the local cache
331 dpurdie 5274
    -package       - Ignore packages that are not available and continue
2078 dpurdie 5275
    -nopackages    - Ignore package processing directives
331 dpurdie 5276
    -forcebuildpkg - Treat LinkPkgArchive directives as BuildPkgArchive
361 dpurdie 5277
                     Also suppress the use of symlinks so that the physical
5278
                     file will be copied locally.
331 dpurdie 5279
    -[no]force     - Force build even if build.pl is not newer
363 dpurdie 5280
                     Default: -force
4778 dpurdie 5281
    -[no]generic   - Build system sanity test
5282
                     Default: Do not test
227 dpurdie 5283
 
5284
 Sticky settings:
331 dpurdie 5285
    -all           - Build for all platforms ignoring GBE_BUILDFILTER
5286
    -expert[=n]    - Relaxing dependency checks on the user makefiles
227 dpurdie 5287
 
5288
 Commands:
2078 dpurdie 5289
    clobber        - Remove generated build system (eg Makefiles).
6133 dpurdie 5290
    interface      - Only (re)build the interface tree.
361 dpurdie 5291
    rootonly       - Only (re)build the root directory.
227 dpurdie 5292
 
5293
=head1 OPTIONS
5294
 
5295
=over 8
5296
 
331 dpurdie 5297
=item B<-help>
227 dpurdie 5298
 
5299
Print a brief help message and exits.
5300
 
5301
=item B<-help -help>
5302
 
5303
Print a detailed help message with an explanation for each option.
5304
 
5305
=item B<-man>
5306
 
5307
Prints the manual page and exits.
5308
 
331 dpurdie 5309
=item B<-verbose[=n]>
227 dpurdie 5310
 
261 dpurdie 5311
Increases program output.
227 dpurdie 5312
 
261 dpurdie 5313
If an argument is provided, then it will be used to set the level, otherwise the
5314
existing level will be incremented. This option may be specified multiple times.
227 dpurdie 5315
 
261 dpurdie 5316
=item B<-debug>
5317
 
227 dpurdie 5318
Increases program output. Enable internal debugging messages to generate detailed
5319
progress information.
5320
 
261 dpurdie 5321
If an argument is provided, then it will be used to set the level, otherwise the
5322
existing level will be incremented. This option may be specified multiple times.
5323
 
331 dpurdie 5324
=item B<-cache>
227 dpurdie 5325
 
5326
This option will cause dependent packages to be cached in the local
5327
dpkg_archive cache.
5328
 
5329
If the option is used twice then the packages will be forcibly refreshed.
5330
 
331 dpurdie 5331
=item B<-package>
227 dpurdie 5332
 
5333
This option will cause the build process to ignore packages that cannot be
5334
located. The package build may fail at a later stage.
5335
 
5336
This option is used by the Auto Build Tool to handle packages that may not be
5337
needed in all builds.
5338
 
2078 dpurdie 5339
=item B<-nopackage>
5340
 
5341
This options will cause all the directives that process external packages to be
5342
ignored.
5343
 
5344
This directive has limited use. It can be used in conjunction with the
5345
'interface' build command in order to create Version Information files in a
5346
sandbox where the required packages do not yet exist.
5347
 
331 dpurdie 5348
=item B<-forcebuildpkg>
227 dpurdie 5349
 
5350
This option will force LinkPkgArchive directives to be treated as
5351
BuildPkgArchive directives. The result is that the 'interface' directory will be
5352
populated with the contents of all dependent packages. Moreover, on a Unix
5353
machine, the files will be copied and not referenced with a soft link.
5354
 
5355
This may be useful for:
5356
 
5357
=over 8
5358
 
361 dpurdie 5359
=item *
227 dpurdie 5360
 
361 dpurdie 5361
Remote Development
227 dpurdie 5362
 
361 dpurdie 5363
=item *
227 dpurdie 5364
 
361 dpurdie 5365
Collecting header files for scanning
5366
 
5367
=item *
5368
 
5369
Local modification of files for test/debug/development
5370
 
227 dpurdie 5371
=back
5372
 
331 dpurdie 5373
=item B<-[no]force>
227 dpurdie 5374
 
331 dpurdie 5375
The '-noforce' option will only perform a build, if the build.pl file
363 dpurdie 5376
has been modified, or the buildfilter has changed, since the last build.
331 dpurdie 5377
 
363 dpurdie 5378
The default operation will always force a build.
331 dpurdie 5379
 
4778 dpurdie 5380
=item B<-[no]generic>
5381
 
5382
If used, this option will perform a sanity test on the build type. If set to 
5383
Generic then the build must be a GENERIC build. If set to noGeneric then the build
5384
must not be a GENERIC build.
5385
 
5386
The default is to not perform the test.
5387
 
5388
This option is intended to be used by the automated build system.
5389
 
331 dpurdie 5390
=item B<-all>
5391
 
227 dpurdie 5392
This option will cause the build process to generate makefiles for all
5393
possible build targets ignoring the use of GBE_BUILDFILTER.
5394
 
5395
This option is sticky. Once used in a build it will be retained when makefiles
5396
are rebuilt.
5397
 
331 dpurdie 5398
=item B<-expert[=n]>
227 dpurdie 5399
 
5400
This option causes the generation of makefiles with relaxed dependancy checks.
5401
 
261 dpurdie 5402
If an argument is provided, then it will be used to set the level, otherwise a
5403
level of '1' will be set.
5404
 
227 dpurdie 5405
The makefiles will have no dependancy between the makefiles and the JATS build
5406
files or the users makefile. If the user's makefile.pl is changed then JATS
5407
will not detect the change and will not rebuild the makefiles. The user manually
5408
force the rebuild with the command 'jats rebuild'.
5409
 
5410
This option should be used with care and with full knowledge of its impact.
5411
 
5412
This option is sticky. Once used in a build it will be retained when makefiles
363 dpurdie 5413
are rebuilt. It will only be lost when the next 'jats build' is performed.
227 dpurdie 5414
 
261 dpurdie 5415
The effect of the option can be changed when the makefiles are processed. This
5416
option simply sets the default' mode of operation.
5417
 
227 dpurdie 5418
=item B<interface>
5419
 
6133 dpurdie 5420
This command will only build, or rebuild, the 'interface' directory.
227 dpurdie 5421
 
261 dpurdie 5422
This command will not build, or rebuild, the root directory. The build
227 dpurdie 5423
process will not recurse through the subdirectories creating makefiles.
5424
 
261 dpurdie 5425
=item B<rootonly>
5426
 
6133 dpurdie 5427
This command will only build, or rebuild, the 'interface' directory and 
5428
the root-level makefiles.
261 dpurdie 5429
 
5430
The build process will not recurse through the subdirectories creating
5431
makefiles. These can be made on-demand by jats if a 'make' command is issued.
5432
 
227 dpurdie 5433
=item B<clobber>
5434
 
5435
This command will remove generated build system files and directories.
5436
 
5437
=back
5438
 
5439
=head1 DESCRIPTION
5440
 
5441
The default build process will parse the user's build.pl file and create the
5442
'interface' directory before creating makefiles for each target platform.
5443
 
5444
The 'build' process simply generates the build sandbox. It does not invoke the
5445
generated makefiles. This must be done by the user in a different phase.
5446
 
5447
The 'build' process need only be invoked if the build.pl file has changed. The
5448
generated makefiles will detected changes to the makefile.pl's and cause them to
5449
be generated as required. The 'build' step sets up the sandboxes external
5450
environment.
5451
 
5452
=head1 INVOCATION
5453
 
5454
This perl library (buildlib.pl) is not designed to be invoked directly by the
5455
user. It should be invoked through a 'build.pl' file. Moreover, for historical
5456
reasons, the build.pl is not easily invoked. It is best to only invoke the
5457
'build' process via the JATS wrapper scripts : jats.bat or jats.sh.
5458
 
331 dpurdie 5459
The build.pl file must be invoked with one fixed arguments, followed by user
227 dpurdie 5460
options and subcommands
5461
 
5462
=over 8
5463
 
361 dpurdie 5464
=item   1
227 dpurdie 5465
 
361 dpurdie 5466
The current working directory
5467
 
227 dpurdie 5468
This could have been derived directly by the program, rather than having it
5469
passed in.
5470
 
361 dpurdie 5471
=item   2
227 dpurdie 5472
 
361 dpurdie 5473
Options and commands may follow the first two mandatory arguments.
5474
 
227 dpurdie 5475
=back
5476
 
5477
The build.pl file must 'require' the buildlib.pl and makelib.pl. The preferred
5478
code is:
5479
 
5480
=over 8
5481
 
5482
    build.pl: First statements
5483
    $MAKELIB_PL     = "$ENV{ GBE_TOOLS }/makelib.pl";
5484
    $BUILDLIB_PL    = "$ENV{ GBE_TOOLS }/buildlib.pl";
5485
 
5486
    require         "$BUILDLIB_PL";
5487
    require         "$MAKELIB_PL";
5488
 
5489
=back
5490
 
5491
=cut
5492
 
5493
1;