Subversion Repositories DevTools

Rev

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