Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
363 dpurdie 1
########################################################################
2
# Copyright (C) 1998-2011 Vix Technology, 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;
26
use Pod::Usage;
261 dpurdie 27
use Getopt::Long;
305 dpurdie 28
use File::Path;
227 dpurdie 29
 
30
our $BuildVersion           = "2.1.0";
31
 
32
#.. Switchs
33
#
34
our $ScmBuildlib            = 0;
35
our $ScmBuildSrc            = "";
36
 
37
our $CmdSwitch              = "";
38
our $Clobber                = 0;
39
our $Archive                = 0;
40
our $Interface              = 0;
41
our $RootOnly               = 0;
42
our $Perms                  = 0;
43
our $Expert                 = 0;
44
our $All                    = 0;
45
our $Nolog                  = 0;
5109 dpurdie 46
our $Cache                  = $ENV{GBE_DPKG_CACHE_CTL} || 0;
261 dpurdie 47
our $NoPackageError         = 0;
227 dpurdie 48
our $ForceBuildPkg          = 0;
49
our $Srcdir                 = "";               # default source root
331 dpurdie 50
our $ForceBuild             = 1;
2078 dpurdie 51
our $IgnorePkgs             = 0;
4778 dpurdie 52
our $GenericBuild           = undef;            # Build System Generic Build Test
227 dpurdie 53
 
54
#.. Public symbols, referenced by many build.pl implementations
55
#
56
our $BUILDPREVIOUSVERSION   = "0.0.0";          # BuildPreviousVersion()
57
our @BUILDPLATFORMS         = ();               # BuildPlatforms()
58
our %BUILDINFO              = ();               # BuildInfo
59
our @DEFBUILDPLATFORMS      = ();
60
our %BUILDPLATFORMARGS      = ();
61
our @BUILD_ACTIVEPLATFORMS  = ();
62
our @BUILDSUBDIRS           = ();               # BuildSubDir()
63
our @BUILDSETENV            = ();               # BuildSetenv()
64
our $BUILDINTERFACE         = "";               # BuildInterface()
65
our $BUILDLOCAL             = "";               # BuildInterface()
66
our $BUILDDIRTREE           = "";               # BuildDirTree()
241 dpurdie 67
our @BUILD_BADNAME          = ();               # Unknown platforms
4551 dpurdie 68
our @GENERIC_TARGETS        = ();               # Generic targets - only one allowed    
227 dpurdie 69
 
70
our $BUILDNAME              = "";               # BuildName()
71
our $BUILDVERSION           = "";               # BuildName()
72
our $BUILDNAME_PACKAGE;                         # Name
73
our $BUILDNAME_VERSION;                         # Version
74
our $BUILDNAME_PROJECT;                         # Project(optional)
359 dpurdie 75
our $BUILDNAME_SUFFIX;                          # Project (available)
227 dpurdie 76
our $DEPLOY_PATCH           = 0;                # Deplyment patch number
77
 
78
our %BUILDALIAS_DELAY       = ();               # Delayed aliases
79
our %BUILDALIAS_TARGETS     = ();               # BuildAlias from --Targets
80
our %BUILDALIAS             = ();               # BuildAlias
81
our %BUILDPRODUCT           = ();               # BuildProduct
82
our %BUILDPRODUCT_PARTS     = ();               # BuildProduct parts
83
our %PKGRULES               = ();               # Package include and link rules
84
our @BUILDTOOLS             = ();               # Extended tool path
85
our $BUILDPHASE             = 0;                # In Build Phase
86
our @CLOBBERDIRS            = ();               # Directories to clobber
375 dpurdie 87
our @REMOVEDIRS             = ();               # Directories to remove - if empty
247 dpurdie 88
our %BUILD_KNOWNFILES       = ();               # Files that will be known
227 dpurdie 89
 
333 dpurdie 90
our $Makelib                = "";
263 dpurdie 91
our $GBE_CORE;                                  # Root of JATS
92
our $InterfaceVersion;                          # Interface directory format version
3967 dpurdie 93
our $ScmRoot;                                   # Package Root
263 dpurdie 94
our $ScmInterface;                              # Interface directory
363 dpurdie 95
our $ScmBuildFilter;                            # Build Filter when build was created
4003 dpurdie 96
our $NoBuild                = 0;                # Dummy Build under ABT only
227 dpurdie 97
 
263 dpurdie 98
 
227 dpurdie 99
my  $DeleteDPACKAGE         = 0;                # Must clobber DPACKAGE
305 dpurdie 100
my  $build_source_pkg       = 0;                # Flag to build source package
227 dpurdie 101
my  $opt_help               = 0;
359 dpurdie 102
my  $sandbox_exact          = 0;                # Exact or in-exact sandbox
227 dpurdie 103
 
104
BuildLibInit();
105
 
106
sub BuildLibInit
107
{
108
 
109
#.. Set environment
110
#
331 dpurdie 111
    EnvImport( 'GBE_VERSION' );
112
    EnvImport( 'GBE_BIN' );
113
    EnvImport( 'GBE_CORE' );
114
    EnvImport( 'GBE_PERL' );
115
    EnvImport( 'GBE_TOOLS' );
116
    EnvImport( 'GBE_CONFIG' );
117
    EnvImport( 'GBE_DPKG' );
118
    EnvImport( 'GBE_MACHTYPE' );
119
    EnvImport( 'USER' );
120
    EnvImport( 'GBE_HOSTNAME');
121
    EnvImport( 'GBE_DRV' )
122
        if ( $ScmHost ne 'Unix' );            # DOS or WIN special
227 dpurdie 123
 
4688 dpurdie 124
    EnvImportOptional ( 'GBE_DPKG_REPLICA','' );
227 dpurdie 125
    EnvImportOptional ( 'GBE_DPKG_STORE','' );
126
    EnvImportOptional ( 'GBE_DPKG_CACHE','' );
127
    EnvImportOptional ( 'GBE_DPKG_LOCAL','' );
128
    EnvImportOptional ( 'GBE_DPKG_SBOX' ,'' );
313 dpurdie 129
    EnvImportOptional ( 'GBE_DPLY'      ,'' );
341 dpurdie 130
    EnvImportOptional ( 'GBE_SANDBOX'   ,'' );
227 dpurdie 131
 
132
    EnvImportOptional ( 'GBE_PLATFORM' );           # optional PLATFORM filter
133
    EnvImportOptional ( 'GBE_BUILDFILTER' );        # optional BUILD filter       
134
    EnvImportOptional ( 'GBE_ABT' );                # optional ABT flags          
135
 
136
#.. Common stuff
137
#
138
    require "$::GBE_TOOLS/common.pl";
331 dpurdie 139
    CommonInit( 'buildlib' );
227 dpurdie 140
    Debug( "Version:   $BuildVersion" );
279 dpurdie 141
    Require( "$::GBE_CONFIG/PLATFORM", "PLATFORM_CFG.PM"  );
227 dpurdie 142
 
143
#.. Parse command line
144
#
145
    $ScmBuildSrc = $0;                          # Name of the build file
331 dpurdie 146
    $Cwd = shift @ARGV;
227 dpurdie 147
    $Cwd =~ tr~\\/~/~s;;                        # Need / in path, Remove doubles
3967 dpurdie 148
    $::ScmRoot = StripDrive($Cwd);
333 dpurdie 149
    $Makelib = shift @ARGV;                     # Only for legacy build.pl files
227 dpurdie 150
 
261 dpurdie 151
    Verbose ("Command Line: @ARGV");
313 dpurdie 152
    my $result = GetOptions( "help|h:+"      => \$opt_help,
153
                             "man:3"         => \$opt_help,
154
                             "debug:+"       => \$::ScmDebug,
155
                             "verbose:+"     => \$::ScmVerbose,
156
                             "expert:1"      => \$Expert,
157
                             "all"           => \$All,
158
                             "nolog"         => \$Nolog,
331 dpurdie 159
                             "cache:+"       => \$Cache,
313 dpurdie 160
                             "package"       => \$NoPackageError,
2078 dpurdie 161
                             "nopackages"    => \$IgnorePkgs,
313 dpurdie 162
                             "forcebuildpkg" => \$ForceBuildPkg,
331 dpurdie 163
                             "force!"        => \$ForceBuild,
4778 dpurdie 164
                             "generic!"      => \$GenericBuild,
313 dpurdie 165
                             );
261 dpurdie 166
    Usage() if ( $opt_help || !$result );
227 dpurdie 167
 
331 dpurdie 168
    Debug( "Host:          ", $ScmHost );
169
    Debug( "Cwd:           ", $Cwd );
333 dpurdie 170
    Debug( "Makelib:       ", $Makelib );
331 dpurdie 171
    Debug( "BuildFile:     ", $ScmBuildSrc );
172
    Debug( "Debug:         ", $::ScmDebug );
173
    Debug( "Verbose:       ", $::ScmVerbose );
174
    Debug( "Expert:        ", $Expert );
175
    Debug( "All:           ", $All );
176
    Debug( "Nolog:         ", $Nolog );
177
    Debug( "Cache:         ", $Cache );
178
    Debug( "package:       ", $NoPackageError );
179
    Debug( "ForcePkg  :    ", $ForceBuildPkg );
180
    Debug( "ForceBuild :   ", $ForceBuild );
4778 dpurdie 181
    Debug( "IgnorePkgs :   ", $IgnorePkgs );
182
    Debug( "GenericTest :  ", $GenericBuild );
227 dpurdie 183
 
184
#.. Command
185
#
3967 dpurdie 186
 
187
    $CmdSwitch = (lc shift @ARGV) if @ARGV;
331 dpurdie 188
    Debug( "CmdSwitch:     ", $CmdSwitch );
227 dpurdie 189
 
331 dpurdie 190
    if ( $CmdSwitch )
191
    {
192
        if ( $CmdSwitch eq "interface" ) {
193
            $Interface      = 1;
227 dpurdie 194
 
331 dpurdie 195
        } elsif ( $CmdSwitch eq "rootonly" ) {
196
            $RootOnly       = 1;
227 dpurdie 197
 
331 dpurdie 198
        } elsif ( $CmdSwitch eq "clobber" ) {
199
            $Clobber        = 1;
227 dpurdie 200
 
331 dpurdie 201
        } elsif ( $CmdSwitch eq "help" || $CmdSwitch eq "usage" ) {
202
            $opt_help = 1;
203
            Usage();
227 dpurdie 204
 
331 dpurdie 205
        } elsif ( $CmdSwitch eq "changelog" ) {
206
            if ( -d "CVS" )                         # CVS support subdir
207
            {
208
                System( "$::GBE_PERL $::GBE_TOOLS/cvs2cl.pl --tags --branches --revisions --day-of-week" )
209
            }
210
            exit(1);
227 dpurdie 211
 
331 dpurdie 212
        } else {
213
            Usage( "(E) build. Unknown command \"$CmdSwitch\"" );
214
        }
215
    }
227 dpurdie 216
 
331 dpurdie 217
    #
341 dpurdie 218
    #   If we are not performing a ForceBuild, then we don't need to continue
219
    #   We have updated the interface directory with BuildPkgArchive
220
    #   information.
331 dpurdie 221
    #
341 dpurdie 222
    unless ( $::GBE_SANDBOX )
331 dpurdie 223
    {
341 dpurdie 224
        TestForForcedBuild();
227 dpurdie 225
    }
226
 
227
    #
228
    #   Must inform makelib that its running under buildlib
229
    #
230
    $ScmBuildlib = 1;
231
 
232
    #
233
    #   In clobber mode System commands will not force termination
234
    #   otherwise, within build.pl, a failed system command will die.
235
    #
236
    SystemConfig ('UseShell' => 1,
283 dpurdie 237
                  'ExitOnError' => ($Clobber == 0) );
5109 dpurdie 238
 
239
    #
240
    #   Capture messages while processing directives
241
    # 
242
    StartCapture(1) 
243
        unless ($Clobber);
227 dpurdie 244
}
245
 
246
 
247
#-------------------------------------------------------------------------------
248
# Function        : Log
249
#
250
# Description     : Internal function to generate a log file of the build process
341 dpurdie 251
#                   The function will print its arguments to the screen and a log file
227 dpurdie 252
#
253
# Inputs          : Arguments will be printed
254
#
255
# Returns         : Nothing
256
#
257
sub Log
258
{
259
    if ( ! $Clobber )
260
    {
261 dpurdie 261
        print "@_\n";
262
        FileAppend ('build.log', \@_ );
227 dpurdie 263
    }
264
}
265
 
266
#-------------------------------------------------------------------------------
267
# Function        : BuildSubDir
268
#
269
# Description     : Specify one or more directories in which makefile.pl's can be
270
#                   found to be processed.
271
#
272
#                   This function will flag the build 'src' dir.
273
#                   This will be the first directory specified UNLESS there
274
#                   is a 'src' directory in the list
275
#
276
#                   The function may be called multiple times.
277
#
278
# Inputs          : NewDirs             - An array of directories
279
#
280
# Returns         : Nothing
281
#
282
 
283
sub BuildSubDir
284
{
285
    my( @NewDirs );
286
 
287
    @NewDirs = map { split /\s+/ } @_;
288
    @NewDirs = grep { defined $_ } @NewDirs;
289
 
290
    Debug( "BuildSubDir(@NewDirs)" );
291
 
292
    foreach my $ThisDir ( @NewDirs )
293
    {
294
        unless ( $Clobber )
295
        {
2450 dpurdie 296
            $ThisDir =~ s~/+$~~;
227 dpurdie 297
            if ( $ThisDir eq "." )
298
            {
299
                Error( "BuildSubDir() cannot specify the current directory (.)",
300
                       "The makefile.pl in the root directory is included in all makefile.pl's" );
301
            }
302
 
303
            if ( $ThisDir =~ m~\\~)
304
            {
305
                Warning ("BuildSubDir contains a '\\' character: $ThisDir" );
306
            }
307
            if ( grep /^$ThisDir$/, @BUILDSUBDIRS )
308
            {
309
                Warning( "BuildSubDir() duplicate subdirectory ignored '$ThisDir'." );
310
                next;
311
            }
312
            if ( ! ( -e $ThisDir and -d $ThisDir ) )
313
            {
314
                Error( "BuildSubDir() non-existent subdirectory: '$ThisDir'." );
315
            }
316
            if ( ! -f $ThisDir . '/makefile.pl' )
317
            {
318
                Error( "BuildSubDir() makefile.pl not found in subdirectory: '$ThisDir'." );
319
            }
320
 
321
            push( @BUILDSUBDIRS, $ThisDir );
322
        }
323
 
324
        #
325
        #   Capture the first source directory mentioned
326
        #   This will be used as the root of the build
327
        #
328
        #   If there is a Src directory then use this
329
        #
330
        $Srcdir = $ThisDir
331
            if ( $ThisDir =~ m/^src$/i );
332
        $Srcdir = $ThisDir
333
            unless ( $Srcdir );
334
    }
335
}
336
 
337
#-------------------------------------------------------------------------------
338
# Function        : BuildAlias
339
#
340
# Description     : Create an alias for multiple targets
341
#                   The default operations will:
342
#                       Add the alias as a default platform (* in the makefile.pl)
343
#                       Perform an implicit BuildPlatform for the alias targets
344
#
345
#                   In hindsight this was not good. Options modify the behaviour
346
#                   Options:
347
#                       --NotDefault    The alias will not be a part of the default
348
#                                       platform for the makefile.pls
349
#                       --Define        Simply define text substitution
350
#                                       Do not implicitly create platforms
351
#                       --Target        Accumulate platforms with specified targets
352
#                                       Complete alias determination is delayed
353
#                                       The named targets are specified as an alias
354
#                                       until the calculation is done
355
#
356
# Inputs          : alias[,--options]   comma seperated options
357
#                   arguments           alias arguments; platforms or targets
358
#
359
# Returns         : Nothing
360
#
361
sub BuildAlias
362
{
363
    my( $alias, @arguments ) = @_;
364
    my $notdefault;
365
    my $define;
366
    my $target_mode;
367
 
368
    Debug( "BuildAlias($alias, @arguments)" );
369
    Error ("BuildAlias: No platforms specified") unless ( @arguments );
370
    Error( "BuildAlias() must appear before BuildName()..." ) if ( $BUILDNAME );
371
 
372
    #   Parse attributes
373
    #
374
    my ( @attrs ) = split( ',', $alias );
375
 
376
    $alias = "";
377
    foreach ( @attrs ) {
378
        if ( /^--/ ) {
379
            if ( /^--NotDefault$/ ) {
380
                $notdefault = 1;
381
 
382
            } elsif ( /^--Define$/ ) {
383
                $define = 1;
384
 
385
            } elsif ( /^--Target$/ ) {
386
                $target_mode = 1;
387
 
388
            } else {
389
                Warning( "BuildAlias() unknown attribute: $_ -- ignored" );
390
            }
391
 
392
        } else {
5262 dpurdie 393
            Error( "BuildAlias() multiple alias specifications", "First: $alias and now $_" )
227 dpurdie 394
                if ( $alias ne "" );
395
            $alias = $_;
396
        }
397
    }
398
    Error( "BuildAlias() missing alias specifications" )
399
        if ( $alias eq "" );
400
 
401
 
402
    #
403
    #   If we need to recalculate the alias based on targets, then tag the alias
404
    #   to be processed
405
    #
406
    $BUILDALIAS_TARGETS{ $alias } = ''
407
        if ( $target_mode );
408
 
409
    #   Define alias
410
    #
4551 dpurdie 411
    if ( PlatformConfig::checkBuildAvailability($alias) == 2 )
227 dpurdie 412
    {
4551 dpurdie 413
        Error( "BuildAlias() cannot create an alias named $alias", "That name is reserved for generic targets" );
227 dpurdie 414
    }
415
    elsif ( $alias ne quotemeta( $alias ) )
416
    {
417
        Warning( "BuildAlias() alias '$alias' contains invalid characters -- ignored" );
418
    }
419
    elsif ( $BUILDALIAS{ $alias } )
420
    {
421
        Warning( "BuildAlias() duplicate alias '$alias' -- alias ignored" );
422
    }
423
    else
424
    {
425
        #
426
        #   Expand alias UNLESS using --Target.
427
        #   The --Target is a real target and not a subject to alias expansion
428
        #   This solves order dependancy problems.
429
        #
430
        @arguments = ExpandPlatforms( @arguments )
431
            unless $target_mode;
432
 
433
        my $platform = "";                   # current platform
434
        my @pargs = ();                      # current args
435
 
436
        #
437
        #   Process the expanded arguments
438
        #   Collect arguments and process when a new platform is discovered
439
        #
440
        foreach my $arg ( @arguments, '++' )
441
        {
442
            if ( $arg =~ /^--/ )
443
            {
444
                push @pargs, $arg;
445
                next;
446
            }
447
            else
448
            {
449
                #
450
                #   Start of a platform
451
                #   Process previous data, once a platform has been seen
452
                #
453
                if ( $platform )
454
                {
455
                    #   Add arguments to BUILDALIAS as we see them
456
                    #
457
                    HashJoin( \%BUILDALIAS, ' ', $alias, $platform );
458
                    HashJoin( \%BUILDALIAS, ' ', $alias, grep(!/^--Uses=/, @pargs) );
459
 
460
                    #
461
                    #   The BuildAlias can also define a platform.
462
                    #   (Sounded like a good idea at the time!)
463
                    #
464
                    unless ( $define || $target_mode )
465
                    {
466
                        push @pargs, '--NotDefault' if ( $notdefault );
467
                        push @pargs, '--FunctionName=BuildAlias';
468
                        BuildPlatforms( $platform, @pargs );
469
                    }
470
                }
471
 
472
                #
473
                #   Start collecting args for the next platform
474
                #
475
                @pargs = ();
476
                $platform = $arg;
477
            }
478
        }
479
    }
480
}
481
 
482
 
483
#-------------------------------------------------------------------------------
484
# Function        : Process_TargetAlias
485
#
486
# Description     : Post Process the --Target option for the build alias
487
#                   Filter all platforms and extract those with a matching targets
488
#
489
# Inputs          : None
490
#
491
# Returns         : Nothing
492
#
493
sub Process_TargetAlias
494
{
495
 
496
    #
497
    #   Merge any delayed aliases with the complete set of alias
498
    #   Delayed alias are not used in expansions during the processing
5410 dpurdie 499
    #   of platforms and targets, but can be used to pick up errors
227 dpurdie 500
    #
501
    while ( my($key,$value) = each(%BUILDALIAS_DELAY) )
502
    {
503
        if ( exists($BUILDALIAS{$key}) )
504
        {
5410 dpurdie 505
            abtWarning("BuildAlias() duplicates internal alias '$key'");
227 dpurdie 506
            next;
507
        }
508
        $BUILDALIAS{$key} = $value;
509
    }
5410 dpurdie 510
    ErrorDoExit();
227 dpurdie 511
 
512
    foreach my $alias ( keys %BUILDALIAS_TARGETS )
513
    {
514
        Debug( "BuildTargetAlias($alias)" );
515
 
516
        #
517
        #   Replace the existing alias - it has done its JOB
518
        #
519
        my $arguments = delete $BUILDALIAS{ $alias } ;
520
 
521
        foreach my $arg ( split / /, $arguments )
522
        {
523
            if ( $arg =~ /^--/ )                # argument
524
            {
525
                #   Add arguments to BUILDALIAS as we see them
526
                #
527
                HashJoin( \%BUILDALIAS, ' ', $alias, $arg );
528
                next;
529
            }
530
 
531
            foreach my $platform ( keys %BUILDINFO )
532
            {
533
                foreach my $element ( qw (TARGET BASE ) )
534
                {
535
                    my $target = $BUILDINFO{$platform}{$element};
536
                    if ( $target && $target eq $arg )
537
                    {
538
                        HashUniqueJoin( \%BUILDALIAS, ' ', $alias, $platform );
539
                        Debug( "BuildTargetAlias: $alias, $target -> $platform" );
540
                    }
541
                }
542
            }
543
        }
544
    }
545
}
546
 
547
#-------------------------------------------------------------------------------
548
# Function        : BuildProduct
549
#
550
# Description     : Create a family of Platforms with a common product line
551
#                   ie: Create two flavors of the TP5, one based on the MOSF and
552
#                   the othe based on the MOS68 toolset.
553
#
554
# Inputs          : $product[,opts]+    The name of the product
555
#                                       This will be the base name for the family
556
#                                       Allowed options are:
557
#                                           --NotDefault    : This is not a default build platform
558
#                                           --Uses=xxx      : All use another platform
5115 dpurdie 559
#                                           --Alias=yyy     : All alias to this name
227 dpurdie 560
#
561
#                   platforms           One or more root platforms, with options
562
#                                       The platform is macro expanded.
563
#                                       Options may be a part of the platform or
564
#                                       distinct.
565
#
566
# Returns         :
567
#
568
 
569
sub BuildProduct
570
{
571
    my( $product, @arguments ) = @_;
572
    my $notdefault = 0;
573
    my @uses = ();
5115 dpurdie 574
    my @alias = ();
227 dpurdie 575
 
576
    Debug( "BuildProduct($product, @arguments)" );
577
    Error( "BuildProduct must appear before BuildName()..." )
578
        if ( $BUILDNAME ne "" );
579
 
580
    #   Parse attributes
581
    #
582
    my( @attrs ) = split( ',', $product );
583
 
584
    $product = "";
585
    foreach ( @attrs ) {
586
        if ( /^--/ ) {
587
            if ( /^--NotDefault$/ ) {
588
                $notdefault++;
589
 
590
            } elsif ( /^--Uses=(.*)/ ) {
591
                UniquePush (\@uses, $1);
592
 
5115 dpurdie 593
            } elsif ( /^(--Alias=.*)/ ) {
594
                UniquePush (\@alias, $1);
595
 
227 dpurdie 596
            } else {
597
                Warning( "BuildProduct() unknown attribute: $_ -- ignored" );
598
            }
599
 
600
        } else {
601
            Error( "BuildProduct() multiple product specifications not allowed" )
602
                if ( $product ne "" );
603
            $product = $_;
604
        }
605
    }
606
 
607
    #
608
    #   Sanity test
609
    #
610
    Error( "BuildProduct() missing product specifications" )
611
        if ( $product eq "" );
612
 
613
    Error( "BuildProduct() product '$product' contains invalid characters" )
614
        if ( $product ne quotemeta( $product ) );
615
 
616
    Error( "BuildProduct() duplicate product '$product'" )
617
        if ( $BUILDPRODUCT{ $product } );
618
 
619
    Error( "BuildProduct() duplicate alias '$product'" )
620
        if ( $BUILDALIAS{ $product } );
621
 
622
    #
623
    #   Expand the user specified targets to allow the use of BuildAlias
624
    #   The (bad) side effect of this is that target options get reorganised
625
    #       PLATFORM,--Uses=ANOTHER  ==> PLATFORM --Uses=ANOTHER
626
    #
627
    #   Insert markers(++) into @aruments to mark when to process collected data
628
    #   Insert before each PLATFORM and at the end of the list
629
    #   platform specifier or the end of the list. Scan the arguments
630
    #
631
    @arguments = ExpandPlatforms( @arguments );
632
    my @new_args;
633
    foreach  ( @arguments )
634
    {
635
        push (@new_args, '++') unless ( m/^--/ );
636
        push (@new_args, $_ );
637
    }
638
    push (@new_args, '++');
639
    shift @new_args if $new_args[0] eq '++';
640
 
5115 dpurdie 641
    my @targs = @alias;
227 dpurdie 642
    my $target;
643
    my @tuses = @uses;
644
    foreach my $arg ( @new_args )
645
    {
646
        #
647
        #   Collect per-platform arguments
648
        #
649
        if ( $arg =~ /^--Uses=(.*)/ ) {
650
            UniquePush (\@tuses, $1);
651
            next;
652
 
653
        } elsif ( $arg =~ /^--/ ) {
654
            push @targs, $arg;
655
            next;
656
        }
657
 
658
        #
659
        #   Collect target(platform) name
660
        #
661
        unless ( $arg eq '++' )
662
        {
663
            $target = $arg;
664
            Error( "BuildProduct() cannot create a product based on a GENERIC platform" )
4551 dpurdie 665
                if ( PlatformConfig::checkBuildAvailability($target) == 2);
227 dpurdie 666
            next;
667
        }
668
 
669
        #
670
        #   Infer a BuildPlatform
671
        #   Do not provide a platform name. This will be created later when the
672
        #   full name is known - or can be calculated.
673
        #
674
        CreateBuildPlatformEntry('BuildProduct', $notdefault, $product, $target, \@tuses, \@targs );
675
 
5115 dpurdie 676
        @targs = @alias;
227 dpurdie 677
        @tuses = @uses;
678
        $target = undef;
679
    }
680
}
681
 
682
#-------------------------------------------------------------------------------
683
# Function        : CreateBuildPlatformEntry
684
#
685
# Description     : Internal routine to create the Build Entry
686
#                   Single point to create a platform, whatever one of those is
687
#
688
# Inputs          : $fname                  - Name of invoking directive
689
#                   $notdefault             - True if the platform is not to be added to the
690
#                                             list of default platforms
691
#                   $product                - Optional product name
692
#                   $target                 - Target platform name
693
#                   $pUses                  - Ref to an array of 'Uses'
694
#                   $pArgs                  - Ref to an array of platform arguments
695
#
696
# Returns         :
697
#
698
 
699
sub CreateBuildPlatformEntry
700
{
701
    my ($fname, $notdefault, $product, $target, $pUses, $pArgs ) = @_;
702
    my %buildentry;
703
    my $platform;
704
 
705
    #
706
    #   Create a basic BUILDINFO entry
707
    #
708
    $buildentry{FNAME} = $fname;
709
    $buildentry{NOT_DEFAULT} = $notdefault;
710
    $buildentry{PRODUCT} = $product;
711
    $buildentry{TARGET} = $target;
712
    $buildentry{BASE} = $target;
713
    $buildentry{USES} = [ @$pUses ] if $pUses;
363 dpurdie 714
    foreach ( @$pArgs )
715
    {
716
        if ( m~^--Alias=(.+)~ ) {
717
            push @{$buildentry{USERALIAS}}, split(',',$1);
718
        }
719
        else{
720
            push @{$buildentry{ARGS}}, $_;
721
        }
722
    }
227 dpurdie 723
 
4728 dpurdie 724
    #   Detect reserved words being misused as a platform name
725
    #   At the moment, the value of NATIVE is calculate towards the end of the
726
    #   build process so that it can be limited to platfroms that 
727
    #   are present.
728
    Error('Invalid use of the platform alias NATIVE','The NATIVE alias cannot be used to define build platforms')
729
        if (uc($target) eq 'NATIVE');
730
 
227 dpurdie 731
    #
732
    #   Allow per-platform processing to be alter the basic information
733
    #   Special processing may be perform to extend the information
734
    #   Allows special processing to be enabled on a per-target basis
735
    #
736
    #   There are three forms of processing that have been allowed for:
737
    #       1) None:        There is not platform specific extension
738
    #       2) Basic:       The extension will add or extend build information
739
    #       3) Advanced:    The extension will generate additional build information
740
    #                       structures.
741
    #
742
 
743
    #
744
    #   Locate the optional PLATFORM configuration file
745
    #   If it does exist then it can alter build-time information
746
    #
747
    if ( my $build_cfg = Require( "$::GBE_CONFIG/PLATFORM", "$target.cfg"  ) )
748
    {
749
        Verbose ("Processing(new) Platform Configuration file: $build_cfg");
750
 
297 dpurdie 751
        #
303 dpurdie 752
        #   Create package name with an uppercase target
753
        #   Target should be UC, but under windows its not detected
754
        #   at this time
755
        #
756
        my $package_name = uc($target) . '_Build';
757
 
758
        #
4551 dpurdie 759
        #   Ensure that the CFG is correctly formed
297 dpurdie 760
        #       Perhaps the package that it implements was misnamed
761
        #
303 dpurdie 762
        Error ("INTERNAL: $target.cfg does not satisfy API " )
297 dpurdie 763
            unless ( $package_name->can('new_platform') || $package_name->can('add_platform') );
764
 
227 dpurdie 765
        if ( $package_name->can('new_platform') )
766
        {
767
            Verbose ("Processing(new) Platform Configuration: $package_name");
768
            $package_name->new_platform( \%buildentry );
769
        }
770
        else
771
        {
772
            Debug ("Processing(new) Platform Configuration: $package_name. 'new_platform' function not found");
773
        }
774
    }
775
 
776
    #
777
    #   Add the basic entry into the build system, unless its been
778
    #   flagged as a TEMPLATE
779
    #
780
    AddBuildPlatformEntry (\%buildentry )
781
        unless ( $buildentry{TEMPLATE} );
782
}
783
 
784
 
785
#-------------------------------------------------------------------------------
786
# Function        : AddBuildPlatformEntry
787
#
788
# Description     : Internal routine to add a Build Entry into the build system
789
#                   This function MAY be called from the build extensions
790
#
791
#                   NOTES:
792
#                   No processing of the info structure is performed. This MUST
793
#                   have been done before now.
794
#
795
#                   Additional information may be added to the structure.
796
#
797
#
798
# Inputs          : $pInfo              - Reference to a BuildInfo structure
799
#
800
# Returns         : Nothing
801
#
802
sub AddBuildPlatformEntry
803
{
804
    my ($pInfo) = @_;
805
    my $fname = $pInfo->{FNAME};
806
 
807
    #
808
    #   Locate the optional PLATFORM configuration file
809
    #   If it does exist then it can extend build-time information
810
    #
811
    my $target = $pInfo->{TARGET};
241 dpurdie 812
 
279 dpurdie 813
    #
814
    #   Yukky Kludge
815
    #   JATS has a mechanism whereby packages can create new platforms
816
    #   Luckily this has only been done for LMOS - don't every do it again
817
    #   One problem is that we can't validate the target name at this point
818
    #   in time: as the packages are loaded much later.
819
    #
820
    #   Kludge. Assume that a leading LMOS_ can be removed when determing
821
    #           validity of the target platform.
822
    #
823
    my $base_target = $target;
824
    $base_target =~ s~^LMOS_~~;
241 dpurdie 825
 
279 dpurdie 826
    #
4551 dpurdie 827
    #   Detect GENERIC targets
828
    #       The Build file is only allowed to have one that can be built on any one machine
829
    #
830
    my $buildAvailability = PlatformConfig::checkBuildAvailability( $base_target );
831
    if ($buildAvailability == 2 )
832
    {
833
        UniquePush (\@GENERIC_TARGETS, $target );
834
        $pInfo->{IS_GENERIC} = 1;
835
    }
836
 
837
    #
279 dpurdie 838
    #   Ensure target is known to JATS
839
    #   Remove unknown targets from the build. Create a list of unknown
840
    #   targets and report them later.
841
    #
842
    #   If there are signs that the target has been processed, then it may be
843
    #   an alias that has not been expanded.
844
    #
845
    #   One result will be that alias platforms, such as DEVLINUX, that don't
846
    #   expand on WIN32 will be shown as DEVLINUX and not its components.
847
    #
4551 dpurdie 848
    unless ( $pInfo->{NOT_AVAILABLE} || exists $BUILDINFO{$target} || $pInfo->{IS_GENERIC} )
227 dpurdie 849
    {
279 dpurdie 850
        unless ( Exists( "$::GBE_CONFIG/PLATFORM", $base_target  ) )
851
        {
4551 dpurdie 852
            UniquePush (\@BUILD_BADNAME, $target ) 
853
                unless PlatformConfig::checkKnownSpecial($target);
279 dpurdie 854
            $pInfo->{NOT_AVAILABLE} = 1;
855
        }
856
    }
857
 
858
    #
4551 dpurdie 859
    #   Mark as NOT_AVAILABLE platforms that are not available on this machine
279 dpurdie 860
    #
861
    unless ($pInfo->{NOT_AVAILABLE} )
862
    {
863
        $pInfo->{NOT_AVAILABLE} = 1
4551 dpurdie 864
            if ($buildAvailability == 0 )
279 dpurdie 865
    }
866
 
867
    unless ($pInfo->{NOT_AVAILABLE} )
868
    {
4551 dpurdie 869
        my $target_cfg = $pInfo->{TARGET_CFG} || $target;
317 dpurdie 870
        if ( my $build_cfg = Require( "$::GBE_CONFIG/PLATFORM", "${target_cfg}.cfg"  ) )
227 dpurdie 871
        {
872
            Verbose ("Processing(add) Platform Configuration file: $build_cfg");
317 dpurdie 873
            my $package_name = "${target_cfg}_Build";
227 dpurdie 874
 
875
            if ( $package_name->can('add_platform') )
876
            {
877
                Verbose ("Processing(add) Platform Configuration: $package_name");
878
                $package_name->add_platform( $pInfo );
879
            }
880
            else
881
            {
882
                Debug ("Processing(add) Platform Configuration: $package_name. 'add_platform' function not found");
883
            }
884
        }
885
    }
886
 
887
    #
888
    #   If a product name has been provided then the platform is a product
889
    #   and will need additional processing
890
    #
891
    if ( $pInfo->{PRODUCT} )
892
    {
893
        #
894
        #   Create the platform name. Derived from the product and the target
895
        #
896
        $pInfo->{PLATFORM} = $pInfo->{PRODUCT} . '_' . $pInfo->{TARGET};
897
 
898
        #
899
        #   Remember the product name
900
        #
901
        $BUILDPRODUCT{ $pInfo->{PRODUCT} } = 1;
902
 
903
        #
904
        #   Add platform name to the alias explansion being created
905
        #   Allows the user to reference the entire FAMILY of platforms
906
        #
907
        HashJoin( \%BUILDALIAS, ' ', $pInfo->{PRODUCT}, $pInfo->{PLATFORM} );
908
 
909
        #
910
        #   Add arguments to the 'alias' based on the product
911
        #   Ensure they don't make it any further
912
        #
913
        HashJoin( \%BUILDALIAS, ' ', $pInfo->{PRODUCT}, @{$pInfo->{ARGS}} ) if ( $pInfo->{ARGS}  );
914
        $pInfo->{ARGS} = undef;
915
 
916
        #
917
        #   Create an element to assist in creating %ScmBuildProducts
918
        #
919
        $pInfo->{ISPRODUCT} = 1;
920
        $BUILDPRODUCT_PARTS{$pInfo->{PLATFORM}} = "$pInfo->{PRODUCT},$pInfo->{TARGET}";
921
    }
922
    else
923
    {
924
        $pInfo->{PRODUCT} = $pInfo->{TARGET};
925
        $pInfo->{PLATFORM} = $pInfo->{TARGET};
926
    }
927
 
928
    #---------------------------------------------------------------------------
929
    #   All the hard work has been done
930
    #   We now know the platforms full name
931
    #
932
    #   Ensure that the target platform has not been been specified
933
    #   Perhaps this should be an error
934
    #
935
    my $platform = $pInfo->{PLATFORM};
936
 
5109 dpurdie 937
    if ( defined ( $BUILDINFO{$platform}) && ! $Clobber)
227 dpurdie 938
    {
5410 dpurdie 939
        abtWarning("$fname() duplicate platform '$platform'");
940
        ErrorDoExit();
227 dpurdie 941
    }
942
 
943
    #
944
    #   Add platform (tag) to various lists
945
    #
946
    UniquePush( \@BUILDPLATFORMS, $platform );
947
    UniquePush( \@DEFBUILDPLATFORMS, $platform ) unless ( $pInfo->{NOT_DEFAULT} );
948
 
949
    #
950
    #   Create a simple alias if requested
951
    #   Used if a platform creates multiple entires
952
    #
953
    if ( $pInfo->{ALIAS} )
954
    {
317 dpurdie 955
        HashJoin( \%BUILDALIAS_DELAY, ' ', $_, $platform )
956
            foreach ( ArrayList($pInfo->{ALIAS}) );
227 dpurdie 957
    }
958
 
363 dpurdie 959
    if ( $pInfo->{USERALIAS} )
960
    {
961
        HashJoin( \%BUILDALIAS_DELAY, ' ', $_, $platform )
962
            foreach ( ArrayList($pInfo->{USERALIAS}) );
963
    }
964
 
227 dpurdie 965
    #
966
    #   Create a HARDWARE type alias if requested
967
    #   ie: SOLARIS_SPARC or SOLARIS_X86
968
    #
969
    if ( $pInfo->{HARDWARE} )
970
    {
971
        HashJoin( \%BUILDALIAS_DELAY, ' ',  $pInfo->{BASE} . '_' . $pInfo->{HARDWARE}, $platform );
972
    }
973
 
974
    #
975
    #   Create the 'parts' of the platform. This is a list of unique
976
    #   bits to search. It will consist of:
977
    #       [0]     - platform
978
    #       [1]     - product
979
    #       ...     - Uses bits ...
980
    #       [last]  - target
981
    #
982
    my @parts;
983
 
379 dpurdie 984
    if ( $pInfo->{USES_FIRST} )
985
    {
986
        UniquePush (\@parts, @{$pInfo->{USES_FIRST}} );
987
    }
988
 
989
    UniquePush (\@parts, $platform);
990
 
227 dpurdie 991
    #
992
    #   Include all the product extensions
993
    #
994
    if ( $pInfo->{ISPRODUCT}  )
995
    {
996
        UniquePush (\@parts, map {+ "$pInfo->{PRODUCT}_${_}" } @{$pInfo->{USES}});
997
        UniquePush (\@parts, map {+ "$pInfo->{PRODUCT}_${_}" } @{$pInfo->{ALSO_USES}});
998
        UniquePush (\@parts, $pInfo->{PRODUCT} );
999
    }
1000
 
1001
    #
1002
    #   Add in non-product expanded parts
1003
    #
1004
    UniquePush (\@parts, @{$pInfo->{EXTRA_USES}});
1005
 
1006
    #
1007
    #   Create a structure to assist in search path resolution
1008
    #   The order is important. It sets the include search order for include
1009
    #   files and libraries
1010
    #   If A uses B then search in A_B, A, B
1011
    #       ie: GAK uses MOS68K Search stuff in GAK_MOS68K, GAK, MOS68K
1012
    #
1013
    #       Usage:  OBFTP uses TP5 on MOSCF(target)       (BuildProduct)
1014
    #       Expansion: OBFTP, TP5_MOSCF, TP5
1015
    #
1016
    #       Usage: VS2003(target) also uses WIN32(uses)     (BuildPlatform)
1017
    #       Expansion: VS2003, VS2003_WIN32, WIN32
1018
    #
1019
    if ( $pInfo->{ISPRODUCT}  )
1020
    {
1021
        UniquePush (\@parts, map {+ "${_}_$pInfo->{TARGET}", $_, $pInfo->{TARGET}} @{$pInfo->{USES}});
1022
        UniquePush (\@parts, map {+ "${_}_$pInfo->{TARGET}", $_, $pInfo->{TARGET}} @{$pInfo->{ALSO_USES}});
1023
    }
1024
    else
1025
    {
1026
        UniquePush (\@parts, map {+ "$pInfo->{TARGET}_${_}", $pInfo->{TARGET}, $_} @{$pInfo->{USES}});
1027
        UniquePush (\@parts, map {+ "$pInfo->{TARGET}_${_}", $pInfo->{TARGET}, $_} @{$pInfo->{ALSO_USES}});
1028
    }
1029
 
1030
    #
1031
    #   Finally - the target
1032
    #
1033
    UniquePush (\@parts, $pInfo->{TARGET} );
1034
 
1035
    #
1036
    #   Save the PARTS
1037
    #   Also saved as BUILDPLATFORM_PARTS for interface with older versions
1038
    #   of the deployments scripts.
1039
    #
1040
    $pInfo->{PARTS} = \@parts;
1041
 
1042
    #
1043
    #   Add any arguments to the platforms argument list
1044
    #
1045
    PlatformArgument( $platform, @{$pInfo->{ARGS}} ) if ( $pInfo->{ARGS} );
1046
 
1047
    #
1048
    #   Clean up and save
1049
    #
1050
    delete $pInfo->{TEMPLATE};
1051
    delete $pInfo->{FNAME};
1052
    $BUILDINFO{$platform} = $pInfo;
1053
#    DebugDumpData("BUILDINFO", \%BUILDINFO );
1054
}
1055
 
1056
 
1057
sub BuildArgument
1058
{
1059
    my( $platform, @arguments ) = @_;
1060
    my( @platforms );
1061
 
1062
    Debug( "BuildArgument($platform, @arguments)" );
1063
 
1064
    Error( "BuildArgument must appear before BuildName()..." )
1065
        if ( $BUILDNAME ne "" );
1066
 
1067
    #
1068
    #   Allow a wildcard to apply a single argument to all platforms
1069
    #   Should only be used AFTER all the platforms have been specified
1070
    #
1071
    if ( $platform eq '*' )
1072
    {
1073
        @platforms = @BUILDPLATFORMS;          # Simple Wildcard
1074
    }
1075
    else
1076
    {
1077
        @platforms = ExpandPlatforms( $platform );  # aliasing
1078
    }
1079
 
283 dpurdie 1080
    foreach my $platform ( @platforms )
227 dpurdie 1081
    {
1082
        next if ( $platform =~ /^--/ );         # argument, ignore
1083
 
1084
        PlatformArgument( $platform, @arguments );
1085
    }
1086
}
1087
 
1088
 
1089
sub BuildPlatforms
1090
{
1091
    my( @arguments ) = @_;
1092
    my $fname = "BuildPlatforms";
1093
 
1094
    Debug( "BuildPlatforms(@arguments)" );
1095
 
1096
    Error( "BuildPlatforms must appear before BuildName()..." )
1097
        if ( $BUILDNAME ne "" );
1098
 
1099
    #
1100
    #   Expand the user specified platforms to allow the use of BuildAlias
1101
    #   The (bad) side effect of this is that platform options get reorganised
1102
    #       PLATFORM,--Uses=ANOTHER  ==> PLATFORM --Uses=ANOTHER
1103
    #
1104
    #   Insert markers(++) into @aruments to mark when to process collected data
1105
    #   Insert before each PLATFORM and at the end of the list
1106
    #   platform specifier or the end of the list. Scan the arguments
1107
    #
1108
    @arguments = ExpandPlatforms( @arguments );
1109
    my @new_args;
1110
    foreach  ( @arguments )
1111
    {
1112
        push (@new_args, '++') unless ( m/^--/ );
1113
        push (@new_args, $_ );
1114
    }
1115
    push (@new_args, '++');
1116
    shift @new_args if $new_args[0] eq '++';
1117
 
1118
 
1119
    my $platform  = "";                         # current platform
1120
    my $notdefault  = 0;
1121
    my @uses = ();
1122
    my @pargs = ();
1123
 
1124
    foreach my $arg ( @new_args )
1125
    {
1126
        #
1127
        #   Extract known options
1128
        #   Unknown options bind to the current platform
1129
        #
1130
        if ( $arg =~ /^--/ ) {
1131
            if ( $arg =~ /^--NotDefault$/ ) {
1132
                $notdefault = 1;
1133
 
1134
            } elsif ( $arg =~/^--Uses=(.*)/ ) {
1135
                UniquePush (\@uses, $1);
1136
 
1137
            } elsif ( $arg =~/^--FunctionName=(.*)/ ) {
1138
                $fname = $1;
1139
 
1140
            } else {
1141
                push @pargs, $arg;
1142
            }
1143
            next;
1144
        }
1145
 
1146
        #
1147
        #   New platform. Save name for later. Collect arguments first
1148
        #
1149
        unless ( $arg eq '++' )
1150
        {
1151
            $platform = $arg;
1152
 
1153
            Error( "$fname() missing platform specification" )
1154
                unless ( $platform );
1155
 
1156
            Error( "$fname() product '$platform' contains invalid characters" )
1157
                unless ( $platform eq quotemeta( $platform ) );
1158
 
1159
            next;
1160
        }
1161
 
1162
        #
1163
        #   Create new platform
1164
        #   Have collected name and arguments
1165
        #
1166
        CreateBuildPlatformEntry($fname, $notdefault, undef, $platform, \@uses, \@pargs  );
1167
 
1168
        #
1169
        #   Reset collection variables for next platform
1170
        #
1171
        $platform = "";
1172
        $notdefault  = 0;
1173
        @uses = ();
1174
        @pargs = ();
1175
    }
1176
}
1177
 
1178
 
1179
#   PlatformArgument ---
1180
#       Append an argument list to the specified platform argument list.
1181
#       Internal use only
1182
#..
1183
 
1184
sub PlatformArgument
1185
{
1186
    my( $platform, @arguments ) = @_;
1187
 
1188
    Debug( "  PlatformArguments($platform, @arguments)" );
1189
 
1190
    HashJoin( \%BUILDPLATFORMARGS, $;, $platform, @arguments )
1191
        if ( $platform );
1192
}
1193
 
279 dpurdie 1194
#-------------------------------------------------------------------------------
1195
# Function        : BuildName
1196
#
1197
# Description     : Defines the package name and version
1198
#
1199
# Inputs          : build arguments
1200
#                   Various formats are allowed for backward compatability
1201
#                   Must support a number of different formats
1202
#                       "name nn.nn.nn prj"
1203
#                       "name nn.nn.nn.prj"
1204
#
1205
#                       "name nn.nn.nn prj", "nn.nn.nn"
1206
#                       "name nn.nn.nn.prj", "nn.nn.nn"
1207
#
1208
#                       "name", "nn.nn.nn.prj"
1209
#
1210
#                       "name", "nn.nn.nn", "prj", --RelaxedVersion
1211
#
1212
# Returns         : Nothing
1213
#
227 dpurdie 1214
sub BuildName
1215
{
1216
    my( @arguments ) = @_;
1217
    my $relaxed_version_name = 0;
1218
    my @args;
1219
 
1220
    Debug( "BuildName(@arguments)" );
1221
 
315 dpurdie 1222
    Error( "Platform(s) not defined.",
227 dpurdie 1223
            "BuildAlias, BuildProduct and BuildPlatform directives must be defined prior to BuildName()." )
1224
        unless( scalar @BUILDPLATFORMS );
1225
 
1226
#.. Parse arguments
1227
#.
1228
    my $build_info = parseBuildName( @arguments );
1229
 
1230
    $BUILDNAME_PACKAGE = $build_info->{BUILDNAME_PACKAGE};
1231
    $BUILDNAME_VERSION = $build_info->{BUILDNAME_VERSION};
1232
    $BUILDNAME_PROJECT = $build_info->{BUILDNAME_PROJECT};
359 dpurdie 1233
    $BUILDNAME_SUFFIX  = $BUILDNAME_PROJECT ? '.' . $BUILDNAME_PROJECT : '';
227 dpurdie 1234
 
1235
    $BUILDNAME         = $build_info->{BUILDNAME};
1236
    $BUILDVERSION      = $build_info->{BUILDVERSION};
1237
 
1238
    $DEPLOY_PATCH      = $build_info->{DEPLOY_PATCH} || 0;
1239
 
1240
    #
1241
    #   Clobber processing done after values have been accumulated
1242
    #   as they may be used later
1243
    #
1244
    return if ( $Clobber );
4003 dpurdie 1245
    ToolsetFile('build.log');
1246
    ToolsetFile('ChangeLog', 'ChangeLog.bak') if ( $ScmHost eq "Unix" );
1247
 
359 dpurdie 1248
    #
1249
    #   Determine type of sandbox
1250
    #
1251
    $sandbox_exact = ( -f $::GBE_DPKG_SBOX . '/.exact' )
1252
        if ( $::GBE_DPKG_SBOX );
1253
 
227 dpurdie 1254
#.. Create the ChangeLog
1255
#
1256
    if ( -d "CVS" )                             # CVS support subdir
1257
    {
1258
        System( "$::GBE_PERL $::GBE_TOOLS/cvs2cl.pl --tags --branches --revisions --day-of-week" )
1259
            if ( $Nolog == 0 && $ScmHost eq "Unix" );
1260
    }
1261
 
1262
 
1263
#.. Create build.log summary information
1264
#
261 dpurdie 1265
    my ($sep) = "\n".(" " x 11) . ". ";
227 dpurdie 1266
 
261 dpurdie 1267
    Log( "\nBuild configuration (version $::GBE_VERSION)" );
1268
    Log( "Name ....... $BUILDNAME ($ScmHost)" );
1269
    Log( "Version .... $BUILDNAME_VERSION" );
1270
    Log( "DeployPatch. $DEPLOY_PATCH" ) if ($DEPLOY_PATCH);
1271
    Log( "Project .... $BUILDNAME_PROJECT" )if ($BUILDNAME_PROJECT);
1272
    Log( "Project .... ****** Specifically supressed ******" )unless ($BUILDNAME_PROJECT);
1273
    Log( "DateTime ... $::CurrentTime" );
1274
    Log( "AutoBuild... Enabled:$::GBE_ABT" ) if defined($::GBE_ABT) ;
359 dpurdie 1275
    Log( "Build dir... $Cwd" ) if defined($::GBE_ABT) || $::GBE_DPKG_SBOX;
4161 dpurdie 1276
    Log( "Build Mach.. $::GBE_HOSTNAME" ) if defined($::GBE_ABT);
227 dpurdie 1277
 
359 dpurdie 1278
    Log( "PERL ....... $::GBE_PERL" );
261 dpurdie 1279
    Log( "BIN  ....... $::GBE_BIN" );
1280
    Log( "TOOLS ...... $::GBE_TOOLS" );
1281
    Log( "CONFIG ..... $::GBE_CONFIG" );
1282
    Log( "MACHTYPE ... $::GBE_MACHTYPE" );
227 dpurdie 1283
 
261 dpurdie 1284
    Log( "PLATFORM ... " . PrintList([split(' ', $::GBE_PLATFORM)], $sep) )    if defined ($::GBE_PLATFORM);
1285
    Log( "BUILDFILTER. " . PrintList([split(' ', $::GBE_BUILDFILTER)], $sep) ) if defined ($::GBE_BUILDFILTER);
227 dpurdie 1286
 
261 dpurdie 1287
    Log( "DPKG_STORE.. $::GBE_DPKG_STORE" );
1288
    Log( "DPKG ....... $::GBE_DPKG" );
4688 dpurdie 1289
    Log( "DPKG_REPLI . $::GBE_DPKG_REPLICA" );
261 dpurdie 1290
    Log( "DPKG_CACHE . $::GBE_DPKG_CACHE" );
1291
    Log( "DPKG_LOCAL . $::GBE_DPKG_LOCAL" );
1292
    Log( "DPKG_SBOX .. $::GBE_DPKG_SBOX" );
359 dpurdie 1293
    Log( "Sandbox .... " . ($sandbox_exact ? "Exact" : "Development") );
3559 dpurdie 1294
    Log( "LocalFilter. $::GBE_SANDBOX/buildfilter") if ( $::GBE_SANDBOX && -f $::GBE_SANDBOX . '/buildfilter' );
227 dpurdie 1295
 
261 dpurdie 1296
    Log( "Platforms .. " . PrintPlatforms(\@BUILDPLATFORMS, $sep) );
227 dpurdie 1297
 
1298
    #
241 dpurdie 1299
    #   Generate a list of platforms that are completely unknown to JATS
4003 dpurdie 1300
    #   May be the result of a user typo or a guess
241 dpurdie 1301
    #
1302
    if ( @BUILD_BADNAME )
1303
    {
281 dpurdie 1304
        Log( "Unknown Pl . " . PrintPlatforms(\@BUILD_BADNAME, $sep) );
4551 dpurdie 1305
        Warning ("The following platform names are not known to JATS", "@BUILD_BADNAME");
241 dpurdie 1306
    }
4551 dpurdie 1307
 
241 dpurdie 1308
    #
4551 dpurdie 1309
    #   Detect multiple GENERIC targets
1310
    #       Only one such target can be processed on any one machine
1311
    #
1312
    if ($#GENERIC_TARGETS > 0)
1313
    {
1314
        Error ("Multiple GENERIC targets detected", PrintPlatforms(\@GENERIC_TARGETS, $sep));
1315
    }
1316
    if ($#GENERIC_TARGETS >= 0 )
1317
    {
1318
        $All = 1;
1319
    }
1320
 
1321
    #
227 dpurdie 1322
    #   Generate a list of active platforms
1323
    #   Ensure that there are some active platforms
1324
    #
1325
    GeneratePlatformList();
4551 dpurdie 1326
 
1327
    #
1328
    #   Detect a mix of Generic and non Generic targets
1329
    #       Cannot mix generic and non-generic targets
1330
    #
1331
    if ($#GENERIC_TARGETS >= 0 && $#BUILD_ACTIVEPLATFORMS >= 0)
1332
    {
1333
        if ($#BUILD_ACTIVEPLATFORMS != $#GENERIC_TARGETS )
1334
        {
1335
            Verbose("Active:", @BUILD_ACTIVEPLATFORMS);
1336
            Verbose("Generic:", @GENERIC_TARGETS);
1337
            Error("Cannot mix GENERIC and non-GENERIC targets in the one build");
1338
        }
1339
    }
1340
 
4778 dpurdie 1341
    #
1342
    #   Build System Generic Saniy Test
1343
    #       If Generic   then MUST be a GENERIC build
1344
    #       If NoGeneric then MUST not be a GENERIC build
1345
    #
1346
    if (defined $GenericBuild)
1347
    {
1348
        if ( scalar(@GENERIC_TARGETS) ne $GenericBuild)
1349
        {
1350
            Error("Generic build inconsistency",
1351
                  "Release Manager entry indicates: $GenericBuild",
1352
                  "Build File indicates: " . scalar(@GENERIC_TARGETS)
1353
                  );
1354
        }
1355
    }
1356
 
4003 dpurdie 1357
    unless( @BUILD_ACTIVEPLATFORMS )
1358
    {
5109 dpurdie 1359
        my $msg = 'GBE_BUILDFILTER prevents any targets being built';
4003 dpurdie 1360
        if (defined($::GBE_ABT)) {
227 dpurdie 1361
 
4003 dpurdie 1362
            # Build filter on this machine prevents the package building
1363
            # On a Build System this is not an error
1364
            #   Create a dummy platform called NOBUILD
1365
            #   Do not populate the interface directory with package data
1366
            #   Flag for jmake to do very little
1367
            #
1368
            CreateBuildPlatformEntry('Internal', 0, undef, 'NOBUILD');
1369
            $IgnorePkgs = 1;
1370
            $NoBuild = 1;
5109 dpurdie 1371
            Log( "Build for .. ". PrintPlatforms(['NOBUILD - ' . $msg], $sep));
4003 dpurdie 1372
 
1373
        } else {
5109 dpurdie 1374
            Error( $msg );
4003 dpurdie 1375
        }
1376
    }
1377
    else
1378
    {
1379
        Log( "Build for .. ". PrintPlatforms(\@BUILD_ACTIVEPLATFORMS, $sep));
1380
    }
1381
 
227 dpurdie 1382
    #
1383
    #   Generate an error if nothing can be done because the GBE_PLATFORM
1384
    #   masks any useful operation.
1385
    #
1386
    if ( $::GBE_PLATFORM )
1387
    {
1388
        my @MAKE_PLATFORMS;
1389
        my %active_platforms;
1390
 
239 dpurdie 1391
        #
1392
        #   Create a hash of active platforms based on the array of
1393
        #   active platforms to simplify testing
1394
        #
1395
        $active_platforms{$_} = 1 foreach ( @BUILD_ACTIVEPLATFORMS  );
227 dpurdie 1396
 
4551 dpurdie 1397
        unless ( $#GENERIC_TARGETS >= 0 )
227 dpurdie 1398
        {
239 dpurdie 1399
            foreach  ( split( ' ', $::GBE_PLATFORM) )
1400
            {
1401
                push @MAKE_PLATFORMS, $_
1402
                    if ( $active_platforms{$_} );
1403
            }
227 dpurdie 1404
 
239 dpurdie 1405
            Error ("The GBE_PLATFORM filter prevents any targets being made",
1406
                   "GBE_PLATFORM: $::GBE_PLATFORM" ) unless ( @MAKE_PLATFORMS );
227 dpurdie 1407
 
261 dpurdie 1408
            Log( "Make for ... ". PrintPlatforms(\@MAKE_PLATFORMS, $sep));
239 dpurdie 1409
        }
227 dpurdie 1410
 
1411
    }
1412
 
1413
    return 1;
1414
}
1415
 
1416
 
1417
sub BuildPreviousVersion
1418
{
1419
    my( $version ) = shift;
1420
 
1421
    $BUILDPREVIOUSVERSION = $version;
261 dpurdie 1422
    Log( "Previous Version ... $BUILDPREVIOUSVERSION" );
227 dpurdie 1423
 
1424
    return 1;
1425
}
1426
 
1427
 
1428
sub BuildInterface
1429
{
1430
    my( $ifdirname ) = @_;
1431
 
1432
 
1433
    #
1434
    #   Clobber the directory - at the end.
1435
    #
1436
    if ( $Clobber )
1437
    {
1438
        #
1439
        #   If this Interface directory contains the Dpackage.cfg file
1440
        #   then JATS has created DPACKAGE and it needs to be clobbered
1441
        #   Flag that it needs to be done later - when we know where it is
1442
        #
1443
        $DeleteDPACKAGE = 1 if ( -f "$ifdirname/Dpackage.cfg" );
1444
 
1445
        push @CLOBBERDIRS, $ifdirname;
1446
        return;
1447
    }
1448
 
1449
    #
1450
    #   In AutoBuildTool mode the entire interface directory
1451
    #   will be deleted. This allows the build to be retried
1452
    #
1453
    if (  defined($::GBE_ABT) )   # clobber mode ?
1454
    {
361 dpurdie 1455
        if ( -d $ifdirname )
227 dpurdie 1456
        {
361 dpurdie 1457
                RmDirTree( $ifdirname );
227 dpurdie 1458
        }
1459
    }
1460
 
1461
    if ( $ifdirname eq "local" ) {
341 dpurdie 1462
        mkpath ( "$ifdirname/inc" );
227 dpurdie 1463
        $BUILDLOCAL = "local";
1464
 
1465
    } else {
341 dpurdie 1466
        mkpath ( "$ifdirname/include" );
227 dpurdie 1467
        $BUILDINTERFACE = $ifdirname;
1468
        $::ScmInterface = $ifdirname;
1469
    }
341 dpurdie 1470
    mkpath ( "$ifdirname/bin" );
1471
    mkpath ( "$ifdirname/lib" );
227 dpurdie 1472
 
261 dpurdie 1473
    Log( "Interface .. $ifdirname" );
227 dpurdie 1474
    return 1;
1475
}
1476
 
1477
 
1478
sub BuildDirTree
1479
{
1480
    my( $dirfile, $dirhead ) = @_;
1481
    my( $dirname, $c );
1482
 
1483
    $dirhead = '.'
1484
        unless defined( $dirhead );
1485
 
1486
    if ( $Clobber )                             # clobber mode ?
1487
    {
1488
        push @CLOBBERDIRS, $dirhead unless $dirhead eq '.';
1489
        return;
1490
    }
1491
 
1492
    #
1493
    #   Allow for an empty "dirfile". This will allow a directory to be created
1494
    #   without the overhead of the file
1495
    #
1496
    if ( ! $dirfile )
1497
    {
261 dpurdie 1498
        Log( "DirTree .... $dirhead" );
341 dpurdie 1499
        mkpath ( $dirhead );
227 dpurdie 1500
    }
1501
    else
1502
    {
261 dpurdie 1503
        Log( "DirTree .... $dirfile within $dirhead" );
341 dpurdie 1504
        mkpath ( $dirhead );
1505
 
283 dpurdie 1506
        open( DIRFILE, '<' ,$dirfile ) ||
227 dpurdie 1507
            Error( "cannot open '$dirfile'" );
1508
 
1509
        while( $dirname = <DIRFILE> )
1510
        {
1511
            chop $dirname;
1512
            $dirname =~ s/#.*//;
1513
            $c = $dirname =~ s/\s*(\S+).*/$1/g;
1514
 
1515
            next unless ( $c == 1 );
1516
 
1517
            if ( ! -d "$dirhead/$dirname" )
1518
            {
261 dpurdie 1519
                Log( "Dir ........ $dirhead/$dirname" );
341 dpurdie 1520
                mkpath ( "$dirhead/$dirname" );
227 dpurdie 1521
            }
1522
        }
1523
 
1524
        close( DIRFILE );
1525
    }
1526
    $BUILDDIRTREE = $dirhead;
1527
}
1528
 
1529
#-------------------------------------------------------------------------------
1530
# Function        : IncludePkg
1531
#
1532
# Description     : Examine a fully specified package directory for a file
1533
#                   that will specify packages to be included. This allows
1534
#                   a package to be simply a package of other packages
1535
#
1536
#                   Internal function. Not to be used by users
1537
#
1538
# Inputs          : Name of the package
1539
#                   Full directory path of the package to examine
1540
#
1541
# Returns         : Nothing
1542
#
1543
sub IncludePkg
1544
{
1545
    my ($name, $pkg) = @_;
1546
    my $file = "$pkg/incpkg";
1547
 
363 dpurdie 1548
    Debug ("IncludePkg: $name, $pkg" );
227 dpurdie 1549
 
1550
    #
1551
    #   Using a require will ensure that the package is only processed once
1552
    #   even though the function user may be called multiple times.
1553
    #   Also prevents recursion within included packages.
1554
    #
1555
    if ( -f $file  )
1556
    {
261 dpurdie 1557
        Log( "PackageIncludes. $name" ) unless ( $INC{$file} );
227 dpurdie 1558
        require $file;
1559
    }
1560
}
1561
 
1562
 
1563
sub LinkSandbox
1564
{
1565
    my( $name, $path, $platform ) = @_;
1566
    return if ( $Clobber );                     # clobber mode ?
2078 dpurdie 1567
 
371 dpurdie 1568
    Warning ("LinkSandbox() This directive is being deprecated.");       #Dec-2011
227 dpurdie 1569
 
1570
    Error ("LinkSandbox() expects three arguments:  @_")
1571
        unless ( $#_ == 2 );
1572
 
371 dpurdie 1573
    Error ("LinkSandbox not allowed in ABT build","It can only be used in a Development Environment")
299 dpurdie 1574
        if ( $::GBE_ABT );
1575
 
227 dpurdie 1576
    Debug( "LinkSandbox:" );
1577
    Debug( "Package:   $name" );
1578
    Debug( "Version:   $path" );
1579
 
1580
    DataDirective("LinkSandbox");               # This directive allowed here
1581
 
2078 dpurdie 1582
    if ( $IgnorePkgs )
1583
    {
1584
        Log( "LinkSandbox. $name ($path) - Ignored" );
1585
        return;
1586
    }
1587
 
227 dpurdie 1588
#
1589
#   If GBE_BUILDFILTER exists, Import 'user' platform
1590
#   specification and filter against the BUILD_ACTIVEPLATFORMS.
1591
#
261 dpurdie 1592
    Log( "LinkSandbox. $name ($path)" );
227 dpurdie 1593
 
1594
    if ( ! -d $path )                           # sandbox exists ?
1595
    {
261 dpurdie 1596
        Log( "WARNING .... Sandbox $path not available" );
227 dpurdie 1597
    }
1598
    else
1599
    {
363 dpurdie 1600
        my @platforms;
1601
        if ( !defined($platform) || $platform eq "*" ) {
1602
            @platforms = @BUILD_ACTIVEPLATFORMS;
1603
        } else {
1604
            @platforms = ExpandPlatforms( split( ',', $platform ) );
1605
        }
1606
 
227 dpurdie 1607
        $path = Realpath( $path );
363 dpurdie 1608
        IncludePkg ( $name, $path );
1609
        foreach my $platform ( @platforms )
227 dpurdie 1610
        {
363 dpurdie 1611
            LinkEntry( $platform, $path, $name, "!sandbox", 1, 1 );
227 dpurdie 1612
        }
1613
    }
1614
}
1615
 
1616
 
1617
#-------------------------------------------------------------------------------
1618
# Function        : LinkPkgArchive
1619
#
1620
# Description     : Include an external package into the build sandbox
1621
#                   by extending the compiler and linker search paths to
1622
#                   include suitable directories found in the package
1623
#
1624
# Inputs          : package name
1625
#                   package version
1626
#
1627
sub LinkPkgArchive
1628
{
1629
    my( $name, $version ) = @_;
1630
 
1631
    return BuildPkgArchive( @_ )
1632
        if ( $ForceBuildPkg );                  # Forcing interface directory
1633
    return if ( $Clobber );                     # clobber mode ?
1634
 
1635
    Debug( "LinkPkgArchive:" );
1636
    Debug( "Name:      $name" );
1637
    Debug( "Version:   $version" );
1638
 
1639
    DataDirective("LinkPkgArchive");            # This directive allowed here
1640
 
2078 dpurdie 1641
    if ( $IgnorePkgs )
1642
    {
1643
        Log( "LinkPkgArchive .. $name ($version) - Ignored" );
1644
        return;
1645
    }
1646
 
227 dpurdie 1647
    #
1648
    #   Ensure that we have do not have multiple definitions
1649
    #
1650
    if ( PackageEntry::Exists( $name, $version ) )
1651
    {
261 dpurdie 1652
        Log( "Duplicate Package: $name, $version. Duplicate entry ignored" );
227 dpurdie 1653
        return;
1654
    }
1655
 
1656
    if ( $Cache && $::GBE_DPKG_CACHE )
1657
    {
1658
        my $mode = ($Cache > 1) ? "-refresh" : "";
331 dpurdie 1659
        Log( "LinkPkgArchive .. $name ($version) Update Cache" );
227 dpurdie 1660
        System('--NoExit', "$::GBE_PERL $::GBE_TOOLS/cache_dpkg.pl $mode -quiet $name/$version" );
1661
    }
1662
 
1663
    #
1664
    #   Locate the package ONCE
1665
    #
331 dpurdie 1666
    Log( "LinkPkgArchive .. $name ($version)" );
227 dpurdie 1667
    my ($pkg, $local ) = PackageLocate( $name, $version );
1668
    if ( $pkg )
1669
    {
1670
        #
1671
        #   Generate package rules for each active platform
1672
        #
363 dpurdie 1673
        IncludePkg ( $name, $pkg );
1674
        foreach my $platform ( @BUILD_ACTIVEPLATFORMS, '--' )
227 dpurdie 1675
        {
331 dpurdie 1676
            LinkEntry( $platform, $pkg, $name, $version, 0, $local );
227 dpurdie 1677
        }
1678
    }
1679
}
1680
 
1681
#-------------------------------------------------------------------------------
1682
# Function        : PackageLocate
1683
#
1684
# Description     : Locate a package
1685
#                   Once located a package will be processed for each
1686
#                   platform, but it need only be located ONCE
1687
#
1688
# Inputs          : package name
1689
#                   package version
1690
#
1691
# Returns         : path to the package
1692
#                   local       1 - From local package repository
1693
#
1694
sub PackageLocate
1695
{
1696
    my ($name, $uversion ) = @_;
283 dpurdie 1697
    my $pkg;
227 dpurdie 1698
    my $local = 1;
359 dpurdie 1699
    my $sandbox = ! $sandbox_exact;
227 dpurdie 1700
    my $isa_cache = 0;
1701
    my $version;
1702
 
1703
    Debug( "PackageLocate: ($name/$uversion)" );
1704
 
1705
    #
1706
    #   Look in each package archive directory
1707
    #
1708
    foreach my $dpkg ( split( $::ScmPathSep, $::GBE_DPKG_SBOX),
1709
                       '--NotSandbox',
1710
                       split( $::ScmPathSep, $::GBE_DPKG_LOCAL),
1711
                       '--NotLocal',
1712
                       split( $::ScmPathSep, $::GBE_DPKG_CACHE),
1713
                       '--NotCache',
4688 dpurdie 1714
                       split( $::ScmPathSep, $::GBE_DPKG_REPLICA),
227 dpurdie 1715
                       split( $::ScmPathSep, $::GBE_DPKG),
313 dpurdie 1716
                       split( $::ScmPathSep, $::GBE_DPLY),
227 dpurdie 1717
                       split( $::ScmPathSep, $::GBE_DPKG_STORE) )
1718
    {
1719
 
1720
        #
1721
        #   Detect various tags that have been placed in the search list
1722
        #   to flag the end of the sandbox search and the end of the local
1723
        #   archive search
1724
        #
1725
        if ( $dpkg eq '--NotSandbox' )
1726
        {
1727
            $sandbox = 0;
1728
            next;
1729
        }
1730
        if ( $dpkg eq '--NotLocal' )
1731
        {
1732
            $local = 0;
1733
            $isa_cache = 1;
1734
            next;
1735
        }
1736
        if ( $dpkg eq '--NotCache' )
1737
        {
1738
            $isa_cache = 0;
1739
            next;
1740
        }
1741
 
1742
 
1743
        #
1744
        #   If we are playing in a sandbox, then the version number is
1745
        #   not used. The Package suffix is still used so that we can
1746
        #   differentiate sysbasetypes.xxxxx.mas and sysbasetypes.xxxxx.syd
1747
        #
1748
        if ( $sandbox )
1749
        {
359 dpurdie 1750
            my ($pn, $pv, $ps ) = SplitPackage ($name, $uversion );
227 dpurdie 1751
            $version = 'sandbox';
1752
            $version .= '.' . $ps if ( $ps );
1753
        }
1754
        else
1755
        {
1756
            $version = $uversion;
1757
        }
1758
 
1759
        #
1760
        #   Alias support
1761
        #   If the 'version' is '!current' then use a version of:
1762
        #       current
1763
        #       current_<USER_NAME>
1764
        #   This is an old mechanism whose use should not be encouraged
1765
        #
1766
        #..
1767
        if ( $version eq "!current" )
331 dpurdie 1768
        {
1769
            Error ("Use of !version is not allowed in ABT build")
1770
                if ( $::GBE_ABT );
227 dpurdie 1771
 
331 dpurdie 1772
            $pkg = "$dpkg/$name/current";       # current
227 dpurdie 1773
            $pkg = "$dpkg/$name/current.lnk"
1774
                if ( -e "$dpkg/$name/current.lnk" );
1775
 
331 dpurdie 1776
                                                # USER specific current
1777
            EnvImport( "USER" );
227 dpurdie 1778
            $pkg = "$dpkg/$name/current_$::USER"
1779
                if ( -e "$dpkg/$name/current_$::USER" );
1780
 
1781
            $pkg = "$dpkg/$name/current_$::USER.lnk"
1782
                if ( -e "$dpkg/$name/current_$::USER.lnk" );
1783
        }
1784
        else
1785
        {                                       # standard
1786
            $pkg = "$dpkg/$name/$version";
1787
            $pkg = "$dpkg/$name/$version.lnk"
1788
                if ( -e "$dpkg/$name/$version.lnk" );
1789
        }
1790
 
1791
        #
1792
        #   Using a soft link
1793
        #   Emulate a link in software. The link file contains one line
1794
        #   which is the real pathname of the package
1795
        #
1796
        if ( $pkg =~ m~(.*)\.lnk$~  )
1797
        {
1798
            #
1799
            #   Warn the user if both a link and a real directory
1800
            #   are both present - the link may well be incorrect
1801
            #
1802
            my $non_link = $1;
1803
            Warning ("Suspect package link: $pkg",
1804
                     "Both a link and a package where found - using the link" )
1805
                                                            if ( -d $non_link );
1806
 
1807
            Debug( "           link found -> $pkg" );
1808
            my $link_src = $pkg;
283 dpurdie 1809
            open( LNKFILE, '<', "$pkg" ) || Error( "cannot open '$pkg'" );
227 dpurdie 1810
            $pkg = <LNKFILE>;                   # real path
1811
            close( LNKFILE );
1812
            $pkg = '' unless ( $pkg );
325 dpurdie 1813
            $pkg =~ s~\s+$~~;;
371 dpurdie 1814
            $pkg =~ s~^GBE_SANDBOX/~$::GBE_SANDBOX/~;
227 dpurdie 1815
 
2078 dpurdie 1816
            unless ( -d $pkg )
1817
            {
1818
                Error ("Broken link: $pkg",
1819
                       "Source link: $link_src",
1820
                       "Try deleting the .lnk file" ) unless ( $NoPackageError );
1821
 
1822
                Warning ("Package not available. Broken link: $pkg");
1823
            }
227 dpurdie 1824
        }
1825
 
1826
        Debug( "           searching $pkg" );
1827
 
1828
        #   Does the package directory exist?
1829
        #   Terminate the directory name with a "/" to detect hidden spaces
1830
        #..
1831
        $pkg =~ s~//~/~g;
1832
        next unless ( -d "$pkg/" );             # exists ?
1833
 
1834
        #
1835
        #   If the package exists within the dpkg_archive cache then mark the
1836
        #   version as having been used. Used by cache cleanup algorithms
1837
        #
1838
        if ( $isa_cache  )
1839
        {
1840
            TouchFile ( "$pkg/used.cache", "Marks the cache copy as being used");
1841
        }
1842
 
1843
        #
1844
        #   Use the first suitable package found
1845
        #..
1846
 
1847
        Debug( "           importing $pkg" );
1848
        return $pkg, $local;
1849
    }
1850
 
1851
    #
1852
    #   Package not found
1853
    #   This is an error, although it can be bypassed
1854
    #
261 dpurdie 1855
    Error ("Required package not found: '$name/$version'" ) unless ( $NoPackageError );
227 dpurdie 1856
 
261 dpurdie 1857
    Log( "WARNING .... Package not available: '$name/$version'" );
283 dpurdie 1858
    return;
227 dpurdie 1859
}
1860
 
1861
 
1862
#-------------------------------------------------------------------------------
1863
# Function        : LinkEntry
1864
#
1865
# Description     : Scan a package an locate platform specific directories
1866
#                   Create data structures to capture the information
1867
#                   This function is used by LinkPkgArchive and LinkSandbox
1868
#                   to perfom the bulk of package inclusion work.
1869
#
1870
# Inputs          : platform being processed
1871
#                   path to the package
1872
#                   name of the package
1873
#                   version of the package
1874
#                   sandbox support (non-zero)
331 dpurdie 1875
#                   local package
227 dpurdie 1876
#
1877
sub LinkEntry
1878
{
331 dpurdie 1879
    my( $platform, $pkg, $name, $version, $sandbox, $local ) = @_;
227 dpurdie 1880
    my( $entry );
1881
 
1882
    #   Create entry record
1883
    #
1884
    #..
331 dpurdie 1885
    $entry = PackageEntry::New( $pkg, $name, $version, $sandbox, 'link', $local );
227 dpurdie 1886
 
1887
    #   Populate includes:
1888
    #
1889
    #   - include/$platform                 (eg include/solaris)
1890
    #   - inc/$platform                     (eg inc/solaris)
1891
    #   - include.$platform                 (eg include.solaris)
1892
    #   - inc.$platform                     (eg inc.solaris)
1893
    #   - include                           (eg include)
1894
    #   - inc                               (eg inc)
1895
    #
1896
    #   plus, product specialisation directores
1897
    #
1898
    #   eg. BuildProduct( 'IDFC', 'WIN32' );
1899
    #
1900
    #   - inc/IDFC_WIN32                    <- derived platform
1901
    #   - inc/IDFC                          <- product
1902
    #   - inc/WIN32                         <- target
1903
    #..
1904
    my $parts = $BUILDINFO{$platform}{PARTS};
1905
 
1906
    foreach my $part ( @$parts )
1907
    {
1908
        $entry->RuleInc( "/include." . $part ) if ( !$sandbox );
1909
        $entry->RuleInc( "/inc." . $part )     if ( !$sandbox );
1910
        $entry->RuleInc( "/include/" . $part ) if ( !$sandbox );
1911
        $entry->RuleInc( "/inc/" . $part );
1912
    }
1913
 
1914
    #
1915
    #   Also search the root include directory - last
1916
    #
1917
    $entry->RuleInc( "/include" )               if ( !$sandbox );
1918
    $entry->RuleInc( "/inc" );
1919
 
1920
    #   Populate libraries:
1921
    #
1922
    #   - lib/lib.$platform[D|P]            (eg lib/lib.sparcD)
1923
    #   - lib/$platform[D|P]                (eg lib/lib.sparc)
1924
    #   - lib.$platform[D|P]                (eg lib.sparcD)
1925
    #
1926
    #   plus, product specialisation directores
1927
    #
1928
    #   eg. BuildProduct( 'IDFC', 'WIN32' );
1929
    #
1930
    #   - lib/IDFC_WIN32                    <- derived platform
1931
    #   - lib/IDFC                          <- product
1932
    #   - lib/WIN32                         <- target
1933
    #..
1934
    $parts = $BUILDINFO{$platform}{PARTS};
1935
 
1936
    foreach my $part ( @$parts )
1937
    {
1938
        $entry->RuleLib("/lib" . ".$part" )     if ( !$sandbox );
1939
        $entry->RuleLib("/lib" . "/lib.$part" ) if ( !$sandbox );
1940
        $entry->RuleLib("/lib" . "/$part" );
1941
    }
1942
 
1943
    #
1944
    #   Some extra places to search
1945
    #   None. This is good as it indicates that all locations are described in PARTS
1946
    #
1947
    #   Do NOT search in /lib. There are no libraries that work on all platforms
1948
    #   Libraries are binaries!
1949
    #
1950
    #    $entry->RuleLib( "/lib" );
1951
 
1952
    #   Tools:
1953
    #
1954
    #   Tools provide an extensible search path for tools and
1955
    #   utilities used to build programs. These are tools that
1956
    #   are executable on the current host machine and are
1957
    #   independent of the toolset.
1958
    #
1959
    #..
1960
    $entry->ExamineToolPath();
1961
    $entry->ExamineThxPath($platform);
1962
    $entry->Cleanup();                          # cleanup tables
1963
 
1964
    #
1965
    #   Add the package entry to the array of such entries for
1966
    #   the current platform. Maintain the discovery order
1967
    #
1968
    #..
1969
    push ( @{$PKGRULES{$platform}}, $entry );
1970
}
1971
 
1972
 
1973
#-------------------------------------------------------------------------------
1974
# Function        : BuildPkgArchive
1975
#
1976
# Description     : Include an external package into the build sandbox
1977
#                   by copying the packages files into the interface directory
1978
#
1979
# Inputs          : package name
1980
#                   package version
1981
#
1982
sub BuildPkgArchive
1983
{
1984
    my( $name, $version ) = @_;
1985
 
1986
    return if ( $Clobber );                     # clobber mode ?
1987
 
1988
    Debug( "BuildPkgArchive:" );
1989
    Debug( "Name:      $name" );
1990
    Debug( "Version:   $version" );
1991
 
1992
    DataDirective("BuildPkgArchive");           # This directive allowed here
1993
 
2078 dpurdie 1994
    if ( $IgnorePkgs )
1995
    {
1996
        Log( "BuildPkgArchive . $name ($version) - Ignored" );
1997
        return;
1998
    }
1999
 
227 dpurdie 2000
    #
2001
    #   Ensure that we have do not have multiple definitions
2002
    #
2003
    if ( PackageEntry::Exists( $name, $version ) )
2004
    {
261 dpurdie 2005
        Log( "Duplicate Package: $name, $version. Duplicate entry ignored" );
227 dpurdie 2006
        return;
2007
    }
2008
 
2009
    if ( $Cache && $::GBE_DPKG_CACHE )
2010
    {
2011
        my $mode = ($Cache > 1) ? "-refresh" : "";
261 dpurdie 2012
        Log( "BuildPkgArchive . $name ($version) Update Cache" );
227 dpurdie 2013
        System('--NoExit', "$::GBE_PERL $::GBE_TOOLS/cache_dpkg.pl $mode -quiet $name/$version" );
2014
    }
2015
 
2016
    #
2017
    #   Locate the package
2018
    #   Use the first instance of the package that it found
2019
    #
261 dpurdie 2020
    Log( "BuildPkgArchive . $name ($version)" );
227 dpurdie 2021
    my ( $pkg, $local ) = PackageLocate( $name, $version );
2022
    if ( $pkg )
2023
    {
2024
        #
2025
        #   Create a Package Entry
2026
        #
331 dpurdie 2027
        my $entry = PackageEntry::New( $pkg, $name, $version, 0, 'build', $local );
227 dpurdie 2028
 
2029
        #
2030
        #   Determine if the package needs to be installed:
2031
        #       If the package is a 'local' package then force transfer
2032
        #       If the user has specified --cache then force transfer
2033
        #       If package is newer that copy, then force transfer
2034
        #       If copy does not exist, then force a transfer
2035
        #
2036
        my $tag_dir = "$Cwd/$BUILDINTERFACE/BuildTags";
2037
        my $tag_file = "$tag_dir/${name}_${version}.tag";
2038
 
2039
        my $package_installed;
2040
        $package_installed = 1
2041
            if ( !$local &&
2042
                 !$Cache &&
2043
                 !FileIsNewer( $entry->GetBaseDir('descpkg'), $tag_file ) );
2044
 
2045
        #
2046
        #   Determine the package format and use the appropriate installer
2047
        #   Supported formats
2048
        #       1) Package has a descpkg file (new style)
2049
        #       2) Package has a InstallPkg.sh file (old style)
2050
        #       3) Package has a Install.sh file (old style is it used ??)
2051
        #
2052
        if ( $package_installed ) {
2053
            Verbose ("Package already installed: $name, $version");
2054
 
2055
        } else {
261 dpurdie 2056
            Log( "                . installing '$pkg'" );
2057
            Log( "                . -> " . readlink($pkg) ) if ( -l $pkg );
227 dpurdie 2058
 
2059
            if ( -e "$pkg/descpkg" )
2060
            {
2061
 
2062
                #
2063
                #   If forcing a BuildPkg, then don't use symlinks
2064
                #   to files in dpkg_archive
2065
                #
331 dpurdie 2066
                my @opts;
2067
                push @opts, "--NoSymlinks" if ( $ForceBuildPkg );
2068
                push @opts, "--AllowOverWrite" if ( $local );
227 dpurdie 2069
 
2070
                #
2071
                #   Determine all the Platforms, Products and Targets
2072
                #   that need to be installed
2073
                #
2074
                my $arglist = GenerateInstallArgumentList();
331 dpurdie 2075
                System( "cd $pkg; $::GBE_PERL $::GBE_TOOLS/installpkg.pl $Cwd/$BUILDINTERFACE $Cwd @opts $arglist");
227 dpurdie 2076
                Error( "Package installation error" ) if ( $? != 0 );
2077
            }
2078
            elsif ( -e "$pkg/InstallPkg.sh" )
2079
            {
2080
                System( "(cd $pkg; ./InstallPkg.sh $Cwd/$BUILDINTERFACE $Cwd)" );
2081
            }
2082
            elsif ( -e "$pkg/Install.sh" )
2083
            {
2084
                System( "(cd $pkg; ./Install.sh $Cwd/$BUILDINTERFACE $Cwd)" );
2085
            }
2086
            else
2087
            {
2088
                Error ("Unknown package format for package $name/$version found in $pkg");
2089
            }
2090
 
2091
            #
2092
            #   Tag the package as installed - after it has been transferred
2093
            #
2094
            mkdir ( $tag_dir );
2095
            TouchFile( $tag_file );
2096
        }
2097
 
2098
        #
2099
        #   Process package
2100
        #
2101
        IncludePkg ( $name, $pkg );
2102
 
2103
        #
2104
        #   Complete the creation of the package entry
2105
        #   Add the information for all platforms
2106
        #
2107
        $entry->Cleanup();
2108
        for my $platform (@BUILD_ACTIVEPLATFORMS)
2109
        {
2110
            $entry->ExamineToolPath();
2111
            $entry->ExamineThxPath($platform);
2112
            push ( @{$PKGRULES{$platform}}, $entry );
2113
        }
2114
    }
2115
}
2116
 
2117
#-------------------------------------------------------------------------------
311 dpurdie 2118
# Function        : CreateInterfacePackage
2119
#
2120
# Description     : Create a dummy package entry to describe the Interface
2121
#                   This is done AFTER all the BuildPkgArchive directives have
2122
#                   been processed so that the interface directory is fully
2123
#                   processed
2124
#
2125
# Inputs          : None
2126
#
2127
# Returns         : 
2128
#
2129
sub CreateInterfacePackage
2130
{
2131
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
2132
    {
2133
        my $entry = PackageEntry::Interface( "$::Cwd/$BUILDINTERFACE" );
2134
 
2135
        #
2136
        #   Locate include and lib bits within the interface
2137
        #   This is much simpler than for a LinkPkgArchive as the form
2138
        #   has been sanitized
2139
        #
2140
        my $parts = $BUILDINFO{$platform}{PARTS};
2141
 
2142
        foreach my $part ( @$parts )
2143
        {
2144
            $entry->RuleInc( "/include/" . $part );
2145
        }
2146
        $entry->RuleInc( "/include" );
2147
 
2148
        foreach my $part ( @$parts )
2149
        {
2150
            $entry->RuleLib("/lib/" . $part );
2151
        }
2152
 
2153
        $entry->ExamineToolPath();
2154
        $entry->ExamineThxPath($platform);
2155
        $entry->Cleanup();
2156
 
2157
        #
2158
        #   Add the package entry to the array of such entries for
2159
        #   the current platform. Force it to be the first one as
2160
        #   the interface directory will be scanned first
2161
        #
2162
        unshift ( @{$PKGRULES{$platform}}, $entry );
2163
    }
2164
}
2165
 
2166
#-------------------------------------------------------------------------------
227 dpurdie 2167
# Function        : GenerateInstallArgumentList
2168
#
2169
# Description     : Generate an argument list for the installpkg.pl script
2170
#                   The argument list is of the form
2171
#                       --Platform:xx[:xx[:xx]] --Platform:yy[:yy[:yy]] ...
2172
#                   Where xx is:
2173
#                       * a 'part' of the target platform
2174
#                         Order is: platform, product, ...  target( in that order )
2175
#                       * --Option[=yyy]
2176
#                        An option to be passed to the script. These are bound only
2177
#                        to the enclosed platform.
2178
# Inputs          :
2179
#
2180
# Returns         : See above
2181
#
2182
sub GenerateInstallArgumentList
2183
{
2184
    my @arglist;
2185
 
2186
    #
2187
    #   Generate the argument list as an array
2188
    #
2189
    for (@BUILD_ACTIVEPLATFORMS)
2190
    {
2191
        my @args = '--Platform';
2192
        push @args, @{$BUILDINFO{$_}{PARTS}};
2193
        push @arglist, join (":" , @args );
2194
    }
2195
 
2196
    return "@arglist";
2197
}
2198
 
2199
#-------------------------------------------------------------------------------
2200
# Function        : GeneratePlatformList
2201
#
2202
# Description     : Return a list of platforms that should particiate in this
2203
#                   build. This is a function of
2204
#                       1) Platforms defined in the build.pl file
2205
#                       2) User filter defined in GBE_BUILDFILTER
2206
#
2207
#                   The primary use of this function is to limit the creation
2208
#                   of makefiles to those that have supported compilers on
2209
#                   the underlying machine.
2210
#
2211
#                   GBE_BUILDFILTER is a space seperated string of words
2212
#                   Each word may be one of
2213
#                       OPTION=TAG or OPTION=!TAG
2214
#                       TAG or !TAG. This is the same as --TARGET=TAG
2215
#
2216
#                   Bare tags are taken to be TARGETS.
2217
#
2218
#                   Where OPTION may be one of
2219
#                       --PLATFORM
2220
#                       --PRODUCT
2221
#                       --TARGET
2222
#
2223
#                   Special cases
2224
#                   1) If GBE_BUILDFILTER is empty, then all available platforms are used
2225
#                      The global $All is set, then all available platforms are used
2226
#                   2) If the first word of GBE_BUILDFILTER is a negative filter,
2227
#                      ie is used the !xxxx or yyy=!xxxx construct, then it is assumed
2228
#                      that the filter will start with all available platforms
2229
#                   3) The special word --ALL forces selection of ALL platforms
2230
#                      and may reset any existing scanning
2231
#                   4) GBE_BUILDFILTER is parsed left to right. It is possible to add and
2232
#                      subtract items from the list.
2233
#                   5) OPTIONS are case insensitive
2234
#                      TAGS are case sensitive
2235
#
2236
#
2237
# Inputs          : GBE_BUILDFILTER from the environment
2238
#
2239
# Returns         : An array of platforms to include in the build
2240
#                   Maintains @BUILD_ACTIVEPLATFORMS  - the last calculated result
2241
#                   Ensures that @DEFBUILDPLATFORMS is a subset of @BUILD_ACTIVEPLATFORMS
2242
#
2243
sub GeneratePlatformList
2244
{
2245
    #
2246
    #   Return the cached result for speed
2247
    #   The value need only be calculated once
2248
    #
2931 dpurdie 2249
    unless ( @BUILD_ACTIVEPLATFORMS )
227 dpurdie 2250
    {
2251
        my ($platform_filter);
2252
        my %result;
2253
        my %part_to_platform;
2254
 
2255
        #
2256
        #   Create a data structure to assist in the production of the platform list
2257
        #   The structure will be a hash of hashes of arrays
2258
        #
2259
        #   The first level hash will be keyed by the word TARGET, PRODUCT or PLATFORM
2260
        #   The second level of the hash will keyed by available targets, products or platforms
2261
        #   The value of the field will be an array of platforms that match the keyword
2262
        #
2263
        for my $platform (keys (%::BUILDINFO))
2264
        {
2265
            my $pParts = $::BUILDINFO{$platform};
2266
 
2267
            #
2268
            #   Skip platforms that are known to be unavailable on this build
2269
            #   machine. Self configure
2270
            #
2271
            next if ( $pParts->{NOT_AVAILABLE} );
2272
 
2273
            my $target  = $pParts->{TARGET};
2274
            my $product = $pParts->{PRODUCT};
2275
 
2276
            push @{$part_to_platform{'PLATFORM'}{$platform}}, $platform;
2277
            push @{$part_to_platform{'TARGET'}  {$target}}  , $platform;
2278
            push @{$part_to_platform{'PRODUCT'} {$product}} , $platform;
2279
        }
2280
        #
2281
        #   Determine the source of the filter
2282
        #   If the user provides one, then use it.
2283
        #   Otherwise its taken from the environment.
2284
        #
2285
        #   Global build all platforms - Kill any user filter
2286
        #
2287
        if ( $All )
2288
        {
2289
            $platform_filter = "";
2290
        }
2291
        else
2292
        {
2293
            $platform_filter = "";
2294
            $platform_filter = $::GBE_BUILDFILTER
2295
                if ( defined($::GBE_BUILDFILTER) );
2296
        }
2297
        Debug( "GeneratePlatformList: Filter:$platform_filter" );
2298
 
2299
        #
2300
        #   Detect the special cases
2301
        #       1) No user definition - assume all platforms
2302
        #       2) First word contains a subtractive element
2303
        #
2304
        my (@filter) = split( ' ', $platform_filter );
2305
 
2306
        if ( !scalar @filter || $filter[0] =~ m/^$/ || $filter[0] =~ m/!/ )
2307
        {
2308
            %result = %{$part_to_platform{'PLATFORM'}}
2309
                if exists $part_to_platform{'PLATFORM'} ;
2310
        }
2311
#DebugDumpData( "PartToPlatform", \%part_to_platform );
2312
 
2313
        #
2314
        #   Process each element in the user filter list
2315
        #   Expand platforms into known aliases
2316
        #
2317
        for my $word (@filter)
2318
        {
2319
            my $platform;
2320
 
2321
            if ( $word =~ m/^--ALL/i )
2322
            {
2323
                %result = %{$part_to_platform{'PLATFORM'}};
2324
            }
2325
            elsif ( $word =~ m/^--(TARGET)=(!?)(.*)/i ||
2326
                    $word =~ m/^--(PRODUCT)=(!?)(.*)/i ||
2327
                    $word =~ m/^--(PLATFORM)=(!?)(.*)/i ||
2328
                    ( $word !~ m/^-/ && $word =~ m/()(!?)(.*)/ )
2329
                )
2330
            {
2331
                my $table = uc($1);
2332
                $table = "TARGET"
2333
                    unless ( $1 );
2334
 
2335
                #
2336
                #   Expand PLATFORMs into known aliases
2337
                #   Alias will expand to PLATFORMs so it won't work unless we are
2338
                #   processing PALTFORMs.
2339
                #
2340
                my @taglist = ( $table eq "PLATFORM" ) ? ExpandPlatforms($3) : $3;
2341
 
2342
                #
2343
                #   Add / Remove items from the result
2344
                #
2345
                for my $item ( @taglist )
2346
                {
2347
                    my $plist = $part_to_platform{$table}{$item};
2348
                    for ( @{$plist})
2349
                    {
2350
                        if ( $2 )
2351
                        {
2352
                            delete $result{$_};
2353
                        }
2354
                        else
2355
                        {
2356
                            $result{$_} = 1;
2357
                        }
2358
                    }
2359
                }
2360
            }
2361
            else
2362
            {
2363
                print "GBE_BUILDFILTER filter term not understood: $word\n";
2364
            }
2365
        }
2366
 
2367
        #
2368
        #   Return an array of platforms to process
2369
        #
2370
        @BUILD_ACTIVEPLATFORMS = sort keys %result;
2371
 
2372
        #
2373
        #   Ensure that DEFBUILDPLATFORMS is a subset of build active platforms
2374
        #
2375
        my @NEW_DEFBUILDPLATFORMS;
2376
        foreach ( @DEFBUILDPLATFORMS )
2377
        {
2378
            push @NEW_DEFBUILDPLATFORMS, $_
2379
                if ( exists $result{$_} );
2380
        }
2381
        @DEFBUILDPLATFORMS = @NEW_DEFBUILDPLATFORMS;
2382
    }
2383
 
2384
    Debug("GeneratePlatformList: Result:@BUILD_ACTIVEPLATFORMS");
2385
    return @BUILD_ACTIVEPLATFORMS;
2386
}
2387
 
2388
#-------------------------------------------------------------------------------
2389
# Function        : PrintPlatforms
2390
#
2391
# Description     : Petty print the specified platform list, breaking line
2392
#                   on either a primary key change or length width >78.
2393
#
2394
# Returns         : Formated string
2395
#
2396
# Example Output :
2397
#
2398
#           DDU_LMOS_WIN32 DDU_LMOS_linux_armv4 DDU_LMOS_linux_i386
2399
#           IDFC_LMOS_WIN32 IDFC_LMOS_linux_armv4 IDFC_LMOS_linux_i386
2400
#           LMOS_WCEPSPC_ARM LMOS_WCEPSPC_EMU LMOS_WIN32 LMOS_linux_armv4
2401
#           LMOS_linux_i386
2402
#..
2403
sub PrintPlatforms
2404
{
2405
    my ($platforms, $nl) = @_;
2406
    my ($string) = "";                          # result
2407
 
2931 dpurdie 2408
    if ( @$platforms )
227 dpurdie 2409
    {
2410
        my ($key_run) = 0;
2411
        my ($pkey);                             # previous key
2412
 
2413
        #   Perform a simple formatting and determine if there is key 
2414
        #   change greater then 1 or whether the total length exceeds 78.
2415
        #
2416
        #   If the line exceeds 78, the printer shall then reformat 
2417
        #   breaking based on line length and possiblity keys.
2418
        #
2419
        $pkey = "";
2420
        for my $k (sort @$platforms) 
2421
        {
2422
            my ($d);                            # delimitor
2423
 
2424
            if (($d = index( $k, '_' )) != index( $pkey, '_' ) ||
2425
                    substr( $k, 0, $d ) ne substr( $pkey, 0, $d )) {
2426
                $key_run = 1
2427
                    if ($key_run <= 1);         # change, reset run if <= 1
2428
            } else {
2429
                $key_run++;                     # same primary key
2430
            }
2431
 
2432
            $string .= " " if ($pkey);
2433
            $string .= $k;
2434
            $pkey = $k;
2435
        }
2436
 
2437
        #   Reprint if required.
2438
        #
2439
        if (length($nl)+length($string) > 78)
2440
        {
2441
            my ($llen);                         # line length
2442
 
2443
            $llen = length($nl);
2444
 
2445
            $pkey = "";
2446
            $string = "";
2447
 
2448
            for my $k (sort @$platforms)
2449
            {
2450
                my ($klen, $d);                 # key length, delimitor
2451
 
2452
                $klen = length($k);
2453
                if ($pkey ne "")
2454
                {
2455
                    if ($llen + $klen > 78 ||
2456
                        ($key_run > 1 && (
2457
                            ($d = index( $k, '_' )) != index( $pkey, '_' ) ||
2458
                            substr( $k, 0, $d ) ne substr( $pkey, 0, $d ) )) )
2459
                    {                           # line >70 or key change
2460
                        $string .= $nl;
2461
                        $llen = length($nl);
2462
                    }
2463
                    else
2464
                    {
2465
                        $string .= " ";
2466
                        $llen++;
2467
                    }
2468
                }
2469
                $string .= $k;
2470
                $pkey = $k;
2471
                $llen += $klen;
2472
            }
2473
        }    
2474
    }
2475
    return $string;
2476
}
241 dpurdie 2477
#-------------------------------------------------------------------------------
2478
# Function        : PrintList
2479
#
2480
# Description     : Pretty format an array to fit within 80 char line
2481
#                   Perform wrapping as required
2482
#
2483
# Inputs          : $list           - Reference to an array
2484
#                   $nl             - New line stuff.
2485
#                                     Use to prefix new lines
2486
#
2487
# Returns         : string
2488
#
2489
sub PrintList
2490
{
2491
    my ($list, $nl) = @_;
2492
    my ($string) = '';                          # result
2493
    my $sep;
227 dpurdie 2494
 
241 dpurdie 2495
    if ( @$list )
2496
    {
2497
        my ($llen) = length($nl);
227 dpurdie 2498
 
241 dpurdie 2499
        for my $k (@$list)
2500
        {
2501
            my $klen = length($k);
2502
            if ($llen + $klen > 78 )
2503
            {
2504
                $string .= $nl;
2505
                $llen = length($nl);
2506
            }
2507
            else
2508
            {
2509
                if ( $sep )
2510
                {
2511
                    $string .= $sep;
2512
                    $llen++;
2513
                }
2514
                else
2515
                {
2516
                    $sep = ' ';
2517
                }
2518
            }
2519
            $string .= $k;
2520
            $llen += $klen;
2521
        }
2522
    }
2523
    return $string;
2524
}
2525
 
305 dpurdie 2526
#-------------------------------------------------------------------------------
2527
# Function        : BuildReleaseFile
2528
#
2529
# Description     : Legacy function
2530
#                   Don't know what it was meant to do
2531
#                   Unfortunately it is present in a lot of build.pl files
2532
#
2533
#                   Not well supported on all machine types
2534
#
331 dpurdie 2535
# Inputs          : None that are used
305 dpurdie 2536
#
331 dpurdie 2537
# Returns         : Undefined
305 dpurdie 2538
#
227 dpurdie 2539
sub BuildReleaseFile
2540
{
2541
}
2542
 
305 dpurdie 2543
#-------------------------------------------------------------------------------
2544
# Function        : BuildSnapshot
2545
#
2546
# Description     : Legacy function
2547
#                   Don't know what it was meant to do
2548
#                   Unfortunately it is present in a lot of build.pl files
2549
#
2550
# Inputs          : None that are used
2551
#
2552
# Returns         : Undefined
2553
#
227 dpurdie 2554
sub BuildSnapshot
2555
{
2556
}
2557
 
305 dpurdie 2558
#-------------------------------------------------------------------------------
2559
# Function        : BuildSrcArchive
2560
#
2561
# Description     : Create a source snapshot of the build source
2562
#                   Designed to provide a source image for packaging
2563
#                   examples
2564
#
2565
#                   Should be platform independent
2566
#
2567
#                   Creates an archive file and places it into the
2568
#                   interface directory. The archive will be packaged
2569
#                   automatically by the build process
2570
#
2571
#                   Use the 'pax' utility
2572
#                       1) Can massage the file path such that the stored
2573
#                          directory image contains the package name and version
2574
#
2575
#                   Directive can be used at any time before the BuildMake
2576
#
2577
#                   Will handle the existence of an auto.pl file by inserting
2578
#                   it as build.pl.
2579
#
2580
# Inputs          : Options
2581
#
2582
#
2583
# Returns         : 
2584
#
2585
sub BuildSrcArchive
2586
{
2587
    #
2588
    #   If we are clobbering, then there is nothing to do
2589
    #   The generated file is placed within the interface
2590
    #   directory and that directory will be deleted during the clobber
2591
    #
2592
    return if ( $Clobber );
2593
    DataDirective("BuildSrcArchive");
227 dpurdie 2594
 
305 dpurdie 2595
    #
2596
    #   Currently this operation is only supported of some platforms
2597
    #   Only supported on Unix platforms
2598
    #   Uses the 'pax' utility
2599
    #
2600
    unless ( LocateProgInPath ( 'pax', '--All' ) && ( $ScmHost eq "Unix" ) )
2601
    {
2602
        Log( "SrcPackage . Not supported" );
2603
        return;
2604
    }
2605
 
2606
    #
2607
    #   Only allow one instance of the directive
2608
    #
2609
    Error ("Multiple BuildSrcArchive directives not supported")
2610
        if ( $build_source_pkg );
2611
 
2612
    #
2613
    #   Create the name of the archive
2614
    #       Based on the package name and version
2615
    #       Has no spaces
2616
    #
2617
    my $build_name = $BUILDNAME;
2618
    $build_name =~ s~\s+~_~g;
2619
 
2620
    #
2621
    #   Create the archive in the interface directory
2622
    #   Don't need to clobber it as the entire interface directory
2623
    #   will be clobbered
2624
    #
2625
    $build_source_pkg = $build_name;
2626
}
2627
 
2628
#-------------------------------------------------------------------------------
2629
# Function        : BuildSrcArchiveBody
227 dpurdie 2630
#
305 dpurdie 2631
# Description     : Function to implement the body of the BuildSrcArchive
2632
#                   operation. Will be invoked during BuildMake
2633
#
2634
# Inputs          : None
2635
#
2636
# Returns         : 
2637
#
2638
sub BuildSrcArchiveBody
2639
{
2640
    return unless ( $build_source_pkg );
2641
 
2642
    my $archive_dir = "pkg/$BUILDNAME_PACKAGE/src";
2643
    my $archive_file = "$build_source_pkg" . '.tar';
2644
 
2645
    Log( "SrcPackage . $archive_file.gz" );
2646
    unlink "$archive_dir/$archive_file";
2647
    unlink "$archive_dir/$archive_file.gz";
2648
    mkpath($archive_dir, 0, 0775);
2649
 
2650
    #
2651
    #   Create a list of files and top-level dirs to add to source archive
2652
    #   Many files are ignored
2653
    #   Should only be executed on the first 'build' thus many internal
2654
    #   directories will not be present
2655
    #
2656
    my @flist;
2657
    my $auto_pl;
2658
    opendir (my $tp, '.' ) or Error ("Cannot read current directory");
2659
    while ( $_ = readdir($tp) )
2660
    {
2661
        next if ( m/^\.$/ );
2662
        next if ( m'^\.\.$' );
2663
        next if ( m'^build\.log$' );
2664
        next if ( m'\.gbe$' );
2665
        next if ( m'^local$' );
2666
        next if ( m'^pkg$' );
2667
        next if ( m/^$BUILDINTERFACE$/ );
2668
        $auto_pl = 1, next  if ( m'^auto\.pl$' );
2669
        next if (  m'^build\.pl$' );
2670
        next if ( m/^$build_source_pkg$/ );
2671
        push @flist, $_;
2672
    }
2673
    closedir $tp;
2674
 
2675
    #
2676
    #   If we don't have an auto.pl, then we add the build.pl file
2677
    #   If we do have a auto.pl - it gets tricky. Its don't after the
2678
    #   initial pax command
2679
    #
2680
    unless ( $auto_pl )
2681
    {
2682
        push @flist, 'build.pl';
2683
    }
2684
 
2685
    #
2686
    #   Create the command to be executed
2687
    #   Prefix archive paths with build_name
2688
    #
2689
    my @command = ( 'pax', '-w', '-f', "$archive_dir/$archive_file" );
2690
    System( '--NoShell' , @command, '-s', "~^~$build_source_pkg/~", @flist );
2691
 
2692
    #
2693
    #   If we have an auto.pl file, then we need to add it to the archive
2694
    #   but it needs to be called build.pl
2695
    #
2696
    if ( $auto_pl )
2697
    {
2698
        System( '--NoShell' , @command, '-a', '-s', "~^auto.pl~$build_source_pkg/build.pl~" , 'auto.pl' );
2699
    }
2700
 
2701
    #
2702
    #   Must now zip the file
2703
    #   Can't zip and append at the same time
2704
    #
2705
    System( '--NoShell' , 'gzip', "$archive_dir/$archive_file" );
2706
 
2707
    #
2708
    #   Display the results
2709
    #
2710
    System ('--NoShell', 'pax', '-z', "-f$archive_dir/$archive_file.gz")
2711
        if (IsVerbose (1));
2712
}
2713
 
2714
#-------------------------------------------------------------------------------
2715
# Function        : BuildAccessPerms
2716
#
2717
# Description     : Check if access/permissions setting requested...
2718
#                   Legacy
2719
#
331 dpurdie 2720
#                   Don't know what it was meant to do
2721
#                   Unfortunately it is present in a lot of build.pl files
305 dpurdie 2722
#
331 dpurdie 2723
# Inputs          : None that are used
305 dpurdie 2724
#
331 dpurdie 2725
# Returns         : Undefined
2726
#
227 dpurdie 2727
sub BuildAccessPerms
2728
{
2729
}
2730
 
2731
 
2732
sub BuildSetenv
2733
{
2734
    push( @BUILDSETENV, @_ );
2735
}
2736
 
2737
#-------------------------------------------------------------------------------
2738
# Function        : DataDirective
2739
#
2740
# Description     : Called by data collection directives to ensure that we are
2741
#                   still collecting data and that we have collected other data
2742
#
2743
# Inputs          : $dname              - Directive Name
2744
#
2745
# Returns         : Will error if we are not
2746
#
2747
sub DataDirective
2748
{
2749
    my ($dname) = @_;
2750
 
2751
    Error( "$dname() must appear after BuildName()...")
2752
        if ( $BUILDNAME eq "" );
2753
 
2754
    Error( "$dname() must appear after BuildInterface()...")
2755
        unless( $BUILDINTERFACE );
2756
 
2757
    Error( "$dname() not allowed after BuildDescpkg, BuildIncpkg, BuildVersion or BuildMake")
2758
        if( $BUILDPHASE);
2759
}
2760
 
2761
#-------------------------------------------------------------------------------
2762
# Function        : StartBuildPhase
2763
#
2764
# Description     : Called by directives that deal with the building phases
2765
#                   to perform common initialisation and to ensure that
2766
#                   directives that collect data are no longer called
2767
#
305 dpurdie 2768
# Inputs          : last                - True: Last directive expected
227 dpurdie 2769
#
2770
# Returns         : May generate an error
2771
#
2772
sub StartBuildPhase
2773
{
305 dpurdie 2774
    my ($last) = @_;
2775
 
227 dpurdie 2776
    #
305 dpurdie 2777
    #   Ensure directive is allowed
2778
    #       $BUILDPHASE >  1     - No more directives allowed
2779
    #       $BUILDPHASE == 1     - Allowed directive
2780
    #
2781
    if ( $BUILDPHASE > 1 )
2782
    {
2783
        my $function = (caller(1))[3];
2784
        $function =~ s~.*::~~;
2785
        Error ("Directive not allowed: $function","'BuildMake' must be the last directive in the build file");
2786
    }
2787
 
2788
    #
227 dpurdie 2789
    #   Only do it once
2790
    #
305 dpurdie 2791
    return if ( $BUILDPHASE  );
2792
    $BUILDPHASE = 1;
227 dpurdie 2793
 
2794
    #
341 dpurdie 2795
    #   If we are not performing a ForceBuild, then we don't need to continue
2796
    #   We have updated the interface directory with BuildPkgArchive
2797
    #   information.
2798
    #
2799
    TestForForcedBuild();
2800
 
2801
    #
227 dpurdie 2802
    #   Calcuate the aliases that are being extracted from targets
2803
    #
2804
    Process_TargetAlias();
2805
 
2806
    #
4728 dpurdie 2807
    #   Calculate NATIVE alaias
2808
    #   Limit the Native Alias to active platforms
2809
    #
2810
    if (exists $BUILDALIAS{NATIVE})
2811
    {
2812
        Warning('User has manually specified a NATIVE alias','Default alias will not be set.');
2813
    }
2814
    else
2815
    {
2816
        my %activePatformMap = map {$_ => 1} @BUILD_ACTIVEPLATFORMS;
2817
        my @activeNatives;
2818
        foreach my $item (PlatformConfig::getNativeTargets())
2819
        {
2820
            push (@activeNatives, $item) if exists($activePatformMap{$item});
2821
        }
2822
 
2823
        $BUILDALIAS{NATIVE} = join(' ', @activeNatives);
2824
    }
2825
 
2826
    #
311 dpurdie 2827
    #   Create dummy package to describe the Interface directory
2828
    #
2829
    CreateInterfacePackage();
2830
 
2831
    #
227 dpurdie 2832
    #   Sanity test the users packages
2833
    #
2834
    PackageEntry::SanityTest() unless $Clobber;
2835
 
2836
    #
2837
    #   Validate the $Srcdir before its first real use
2838
    #   This is calculated from the user directives
2839
    #
2840
 
2841
    #.. Determine default "source" root
2842
    #
2843
    if ( $Srcdir eq "" )
2844
    {
2845
        Warning( "Both the directories 'src' and 'SRC' exist ....." )
2846
            if ( $ScmHost eq "Unix" && -e "src" && -e "SRC" );
2847
 
2848
        if ( -e "src" ) {
2849
            $Srcdir = "src";
2850
        } else {
2851
            ( -e "SRC" ) ||
2852
                Error( "Neither the directory 'src' nor 'SRC' exist ....." );
2853
            $Srcdir = "SRC";
2854
        }
2855
    }
2856
 
2857
    #
2858
    #   Must have a valid Srcdir
2859
    #
2860
    Error ("Source directory not found: $Srcdir")
2861
        unless ( $Srcdir && -d $Srcdir );
2862
 
305 dpurdie 2863
    #
2864
    #   Create source package
2865
    #
2866
    BuildSrcArchiveBody();
2867
 
227 dpurdie 2868
    return $Srcdir;
2869
}
2870
 
2871
#-------------------------------------------------------------------------------
341 dpurdie 2872
# Function        : TestForForcedBuild
2873
#
2874
# Description     : If a non-forced build has been requested, then see
2875
#                   if a build is required ( ie: build.pl modified )
2876
#
2877
#
2878
# Inputs          : None
2879
#
2880
# Returns         : May not return
2881
#
2882
sub TestForForcedBuild
2883
{
2884
    #
2885
    #   Always return if in clobber mode
2886
    #
2887
    return if ( $Clobber );
2888
 
2889
    if ( ! $ForceBuild  )
2890
    {
2891
        my @build_warn;
2892
        my $bstamp = -M "$Cwd/$ScmBuildSrc";
2893
        my $tstamp = -M "$Cwd/Makefile.gbe";
2894
 
2895
        push @build_warn, "Missing: Makefile.gbe" unless ( defined $tstamp );
2896
        push @build_warn, "Modified build file ($ScmBuildSrc)" if ( $tstamp && $bstamp < $tstamp );
2897
 
363 dpurdie 2898
        #
2899
        #   Ensure that the build filter has not changed
2900
        #   If the user has changed the buildfilter, then we need to
2901
        #   force a build.
2902
        #
2903
        #   The root Makefile.bge will have a $ScmBuildFilter entry
2904
        #
2905
        unless ( @build_warn )
2906
        {
2907
            use JatsMakeInfo;
2908
            ReadMakeInfo();
2909
                my $line = $::ScmBuildFilter || '';
2910
                $line =~ s~\s+~ ~g;
2911
 
2912
                my $filter = $::GBE_BUILDFILTER;
2913
                $filter =~ s~\s+~ ~g;
2914
                if ( $line ne $filter )
2915
                {
2916
                    push @build_warn, "Build filter has changed";
2917
                    Verbose2 ("Buildfilter Test: Was:$line, Is:$::GBE_BUILDFILTER");
2918
                }
2919
        }
2920
 
341 dpurdie 2921
        if ( @build_warn )
2922
        {
363 dpurdie 2923
            Verbose ("Forcing Build.", @build_warn );
341 dpurdie 2924
        }
2925
        else
2926
        {
2927
            Verbose ("No build performed. Build files up to date");
2928
            Log ("Build files up to date") if $::GBE_SANDBOX;
2929
            exit 0;
2930
        }
2931
    }
2932
}
2933
 
2934
#-------------------------------------------------------------------------------
305 dpurdie 2935
# Function        : LastBuildDirective
2936
#
2937
# Description     : No more build directives allowed
2938
#
2939
# Inputs          : 
2940
#
2941
# Returns         : 
2942
#
2943
sub LastBuildDirective
2944
{
2945
    $BUILDPHASE = 2;
2946
}
2947
 
2948
#-------------------------------------------------------------------------------
227 dpurdie 2949
# Function        : BuildPackageLink
2950
#
2951
# Description     : Create a soft link from sandbox_dpkg_archive to the package
2952
#                   being created by this build
2953
#
2954
#                   For backward compatability.
2955
#                   If GBE_DPKG_SBOX is not defined, then use GBE_DPKG_LOCAL
2956
#
2957
#                   This will allow multiple components to work together
2958
#
2959
#                   Note: When called in Clobber-mode the link will be deleted
2960
#
2961
# Inputs          : $BUILDNAME              - The package name
2962
#                   $BUILDNAME_PROJECT      - Project extension
2963
#                   $::GBE_DPKG_SBOX        - Path of sandbox_dpkg_archive
2964
#                   $::GBE_DPKG_LOCAL       - Path of local_dpkg_archive
2965
#                   $::GBE_DPKG             - Main repository
2966
#
2967
# Returns         : Nothing
2968
#
2969
sub BuildPackageLink
2970
{
2971
    my $target_archive;
2972
    my $target_archive_name;
2973
    my $link_file;
2974
    my $tag;
371 dpurdie 2975
    my $root_path;
227 dpurdie 2976
 
2977
    #
2978
    #   Determine the path (and name) of the target archive
2979
    #   Use sandbox_dpkg_archive if it exists
2980
    #   Use local_dpkg_acrhive for backward compatability (should be removed after JATS 2.64.2+)
2981
    #
2982
    if ( $target_archive = $::GBE_DPKG_SBOX )
2983
    {
2984
        $target_archive_name = "sandbox_dpkg_archive";
2985
        $tag = "Sandbox";
359 dpurdie 2986
        if ( $sandbox_exact )
2987
        {
2988
            $link_file = "$BUILDVERSION.lnk";
2989
        }
2990
        else
2991
        {
2992
            $link_file  = 'sandbox' . ${BUILDNAME_SUFFIX} . '.lnk';
2993
        }
371 dpurdie 2994
        $root_path = 'GBE_SANDBOX' . substr($Cwd, length($::GBE_SANDBOX));
2995
        Verbose2("Root Path: $::GBE_SANDBOX, $root_path");
227 dpurdie 2996
    }
2997
    elsif ( $target_archive = $::GBE_DPKG_LOCAL )
2998
    {
2999
        $target_archive_name = "local_dpkg_archive";
3000
        $link_file = "$BUILDVERSION.lnk";
3001
        $tag = "Local";
371 dpurdie 3002
        $root_path = $Cwd;
227 dpurdie 3003
    }
3004
    else
3005
    {
3006
        Verbose("Cannot locate local or sandbox archive")
3007
            unless $Clobber;
3008
        return;
3009
    }
3010
 
3011
    #
3012
    #   Santity test
3013
    #   Target must be a directory
3014
    #
3015
    unless ( -d $target_archive )
3016
    {
241 dpurdie 3017
        Warning("$target_archive_name is not a directory: $target_archive")
227 dpurdie 3018
            unless $Clobber;
3019
        return;
3020
    }
3021
 
3022
    my $link_dir = "$target_archive/$BUILDNAME_PACKAGE";
3023
    my $link_path = "$link_dir/$link_file";
3024
 
3025
    if ( $Clobber )
3026
    {
3027
        unlink $link_path;          # Delete the link
3028
        rmdir $link_dir;            # Delete only if empty
3029
    }
3030
    else
3031
    {
261 dpurdie 3032
        Log( "Local Link . $BUILDNAME_PACKAGE/$link_file ($tag)");
3033
        mkdir $link_dir unless -d $link_dir;
371 dpurdie 3034
        FileCreate ( $link_path, "$root_path/pkg/$BUILDNAME_PACKAGE");
227 dpurdie 3035
    }
3036
}
3037
 
3038
#-------------------------------------------------------------------------------
3039
# Function        : BuildSandboxData
3040
#
3041
# Description     : Create data structures to allow this package to be built
3042
#                   within a multi-package sandbox.
3043
#
3044
#                   This will allow multiple components to work together
3045
#
3046
#                   Note: When called in Clobber-mode the link will be deleted
3047
#
3048
# Inputs          : $BUILDNAME              - The package name
3049
#                   $BUILDNAME_PROJECT      - Project extension
3050
#                   $::GBE_DPKG_SBOX        - Path of sandbox_dpkg_archive
3051
#                   $::GBE_DPKG             - Main repository
3052
#
3053
# Returns         : Nothing
3054
#
3055
sub BuildSandboxData
3056
{
3057
    my $sandbox_dpkg_archive = $::GBE_DPKG_SBOX;
3058
    return unless ( $sandbox_dpkg_archive );
3059
 
3060
    unless ( -d $sandbox_dpkg_archive )
3061
    {
241 dpurdie 3062
        Error("sandbox_dpkg_archive is not a directory: $sandbox_dpkg_archive")
227 dpurdie 3063
            unless $Clobber;
3064
        return;
3065
    }
3066
 
3067
    #
3068
    #   Create a name for this package in the sandbox
3069
    #   Must use the package name and extension. Don't use the version
3070
    #   information as this will not be correct
3071
    #
3072
    #   PACKAGE/sandbox.PRJ.cfg
3073
    #
3074
    my $link_dir = "$sandbox_dpkg_archive/$BUILDNAME_PACKAGE";
359 dpurdie 3075
    my $link_file;
3076
 
3077
    if ( $sandbox_exact )
3078
    {
3079
        $link_file = "$BUILDVERSION.cfg";
3080
    }
3081
    else
3082
    {
3083
        $link_file  = 'sandbox' . ${BUILDNAME_SUFFIX} . '.cfg';
3084
    }
227 dpurdie 3085
    my $link_path = "$link_dir/$link_file";
3086
 
3087
    if ( $Clobber )
3088
    {
3089
        unlink $link_path;          # Delete the link
3090
        rmdir $link_dir;            # Delete only if empty
3091
    }
3092
    else
3093
    {
261 dpurdie 3094
        Log( "Sandbox cfg. $link_file");
227 dpurdie 3095
        unlink $link_path;
3096
        mkdir $link_dir;
3097
 
3098
        #
3099
        #   Create the sandbox config data structure
3100
        #
3101
        my %sandbox_info = (
3102
            BUILDDIR     => $Cwd,
3103
            INTERFACEDIR => $BUILDINTERFACE,
3104
            );
3105
 
3106
        #
3107
        #   Write out the Parsed Config File with new information
3108
        #
3109
        my $fh = ConfigurationFile::New( $link_path );
3110
        $fh->Header( "buildlib (version $::BuildVersion)",
3111
                                  "Sandbox configuration" );
3112
 
3113
        #
3114
        #   Dump out the configuration information
3115
        #
3116
        $fh->Dump( [\%sandbox_info], [qw(*sandbox_info)] );
3117
        $fh->Close();
3118
    }
3119
}
3120
 
3121
 
3122
#-------------------------------------------------------------------------------
3123
# Function        : BuildMake
3124
#
3125
# Description     : Generate the makefiles
3126
#                   This directive MUST be the last directive in the build.pl
3127
#                   file. The directive triggers the processing of all the
3128
#                   information that has been collected
3129
#
3130
#
3131
# Inputs          : None
3132
#
3133
# Returns         : Nothing
3134
#
3135
 
3136
sub BuildMake
3137
{
3138
    my( $argc, $platform );
3139
 
3140
    #
3141
    #   Must have a valid $BUILDINTERFACE
3142
    #   Normally this is held in the interface directory, but this is not
3143
    #   always created. If there is no $BUILDINTERFACE, then use the
3144
    #   build directory
3145
    #
3146
    $BUILDINTERFACE = "." unless ( $BUILDINTERFACE );
3147
 
3148
    #.. Starting the build phase. No more data collection
3149
    #
305 dpurdie 3150
    StartBuildPhase();
3151
    LastBuildDirective();
227 dpurdie 3152
 
5109 dpurdie 3153
    #
3154
    #   Now that the bulk of the information has been displayed
3155
    #   we can display captured messages. These warnings will be 
3156
    #   at the end of the log so that users can see them.
3157
    DumpCapture();
3158
 
227 dpurdie 3159
    sub DeleteCfg
3160
    {
3161
        #
3162
        #   Delete files that will be re-created
3163
        #   Some of these files are read and written.
3164
        #   Errors in the files are solved by deleting the files now.
3165
        #
3166
        unlink "$BUILDINTERFACE/build.cfg";
3167
        unlink "$BUILDINTERFACE/Makefile.cfg";
3168
        unlink glob ("$BUILDINTERFACE/Makefile*.cfg");
3169
        unlink "$BUILDINTERFACE/Buildfile.cfg";
3170
        unlink "$BUILDINTERFACE/Dpackage.cfg";
3171
    }
3172
 
3173
    if ( $Clobber )                             # clobber mode ?
3174
    {
4003 dpurdie 3175
        #
3176
        #   Read in toolset files - a list of files collected during
3177
        #   previous builds
3178
        #
3179
        ToolsetFile();
227 dpurdie 3180
 
4003 dpurdie 3181
        #
3182
        #   Unmake all the makefiles
3183
        #   No longer needed as we track the file that are created
3184
        #
3185
        #if ( -e "Makefile.gbe" )
3186
        #{
3187
        #    JatsTool ( 'jmake.pl', 'unmakefiles');
3188
        #}
3189
 
3190
        #
3191
        #   Delete my own configuration files
3192
        #
227 dpurdie 3193
        DeleteCfg();
3194
 
3195
        #
3196
        #   JATS creates a 'pkg' directory for the target package
3197
        #
3198
        push @CLOBBERDIRS, "pkg";
3199
 
3200
        #
3201
        #   Deployment creates a 'build/deploy' directory
375 dpurdie 3202
        #   The 'build' directory may contain user files - only remove if empty
227 dpurdie 3203
        #
3204
        push @CLOBBERDIRS, "build/deploy";
375 dpurdie 3205
        push @REMOVEDIRS, "build";
227 dpurdie 3206
 
3207
        #
3208
        #   Delete interface directories and other directories that have been
375 dpurdie 3209
        #   marked to be clobbered
227 dpurdie 3210
        #
3211
        foreach my $dir ( @CLOBBERDIRS )
3212
        {
3213
            next if ( $dir eq '.' );
3214
            next if ( $dir eq '..' );
3215
            if ( -d $dir )
3216
            {
361 dpurdie 3217
                RmDirTree ( $dir );
227 dpurdie 3218
            }
3219
        }
3220
 
375 dpurdie 3221
        foreach my $dir ( @REMOVEDIRS )
3222
        {
3223
            next if ( $dir eq '.' );
3224
            next if ( $dir eq '..' );
3225
            if ( -d $dir )
3226
            {
3227
                rmdir ( $dir ); # Only if empty
3228
            }
3229
        }
3230
 
4003 dpurdie 3231
        if ( exists $::GBE_TOOLSETFiles{Files} )
227 dpurdie 3232
        {
4007 dpurdie 3233
            foreach my $file (keys %{$::GBE_TOOLSETFiles{Files}})
227 dpurdie 3234
            {
4003 dpurdie 3235
                if ( -f $file )
3236
                {
3237
                    RmDirTree ( $file );
3238
                }
227 dpurdie 3239
            }
3240
        }
3241
 
3242
        #
3243
        #   DPACKAGE may be a user file, Only delete it if we created it
3244
        #
299 dpurdie 3245
        unlink "$Srcdir/DPACKAGE.$::GBE_MACHTYPE" if $DeleteDPACKAGE;
227 dpurdie 3246
 
3247
        BuildPackageLink();
3248
        BuildSandboxData();
3249
        return;
3250
    }
3251
 
3252
    #.. Build support files
3253
    #
3254
    DeleteCfg();
3255
    BuildConfig();
3256
    BuildSharedLibFiles();
3257
    WriteParsedBuildConfig();
3258
    BuildPackageLink();
3259
    BuildSandboxData();
4003 dpurdie 3260
    NoBuildMarker();
227 dpurdie 3261
 
3262
    #
3263
    #  ONLY (re)building interface dir
3264
    #
3265
    return
3266
        if ( $Interface );
3267
 
3268
    #---------------------------------------------------------------------------
3269
    #
3270
    #.. Make bootstrap "makefile",
3271
    #   Simulate a top level makefile
3272
    #       Pass argumenst to makelib
3273
    #       Sumulate SubDir() operations
3274
    #       Sumulate a Platform(*);
3275
    #
3276
    #       Due to the normal way that makelib.pl is executed,
3277
    #       the following substitutions are done.
3278
    #
3279
    @ARGV = ();
3280
    $0 = "makefile.pl ";
3281
    push @ARGV, "$Cwd";                         # current working directory
331 dpurdie 3282
    push @ARGV, "$::GBE_TOOLS/makelib.pl";     # makelib.pl image
227 dpurdie 3283
    push @ARGV, "--interface=$BUILDINTERFACE"
261 dpurdie 3284
        if ($BUILDINTERFACE);
227 dpurdie 3285
 
3286
    Debug( "ARGV:      @ARGV" );
3287
 
3288
    #.. (re)Build root makefile
3289
    #
3290
    $ScmBuildlib = 0;                           # clear Buildlib flag for 'makelib.pl'
3291
    RootMakefile();                             # inform 'makelib.pl'
3292
    MakeLibInit();                              # run initialisation
3293
 
3294
    #.. Register subdir(s)
3295
    #
3296
    UniquePush (\@BUILDSUBDIRS, $Srcdir );
3297
    SubDir( @BUILDSUBDIRS );
3298
    Platform( @BUILD_ACTIVEPLATFORMS );
3299
 
3300
    #.. (re)build src makefiles and associated information
367 dpurdie 3301
    #   JatsTool will not return on error
227 dpurdie 3302
    #
263 dpurdie 3303
    my @cmds = ('jmake.pl', 'rebuild');
227 dpurdie 3304
    push @cmds, 'NORECURSE=1' if ( $RootOnly );
263 dpurdie 3305
    JatsTool ( @cmds);
305 dpurdie 3306
 
3307
    #
3308
    #   Generate some warnings that will be seen at the end of the build
3309
    #
3310
    Warning ("BuildSrcArchive Directive Present","Read JATS Manual for correct usage")
3311
        if ($build_source_pkg);
227 dpurdie 3312
}
3313
 
3314
 
3315
#-------------------------------------------------------------------------------
3316
# Function        : BuildVersion
3317
#
3318
# Description     : Generate version.c and version.h files
3319
#
3320
# Inputs          : Options
3321
#                       --Prefix=prefix         Text prepended to variables created
3322
#                                               as a part of the "C" versions
3323
#                       --Type=type             Type of "C" style data
3324
#                                               Allowed types are: array
3325
#                       --Defs=name             Generate a "C" definitions file.
3326
#                                               This file simply contains definitions
3327
#                       --Defs                  Same as --Defs=defs
3328
#                       --Style=style           Output file style
3329
#                                               Supported styles:
3330
#                                                   "C" - Default
3331
#                                                   "CSharp"
3332
#                                                   "WinRC"
289 dpurdie 3333
#                                                   "Delphi"
315 dpurdie 3334
#                                                   "VB"
227 dpurdie 3335
#                       --File=name             Specifies the output file name
3336
#                                               Default is determined by the style
3337
#
3338
#                   Also allows for an 'old' style format in which
3339
#                   the first three arguments are prefix,type and defs
3340
# Returns         :
3341
#
3342
 
3343
sub BuildVersion
3344
{
3345
    my ( $Prefix, $Type, $Mode ) = @_;
3346
    my $ModePrefix;
3347
    my $Style = "C";
3348
    my $FileName;
3349
    my $VersionFiles;
267 dpurdie 3350
    my @opts;
3351
    my $supports_opts;
227 dpurdie 3352
 
3353
    StartBuildPhase();                          # Starting the build phase. No more data collection
3354
 
279 dpurdie 3355
    if ( defined($Prefix) && $Prefix =~ /^-/ )
227 dpurdie 3356
    {
3357
        $Prefix = undef;
3358
        $Type = undef;
3359
        $Mode = undef;
3360
        foreach  ( @_ )
3361
        {
3362
            if (      /^--Prefix=(.*)/ ) {
3363
                $Prefix = $1;
3364
                $VersionFiles = 1;
3365
 
3366
            } elsif ( /^--Type=(.*)/ ) {
3367
                $Type = $1;
3368
                $VersionFiles = 1;
3369
 
3370
            } elsif ( /^--Defs=(.*)/ ) {
3371
                $Mode = $1;
3372
                $ModePrefix = "_$1";
3373
 
3374
            } elsif ( /^--Defs$/ ) {
3375
                $Mode = 'defs';
3376
                $ModePrefix = "";
3377
 
3378
            } elsif ( /^--Style=(.*)/ ) {
3379
                $Style = $1;
279 dpurdie 3380
                $VersionFiles = 1;
267 dpurdie 3381
                $supports_opts = 1 if ( $Style =~ /^WinRC/i );
227 dpurdie 3382
 
3383
            } elsif ( /^--File=(.*)/ ) {
3384
                $FileName = $1;
3385
 
267 dpurdie 3386
            } elsif ($supports_opts ) {
3387
                push @opts, $_;
235 dpurdie 3388
 
227 dpurdie 3389
            } else {
3390
                Error ("BuildVersion: Unknown option: $_");
3391
 
3392
            }
3393
        }
3394
    }
3395
    else
3396
    {
3397
        #
3398
        #   Old style positional arguments.
3399
        #
3400
        $VersionFiles = 1;
3401
        if ( defined( $Mode ) )
3402
        {
3403
            if ( $Mode =~ m/^defs(=(.*))?$/i )
3404
            {
3405
                $Mode       = $2 ? $2    : 'defs';
3406
                $ModePrefix = $2 ? "_$2" : "";
3407
            }
3408
            else
3409
            {
3410
                Error ("BuildVersion: Bad Mode argument. Need 'defs' or 'defs=name'");
3411
            }
3412
        }
3413
    }
3414
 
3415
    #
3416
    #   Determine the style of version file to create
3417
    #
3418
    if ( $Style =~ /^CSharp/i ) {
3419
        BuildVersionCSharp( $FileName );
3420
 
229 dpurdie 3421
    } elsif ( $Style =~ /^Properties/i ) {
3422
        BuildVersionProperties( $FileName, $Prefix );
3423
 
227 dpurdie 3424
    } elsif ( $Style =~ /^WinRC/i ) {
267 dpurdie 3425
        BuildVersionWinRC( $FileName, @opts );
227 dpurdie 3426
 
289 dpurdie 3427
    } elsif ( $Style =~ /^Delphi/i ) {
3428
        BuildVersionDelphi( $FileName, $Prefix );
315 dpurdie 3429
 
3430
    } elsif ( $Style =~ /^VB/i ) {
3431
        BuildVersionVB( $FileName, $Prefix );
289 dpurdie 3432
 
227 dpurdie 3433
    } elsif ( $Style eq "C" ) {
289 dpurdie 3434
        BuildVersionC    ( $FileName, $Prefix, $Type )     if ( $VersionFiles );
3435
        BuildVersionCdefs( $FileName, $Mode, $ModePrefix ) if ( $Mode );
227 dpurdie 3436
 
3437
    } else {
3438
        Error("BuildVersion: Unknown style: $Style");
3439
    }
3440
}
3441
 
3442
#-------------------------------------------------------------------------------
3443
# Function        : BuildDescpkg
3444
#
3445
# Description     : Create a package description file
3446
#                   The format of this file matches that generated by JANTS
3447
#                   Take care when extending the format
3448
#
3449
#                   NOTE: It turns out that JANTS is not a standard and the
3450
#                         implementors (of JANTS) kept on changing it.
3451
#
3452
# Inputs          :
3453
#
3454
# Returns         :
3455
#
3456
sub BuildDescpkg
3457
{
4003 dpurdie 3458
    StartBuildPhase();                      # Starting the build phase. No more data collection
3459
    return if ( $Clobber );                 # clobber mode ?
227 dpurdie 3460
 
247 dpurdie 3461
    #
3462
    #   Store the files location for use at runtime
3463
    #   It will be a file that is 'known' to JATS
3464
    #
4003 dpurdie 3465
    my $pkgfile = BuildAddKnownFile ( $NoBuild ? $Cwd : $Srcdir, 'descpkg' );
227 dpurdie 3466
 
261 dpurdie 3467
    my @desc;
279 dpurdie 3468
    push @desc, "Package Name:  $BUILDNAME_PACKAGE";
3469
    push @desc, "Version:       $BUILDVERSION";
3470
    push @desc, "Released By:   $::USER";
3471
    push @desc, "Released On:   $::CurrentTime";
3472
    push @desc, "Build Machine: $::GBE_HOSTNAME";
3473
    push @desc, "Path:          $Cwd";
3474
    push @desc, "Jats Version:  $::GBE_VERSION";
3475
    push @desc, "Jats Path:     $::GBE_CORE";
261 dpurdie 3476
    push @desc, "";
3477
    push @desc, "Build Dependencies:";
3478
    push @desc, "";
227 dpurdie 3479
 
3480
    foreach my $tag ( PackageEntry::GetPackageList )
3481
    {
3482
        my ($name, $version, $type) = PackageEntry::GetPackageData($tag);
3483
 
3484
        my @attributes;
3485
 
3486
        push @attributes, "name=\"$name\"";
3487
        push @attributes, "version=\"$version\"";
3488
        push @attributes, "build=\"true\"" if $type =~ /Build/i;
3489
 
261 dpurdie 3490
        push @desc, "<sandbox @attributes/>";
227 dpurdie 3491
    }
247 dpurdie 3492
 
261 dpurdie 3493
    FileCreate ($pkgfile, \@desc );
227 dpurdie 3494
}
3495
 
3496
#-------------------------------------------------------------------------------
4003 dpurdie 3497
# Function        : NoBuildMarker
3498
#
3499
# Description     : Maintain the nobuild marker
3500
#                   This is file placed in the interface directory simply
3501
#                   to indicate to the 'create_dpkg' utility that this build
3502
#                   does not do anything useful.
3503
#
3504
#                   It will only be used on a build machine by the buid daemon
3505
#
3506
#                   Its not placed in the interface directory as it would be
3507
#                   harder for create_dpkg to find it.
3508
#
3509
# Inputs          : None
3510
# Globals         : $NoBuild, $Clobber
3511
#
3512
# Returns         : Nothing
3513
#
3514
sub NoBuildMarker
3515
{
3516
    return if ( $Clobber );
3517
 
3518
    # Always delete the file - in case we toggle build forms
3519
    #
3520
    my $markerFile = BuildAddKnownFile( $Cwd, 'noBuild.gbe');
3521
    unlink($markerFile);
3522
 
3523
    TouchFile($markerFile)
3524
        if ($NoBuild);
3525
}
3526
 
3527
#-------------------------------------------------------------------------------
227 dpurdie 3528
# Function        : BuildIncpkg
3529
#
3530
# Description     : Create a package inclusion file
3531
#
3532
# Inputs          :
3533
#
3534
# Returns         :
3535
#
3536
sub BuildIncpkg
3537
{
3538
    StartBuildPhase();                          # Starting the build phase. No more data collection
3539
    if ( $Clobber )                             # clobber mode ?
3540
    {
361 dpurdie 3541
        RmDirTree( "$Srcdir/incpkg" );
227 dpurdie 3542
        return;
3543
    }
3544
 
3545
    my $fh = ConfigurationFile::New( "$Srcdir/incpkg" );
3546
    $fh->Header( "buildlib (Version $BuildVersion)",
3547
                              "Package inclusion list" );
3548
 
3549
    foreach my $tag ( PackageEntry::GetPackageList )
3550
    {
3551
        my ($name, $version, $type) = PackageEntry::GetPackageData($tag);
3552
        $type = ($type =~ /build/i) ? "Build" : "Link";
3553
 
3554
        $fh->Write( "${type}PkgArchive( '$name', '$version' );\n" );
3555
    }
3556
 
3557
    $fh->Close();
3558
}
3559
 
3560
#-------------------------------------------------------------------------------
3561
# Function        : BuildConfig
3562
#
3563
# Description     : Create the file interface/build.cfg
3564
#                   This file contains information gathered by the build process
3565
#                   that is to be used when makefiles are created and re-created
3566
#
3567
# Inputs          : None
3568
#
3569
# Returns         : Nothing
3570
#
283 dpurdie 3571
sub BuildConfig
227 dpurdie 3572
{
3573
    Error( "No BuildInterface directive encountered\n" )
3574
        unless ($BUILDINTERFACE);
3575
 
3576
    my $fh = ConfigurationFile::New( "$BUILDINTERFACE/build.cfg");
3577
    $fh->Header( "buildlib (Version $BuildVersion)",
3578
                              "Makelib configuration file", "
3579
\$ScmBuildMachType              = \"$::GBE_MACHTYPE\";
3580
\$ScmInterfaceVersion           = \"$::InterfaceVersion\";
3581
\$ScmBuildName                  = \"$BUILDNAME\";
3582
\$ScmBuildPackage               = \"$BUILDNAME_PACKAGE\";
3583
\$ScmBuildVersion               = \"$BUILDNAME_VERSION\";
3584
\$ScmBuildProject               = \"$BUILDNAME_PROJECT\";
3585
\$ScmBuildVersionFull           = \"$BUILDVERSION\";
3586
\$ScmBuildPreviousVersion       = \"$BUILDPREVIOUSVERSION\";
3587
\$ScmLocal                      = \"$BUILDLOCAL\";
3588
\$ScmDeploymentPatch            = \"$DEPLOY_PATCH\";
3589
\$ScmSrcDir                     = \"$Srcdir\";
3590
\$ScmBuildSrc                   = \"$ScmBuildSrc\";
3591
\$ScmExpert                     = \"$Expert\";
261 dpurdie 3592
\$ScmAll                        = \"$All\";
4003 dpurdie 3593
\$ScmNoBuild                    = \"$NoBuild\";
227 dpurdie 3594
");
3595
 
3596
#.. Alias
3597
#
3598
    $fh->DumpData(
3599
        "\n# Aliases.\n#\n",
3600
        "ScmBuildAliases", \%BUILDALIAS );
3601
 
3602
#.. Products
3603
#
3604
    $fh->DumpData(
3605
        "# Product mapping.\n#\n",
3606
        "ScmBuildProducts", \%BUILDPRODUCT_PARTS );
3607
 
3608
#.. Create ScmBuildPlatforms
3609
#
3610
    my( @platforms_merged, %platform_args ) = ();
3611
 
3612
    UniquePush ( \@platforms_merged, @BUILDPLATFORMS );
3613
 
3614
    foreach my $key ( keys %BUILDPRODUCT ) {
3615
        my( @list ) = split( ' ', $BUILDALIAS{ $key } || '' );
3616
        my( $platform );
3617
 
3618
        foreach my $elem ( @list ) {
3619
            if ( $elem =~ /^--/ ) {             # argument
3620
                HashJoin( \%platform_args, $;, $platform, $elem )
3621
                    if ( defined($platform) );
3622
                next;
3623
            }
3624
            $platform = $elem;                  # platform
3625
            UniquePush( \@platforms_merged, $elem );
3626
        }
3627
    }
3628
 
3629
#.. Create ScmBuildPlatforms
3630
#   Contains per platform options extracted from alias and platform args
3631
#
3632
    my %ScmBuildPlatforms;
3633
    foreach my $key ( @platforms_merged ) {
3634
 
3635
        my( @arguments ) = ();
3636
        UniquePush( \@arguments, split( /$;/, $BUILDPLATFORMARGS{ $key } ))
3637
            if ( exists $BUILDPLATFORMARGS{ $key } );
3638
 
3639
        UniquePush( \@arguments, split( /$;/, $platform_args{ $key } ))
3640
            if ( exists $platform_args{ $key } );
3641
 
3642
        $ScmBuildPlatforms{$key} = join "$;", @arguments;
3643
    }
3644
 
3645
    $fh->DumpData(
3646
        "# Platform and global argument list.\n#\n",
3647
        "ScmBuildPlatforms", \%ScmBuildPlatforms );
3648
 
3649
 
3650
# .. Create BuildPkgRules
3651
#
367 dpurdie 3652
#    This is most of the information contained within %PKGRULES, which
227 dpurdie 3653
#    requires additional processing within makelib.
3654
#
367 dpurdie 3655
#   Need the True Path for windows.
3656
#       Some makefile functions (wildcard) only work as expected
3657
#       if the case of the pathname is correct. Really only a problem
3658
#       with badly formed legecy packages where the Windows user
3659
#       guessed at the package format.
3660
#
227 dpurdie 3661
    my %ScmBuildPkgRules;
3662
    foreach my $platform ( keys %PKGRULES )
3663
    {
3664
        foreach my $package ( @{$PKGRULES{$platform}} )
3665
        {
3666
            my %entry;
3667
 
367 dpurdie 3668
            $entry{ROOT}     = TruePath( $package->{'base'} );
227 dpurdie 3669
            $entry{NAME}     = $package->{'name'};
3670
            $entry{VERSION}  = $package->{'version'};
3671
            $entry{DNAME}    = $package->{'dname'};
3672
            $entry{DVERSION} = $package->{'dversion'};
3673
            $entry{DPROJ}    = $package->{'dproj'};
3674
            $entry{TYPE}     = $package->{'type'};
3675
            $entry{CFGDIR}   = $package->{'cfgdir'} if ( defined( $package->{'cfgdir'} ) );
3676
 
367 dpurdie 3677
            foreach my $dir (qw (TOOLDIRS) )
227 dpurdie 3678
            {
3679
                $entry{$dir} = $package->{$dir} ;
3680
            }
3681
 
367 dpurdie 3682
            my $baselen = length($package->{'base'});
3683
            foreach my $dir (qw (PINCDIRS PLIBDIRS THXDIRS) )
3684
            {
3685
                $entry{$dir} = [];
3686
                foreach my $file ( @{$package->{$dir}} )
3687
                {
3688
                    push @{$entry{$dir}}, substr TruePath($package->{'base'} . $file ), $baselen;
3689
                }
3690
            }
3691
 
227 dpurdie 3692
            push @{$ScmBuildPkgRules{$platform}}, \%entry;
3693
        }
3694
    }
3695
 
3696
    $fh->DumpData(
3697
        "# Imported packages.\n#\n",
3698
        "ScmBuildPkgRules", \%ScmBuildPkgRules );
3699
 
3700
#
3701
#   BUILDPLATFORMS,
3702
#       The value that is saved only contains the active platforms
3703
#
3704
#   DEFBUILDPLATFORMS,
3705
#       The value that is matchs the wildcard specification for Platform 
3706
#       directives.
3707
#
3708
    $fh->DumpData(
3709
        "# A list of platforms active within the view.\n#\n",
3710
        "BUILDPLATFORMS", \@BUILD_ACTIVEPLATFORMS );
3711
 
3712
    $fh->DumpData(
3713
        "# A list of default platforms within the view.\n#\n",
3714
        "DEFBUILDPLATFORMS", \@DEFBUILDPLATFORMS );
3715
 
3716
#
3717
#   BUILDTOOLS
3718
#       A list of toolset extension paths
3719
#
3720
    $fh->DumpData(
3721
        "# A list of paths with toolset extension programs.\n#\n",
3722
        "BUILDTOOLSPATH", \@BUILDTOOLS );
3723
 
3724
#
3725
#   BUILDPLATFORM_PARTS
3726
#       A subset of BUILDINFO exported as BUILDPLATFORM_PARTS
3727
#       This exists only for backward compatability with existing code
3728
#       in external packages ( deployfiles).
3729
#
3730
#   Only save those parts that are part of the current build
3731
#   This will prevent users attempting to build for platforms that have not
3732
#   been correctly constructed.
3733
#
3734
    my %active =  map { ${_} => 1 } @BUILD_ACTIVEPLATFORMS;
3735
    my %active_buildplatform_parts;
3736
    my %active_build_info;
3737
    foreach ( keys %BUILDINFO )
3738
    {
3739
        next unless ( $active{$_} );
3740
        $active_buildplatform_parts{$_} = $BUILDINFO{$_}{PARTS};
3741
        $active_build_info{$_}          = $BUILDINFO{$_};
3742
    }
3743
 
3744
    $fh->DumpData(
3745
        "# Parts of all platforms.\n#\n",
3746
        "BUILDPLATFORM_PARTS", \%active_buildplatform_parts );
3747
#
3748
#   BUILDINFO
3749
#       Complete TARGET Information
3750
#
3751
    $fh->DumpData(
3752
        "# Extended build information.\n#\n",
3753
        "BUILDINFO", \%active_build_info );
3754
 
3755
#
247 dpurdie 3756
#   BUILD_KNOWNFILES
3757
#       All paths are relative to the project root directory
3758
#       ie: The directory that conatins the build.pl file
3759
#
3760
    $fh->DumpData(
3761
        "# Generated Files that may be known when used as Src files.\n#\n",
3762
        "BUILD_KNOWNFILES", \%BUILD_KNOWNFILES );
3763
 
3764
#
227 dpurdie 3765
#   Close out the file
3766
#
3767
    $fh->Close();
363 dpurdie 3768
 
227 dpurdie 3769
}
3770
 
3771
#-------------------------------------------------------------------------------
3772
# Function        : WriteParsedBuildConfig
3773
#
3774
# Description     : Write all the parsed build.pl data to a single file
3775
#                   Its all in there for use
3776
#
3777
# Inputs          : 
3778
#
3779
# Returns         : 
3780
#
3781
sub WriteParsedBuildConfig
3782
{
3783
    my $cfg_file = "$::BUILDINTERFACE/Buildfile.cfg";
3784
    my %cf_build_info = ();
3785
 
3786
    #
3787
    #   Examine the symbol table and capture most of the entries
3788
    #
3789
    foreach my $symname (keys %main::)
3790
    {
3791
        next if ( $symname =~ m/::/  );                 # No Typeglobs
3792
        next if ( $symname =~ m/^cf_build_info/  );     # Not myself
3793
        next unless ( $symname =~ m/^[A-Za-z]/  );      # No system type names
3794
        next if ( $symname =~ m/^SIG$/  );              # Useless
3795
        next if ( $symname =~ m/^ENV$/  );              # Don't keep the user ENV
3796
        next if ( $symname =~ m/^INC$/  );              # Don't keep the INC paths
3797
        next if ( $symname =~ m/^DEFINES/  );           # Don't keep
3798
        next if ( $symname =~ m/^TOOLSETRULES/  );      # Don't keep
3799
 
331 dpurdie 3800
        no strict 'vars';
227 dpurdie 3801
        local *sym = $main::{$symname};
3802
 
331 dpurdie 3803
        $cf_build_info{"\$$symname"} =  $sym if defined $sym;
369 dpurdie 3804
        $cf_build_info{"\@$symname"} = \@sym if @sym;
3805
        $cf_build_info{"\%$symname"} = \%sym if %sym;
331 dpurdie 3806
        use strict 'vars';
227 dpurdie 3807
    }
3808
 
3809
    #
3810
    #   Dump out the configuration information
3811
    #
3812
    my $fh = ConfigurationFile::New( "$cfg_file" );
3813
    $fh->Header( "buildlib (version $::BuildVersion)",
3814
                              "Buildfile configuration" );
3815
    $fh->Dump( [\%cf_build_info], [qw(*cf_build_info)] );
3816
    $fh->Close();
3817
}
3818
 
3819
 
3820
#-------------------------------------------------------------------------------
3821
# Function        : BuildSharedLibFiles
3822
#
3823
# Description     : Create a file in the interface directory that will specify
3824
#                   the locations of shared libraries.
3825
#
3826
#                   Note: Always create a file as makefile targets depend on it.
3827
#
3828
#                   This is a bit ugly.
3829
#
3830
#                   There needs be an association between the build machine and
3831
#                   the target platform. Need to know if the current target is
3832
#                   native to the current build machine. If it is then we can
3833
#                   run tests on the machine and we then need to extend the
3834
#                   search path for the target.
3835
#
3836
#                   The BUILDINFO{EXT_SHARED} is used to control the creation of
3837
#                   the files by specifying the extension of the file.
3838
#
3839
# Inputs          : None
3840
#
3841
# Returns         :
3842
#
3843
sub BuildSharedLibFiles
3844
{
3845
    if ( $ScmHost eq "DOS" || $ScmHost eq "WIN" ) {
3846
        BuildSharedLibFiles_WIN(@_);
3847
 
3848
    } elsif ( $ScmHost eq "Unix" ) {
3849
        BuildSharedLibFiles_Unix(@_);
3850
 
3851
    } else {
3852
        Error("Cannot build. Unknown machine type: $ScmHost",
3853
              "Need WIN, DOS or Unix" );
3854
    }
3855
}
3856
 
3857
#-------------------------------------------------------------------------------
3858
# Function        : BuildSharedLibFiles_WIN
3859
#
3860
# Description     : Implementation of BuildSharedLibFiles for Windows
3861
#
3862
# Inputs          : None
3863
#
3864
sub BuildSharedLibFiles_WIN
3865
{
3866
 
3867
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
3868
    {
3869
        next unless ( exists $BUILDINFO{$platform}{EXT_SHARED} );
3870
        my @dos_paths = BuildSharedLibFiles_list( $platform, $BUILDINFO{$platform}{EXT_SHARED} );
3871
 
3872
        #
3873
        #   Create a .bat file for WIN32
3874
        #   This may be consumed by user wrapper programs
3875
        #
229 dpurdie 3876
        #   Features: No Echo
3877
        #             Use of SETLOCAL to prevent pollution of environment
3878
        #
227 dpurdie 3879
        my $fh = ::ConfigurationFile::New( "$BUILDINTERFACE/set_$platform.bat", '--NoEof', '--Type=bat' );
229 dpurdie 3880
        $fh->Write ( "\@echo off\n");
227 dpurdie 3881
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
229 dpurdie 3882
        $fh->Write ( "\nSETLOCAL\n");
227 dpurdie 3883
        foreach ( reverse @dos_paths )
3884
        {
3885
            $_ =~ s~/~\\~g;
3886
            $fh->Write ( "PATH=$_;\%PATH\%\n" );
3887
        }
3888
        $fh->Write ( "\n%*\n" );
229 dpurdie 3889
        $fh->Write ( "\nENDLOCAL\n");
231 dpurdie 3890
        $fh->Write ( "EXIT /B %ERRORLEVEL%\n");
227 dpurdie 3891
        $fh->Close();
3892
 
3893
        #
3894
        #   Create a .sh file for WIN32
3895
        #   This may be consumed by a shell - as used within JATS
3896
        #
3897
        $fh = ::ConfigurationFile::New( "$BUILDINTERFACE/set_$platform.sh", '--NoEof', '--Type=sh' );
3898
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
3899
        foreach ( reverse @dos_paths )
3900
        {
3901
            tr~\\/~/~s;
3902
            $fh->Write ( "PATH=$_\\;\$PATH\n" );
3903
        }
287 dpurdie 3904
        $fh->Write ( "\n" . '[ -n "$*" ] && "$@"'  ."\n" );
227 dpurdie 3905
        $fh->Close();
3906
    }
3907
}
3908
 
3909
#-------------------------------------------------------------------------------
3910
# Function        : BuildSharedLibFiles_Unix
3911
#
3912
# Description     : Implementation of BuildSharedLibFiles for Unix
3913
#                   Extend the Shared Library search path via LD_LIBRARY_PATH
3914
#
3915
# Inputs          : None
3916
#
3917
sub BuildSharedLibFiles_Unix
3918
{
3919
    foreach my $platform ( @BUILD_ACTIVEPLATFORMS )
3920
    {
3921
        next unless ( exists $BUILDINFO{$platform}{EXT_SHARED} );
3922
        my @unix_paths = BuildSharedLibFiles_list( $platform, $BUILDINFO{$platform}{EXT_SHARED} );
3923
 
3924
        #
3925
        #   Create a .sh file for Unix
3926
        #
229 dpurdie 3927
        my $file = "$BUILDINTERFACE/set_$platform.sh";
3928
        my $fh = ::ConfigurationFile::New( $file , '--NoEof', '--Type=sh' );
227 dpurdie 3929
        $fh->Header( "Buildlib ($BuildVersion)","Shared Library Paths" );
3930
        foreach ( reverse @unix_paths )
3931
        {
3932
            $fh->Write ( "export LD_LIBRARY_PATH=$_:\$LD_LIBRARY_PATH\n" );
3933
        }
275 dpurdie 3934
        $fh->Write ( "\n\"\$\@\"\n" );
227 dpurdie 3935
        $fh->Close();
229 dpurdie 3936
 
3937
        #
3938
        #   Make the file executable under unix
3939
        #
3940
        chmod 0755, $file;
227 dpurdie 3941
    }
3942
}
3943
 
3944
#-------------------------------------------------------------------------------
3945
# Function        : BuildSharedLibFiles_list
3946
#
3947
# Description     : Determine a list of Shared Library paths that can be used
3948
#                   by the current target
3949
#
3950
# Inputs          : $platform       - Current platform
3951
#                   $so             - Shared object extensions
3952
#
3953
# Returns         : List of search paths
3954
#
3955
sub BuildSharedLibFiles_list
3956
{
3957
    my ($platform, $so ) = @_;
3958
    my @paths;
3959
    my @parts = @{$BUILDINFO{$platform}{PARTS}};
3960
 
3961
    #
3962
    #   Paths from the current build
3963
    #       Local directory         - for installed components
3964
    #       Interface directory     - for BuildPkgArchives
3965
    #
3966
    if ( $BUILDLOCAL )
3967
    {
3968
        foreach ( @parts )
3969
        {
3970
            push @paths, AbsPath("$BUILDLOCAL/lib/$_");
3971
        }
3972
    }
3973
 
3974
    foreach ( @parts )
3975
    {
3976
            push @paths, AbsPath("$BUILDINTERFACE/lib/$_");
3977
    }
3978
 
3979
    #
3980
    #   For each LinkPkgArchive
3981
    #
3982
    foreach my $package ( @{$PKGRULES{$platform}} )
3983
    {
3984
        next unless ( $package->{'type'} eq 'link' );
3985
 
3986
        my $base = $package->{'base'};
3987
        for my $path ( @{$package->{'PLIBDIRS'}} )
3988
        {
289 dpurdie 3989
            my @so_libs;
317 dpurdie 3990
            push @so_libs, glob ( "$base$path/*$_") foreach ( ArrayList($so) );
227 dpurdie 3991
            next unless scalar @so_libs;
3992
            push @paths, $base . $path;;
3993
        }
3994
    }
3995
 
3996
    #
3997
    #   Returns paths found
3998
    #
3999
    return @paths;
4000
}
4001
 
4002
#-------------------------------------------------------------------------------
247 dpurdie 4003
# Function        : BuildAddKnownFile
4004
#
4005
# Description     : Save the file as a file that will be known  to the JATS
4006
#                   makefiles. It will be available SRCS, but will not be a
4007
#                   part of any object list.
4008
#
4009
#                   Known Files will be deleted on clobber
4010
#
4011
# Inputs          : $path
4012
#                   $file
289 dpurdie 4013
#                   $noadd                    - Don't add to known
247 dpurdie 4014
#
4015
# Returns         : Path and filename
4016
#
4017
 
4018
sub BuildAddKnownFile
4019
{
289 dpurdie 4020
    my ($path, $file, $noadd) = @_;
247 dpurdie 4021
    $path .= '/'. $file;
2450 dpurdie 4022
    $path =~ tr~/~/~s;
289 dpurdie 4023
    $BUILD_KNOWNFILES {$file} = $path
4024
        unless ( defined($noadd) && $noadd);
4003 dpurdie 4025
 
3967 dpurdie 4026
    ToolsetFile( $path )
4027
        unless ($Clobber);
4028
 
247 dpurdie 4029
    return $path;
4030
}
4031
 
4032
#-------------------------------------------------------------------------------
5410 dpurdie 4033
# Function        : abtWarning 
4034
#
4035
# Description     : User Error, Build System Warning
4036
#                   Used to tighten up builds, but to retain BuildSystem compatability
4037
#
4038
#                   Must use "ErrorDoExit();" to force termination
4039
#                   Multiple error messages can be displayed before termination
4040
# 
4041
#                   ABT Mode is a bit more forgiving, but only for backward compatability
4042
#                   Otherwise force users to fix the build.pl files.
4043
#
4044
# Inputs          : $msg            - Message to display 
4045
#
4046
# Returns         : May not return
4047
#
4048
sub abtWarning
4049
{
4050
    my ($msg) = @_;
4051
    if ( $::GBE_ABT ) 
4052
    {
4053
        Warning( $msg . ' -- ignored in ABT Mode' );
4054
        return;
4055
    }
4056
    ReportError($msg);
4057
}
4058
 
4059
#-------------------------------------------------------------------------------
227 dpurdie 4060
# Function        : Usage
4061
#
4062
# Description     : Display program usage information
4063
#
4064
# Inputs          : args            - Text message to display
4065
#
4066
#                   $opt_help       - Level of verbose ness
4067
#
4068
# Returns         : Does not return
4069
#                   This function will exit
4070
#
4071
sub Usage
4072
{
4073
    my( $msg ) = @_;
4074
    my %usage_args;
4075
 
4076
    #
4077
    #   Create a hash of arguments for the pod2usage function
4078
    #
4079
    $usage_args{'-input'} = __FILE__;
4080
    $usage_args{'-exitval'} = 42;
4081
    $usage_args{'-message'} = "\nbuildlib $msg\n" if $msg;
4082
    $usage_args{'-verbose'} = $opt_help < 3 ? $opt_help - 1 : 3 if ( $opt_help );
4083
 
4084
    #
4085
    #   Generate nice help
4086
    #
4087
    pod2usage(\%usage_args);
4088
}
4089
 
4090
#-------------------------------------------------------------------------------
4091
#   Documentation
4092
#
4093
 
4094
=pod
4095
 
361 dpurdie 4096
=for htmltoc    JATS::build
4097
 
227 dpurdie 4098
=head1 NAME
4099
 
361 dpurdie 4100
build - Build Environment and Makefiles
227 dpurdie 4101
 
4102
=head1 SYNOPSIS
4103
 
4104
jats build [options] [command]
4105
 
4106
     [perl buildlib.pl [options] PWD [command]]
4107
 
4108
 Options:
331 dpurdie 4109
    -help          - Display terse usage
361 dpurdie 4110
    -help -help    - Display verbose usage
331 dpurdie 4111
    -man           - Display internal manual
4112
    -verbose[=n]   - Set level of progress verbosity
4113
    -debug[=n]     - Set the debug level
4114
    -nolog         - Do not generate/update Changelog
4115
    -cache         - Cache packages in the local dpkg_package cache
361 dpurdie 4116
    -cache -cache  - Forced refresh dependent packages in the local cache
331 dpurdie 4117
    -package       - Ignore packages that are not available and continue
2078 dpurdie 4118
    -nopackages    - Ignore package processing directives
331 dpurdie 4119
    -forcebuildpkg - Treat LinkPkgArchive directives as BuildPkgArchive
361 dpurdie 4120
                     Also suppress the use of symlinks so that the physical
4121
                     file will be copied locally.
331 dpurdie 4122
    -[no]force     - Force build even if build.pl is not newer
363 dpurdie 4123
                     Default: -force
4778 dpurdie 4124
    -[no]generic   - Build system sanity test
4125
                     Default: Do not test
227 dpurdie 4126
 
4127
 Sticky settings:
331 dpurdie 4128
    -all           - Build for all platforms ignoring GBE_BUILDFILTER
4129
    -expert[=n]    - Relaxing dependency checks on the user makefiles
227 dpurdie 4130
 
4131
 Commands:
361 dpurdie 4132
    changelog      - Only update ChangeLog.
2078 dpurdie 4133
    clobber        - Remove generated build system (eg Makefiles).
361 dpurdie 4134
    interface      - Only (re)build the interface tree, including ChangeLog.
4135
    rootonly       - Only (re)build the root directory.
227 dpurdie 4136
 
4137
=head1 OPTIONS
4138
 
4139
=over 8
4140
 
331 dpurdie 4141
=item B<-help>
227 dpurdie 4142
 
4143
Print a brief help message and exits.
4144
 
4145
=item B<-help -help>
4146
 
4147
Print a detailed help message with an explanation for each option.
4148
 
4149
=item B<-man>
4150
 
4151
Prints the manual page and exits.
4152
 
331 dpurdie 4153
=item B<-verbose[=n]>
227 dpurdie 4154
 
261 dpurdie 4155
Increases program output.
227 dpurdie 4156
 
261 dpurdie 4157
If an argument is provided, then it will be used to set the level, otherwise the
4158
existing level will be incremented. This option may be specified multiple times.
227 dpurdie 4159
 
261 dpurdie 4160
=item B<-debug>
4161
 
227 dpurdie 4162
Increases program output. Enable internal debugging messages to generate detailed
4163
progress information.
4164
 
261 dpurdie 4165
If an argument is provided, then it will be used to set the level, otherwise the
4166
existing level will be incremented. This option may be specified multiple times.
4167
 
331 dpurdie 4168
=item B<-nolog>
227 dpurdie 4169
 
4170
Do not generate or update the ChangeLog maintained when a CVS directory is detected
4171
in the build directory.
4172
 
331 dpurdie 4173
=item B<-cache>
227 dpurdie 4174
 
4175
This option will cause dependent packages to be cached in the local
4176
dpkg_archive cache.
4177
 
4178
If the option is used twice then the packages will be forcibly refreshed.
4179
 
331 dpurdie 4180
=item B<-package>
227 dpurdie 4181
 
4182
This option will cause the build process to ignore packages that cannot be
4183
located. The package build may fail at a later stage.
4184
 
4185
This option is used by the Auto Build Tool to handle packages that may not be
4186
needed in all builds.
4187
 
2078 dpurdie 4188
=item B<-nopackage>
4189
 
4190
This options will cause all the directives that process external packages to be
4191
ignored.
4192
 
4193
This directive has limited use. It can be used in conjunction with the
4194
'interface' build command in order to create Version Information files in a
4195
sandbox where the required packages do not yet exist.
4196
 
331 dpurdie 4197
=item B<-forcebuildpkg>
227 dpurdie 4198
 
4199
This option will force LinkPkgArchive directives to be treated as
4200
BuildPkgArchive directives. The result is that the 'interface' directory will be
4201
populated with the contents of all dependent packages. Moreover, on a Unix
4202
machine, the files will be copied and not referenced with a soft link.
4203
 
4204
This may be useful for:
4205
 
4206
=over 8
4207
 
361 dpurdie 4208
=item *
227 dpurdie 4209
 
361 dpurdie 4210
Remote Development
227 dpurdie 4211
 
361 dpurdie 4212
=item *
227 dpurdie 4213
 
361 dpurdie 4214
Collecting header files for scanning
4215
 
4216
=item *
4217
 
4218
Local modification of files for test/debug/development
4219
 
227 dpurdie 4220
=back
4221
 
331 dpurdie 4222
=item B<-[no]force>
227 dpurdie 4223
 
331 dpurdie 4224
The '-noforce' option will only perform a build, if the build.pl file
363 dpurdie 4225
has been modified, or the buildfilter has changed, since the last build.
331 dpurdie 4226
 
363 dpurdie 4227
The default operation will always force a build.
331 dpurdie 4228
 
4778 dpurdie 4229
=item B<-[no]generic>
4230
 
4231
If used, this option will perform a sanity test on the build type. If set to 
4232
Generic then the build must be a GENERIC build. If set to noGeneric then the build
4233
must not be a GENERIC build.
4234
 
4235
The default is to not perform the test.
4236
 
4237
This option is intended to be used by the automated build system.
4238
 
331 dpurdie 4239
=item B<-all>
4240
 
227 dpurdie 4241
This option will cause the build process to generate makefiles for all
4242
possible build targets ignoring the use of GBE_BUILDFILTER.
4243
 
4244
This option is sticky. Once used in a build it will be retained when makefiles
4245
are rebuilt.
4246
 
331 dpurdie 4247
=item B<-expert[=n]>
227 dpurdie 4248
 
4249
This option causes the generation of makefiles with relaxed dependancy checks.
4250
 
261 dpurdie 4251
If an argument is provided, then it will be used to set the level, otherwise a
4252
level of '1' will be set.
4253
 
227 dpurdie 4254
The makefiles will have no dependancy between the makefiles and the JATS build
4255
files or the users makefile. If the user's makefile.pl is changed then JATS
4256
will not detect the change and will not rebuild the makefiles. The user manually
4257
force the rebuild with the command 'jats rebuild'.
4258
 
4259
This option should be used with care and with full knowledge of its impact.
4260
 
4261
This option is sticky. Once used in a build it will be retained when makefiles
363 dpurdie 4262
are rebuilt. It will only be lost when the next 'jats build' is performed.
227 dpurdie 4263
 
261 dpurdie 4264
The effect of the option can be changed when the makefiles are processed. This
4265
option simply sets the default' mode of operation.
4266
 
227 dpurdie 4267
=item B<changelog>
4268
 
4269
This command will only update the CVS change log.
4270
 
4271
=item B<interface>
4272
 
4273
This command will only build, or rebuild, the 'interface' directory and the
4274
changelog ( if required ).
4275
 
261 dpurdie 4276
This command will not build, or rebuild, the root directory. The build
227 dpurdie 4277
process will not recurse through the subdirectories creating makefiles.
4278
 
261 dpurdie 4279
=item B<rootonly>
4280
 
4281
This command will only build, or rebuild, the 'interface' directory, the
4282
changelog (if required) and the root-level makefiles.
4283
 
4284
The build process will not recurse through the subdirectories creating
4285
makefiles. These can be made on-demand by jats if a 'make' command is issued.
4286
 
227 dpurdie 4287
=item B<clobber>
4288
 
4289
This command will remove generated build system files and directories.
4290
 
4291
=back
4292
 
4293
=head1 DESCRIPTION
4294
 
4295
The default build process will parse the user's build.pl file and create the
4296
'interface' directory before creating makefiles for each target platform.
4297
 
4298
The 'build' process simply generates the build sandbox. It does not invoke the
4299
generated makefiles. This must be done by the user in a different phase.
4300
 
4301
The 'build' process need only be invoked if the build.pl file has changed. The
4302
generated makefiles will detected changes to the makefile.pl's and cause them to
4303
be generated as required. The 'build' step sets up the sandboxes external
4304
environment.
4305
 
4306
=head1 INVOCATION
4307
 
4308
This perl library (buildlib.pl) is not designed to be invoked directly by the
4309
user. It should be invoked through a 'build.pl' file. Moreover, for historical
4310
reasons, the build.pl is not easily invoked. It is best to only invoke the
4311
'build' process via the JATS wrapper scripts : jats.bat or jats.sh.
4312
 
331 dpurdie 4313
The build.pl file must be invoked with one fixed arguments, followed by user
227 dpurdie 4314
options and subcommands
4315
 
4316
=over 8
4317
 
361 dpurdie 4318
=item   1
227 dpurdie 4319
 
361 dpurdie 4320
The current working directory
4321
 
227 dpurdie 4322
This could have been derived directly by the program, rather than having it
4323
passed in.
4324
 
361 dpurdie 4325
=item   2
227 dpurdie 4326
 
361 dpurdie 4327
Options and commands may follow the first two mandatory arguments.
4328
 
227 dpurdie 4329
=back
4330
 
4331
The build.pl file must 'require' the buildlib.pl and makelib.pl. The preferred
4332
code is:
4333
 
4334
=over 8
4335
 
4336
    build.pl: First statements
4337
    $MAKELIB_PL     = "$ENV{ GBE_TOOLS }/makelib.pl";
4338
    $BUILDLIB_PL    = "$ENV{ GBE_TOOLS }/buildlib.pl";
4339
 
4340
    require         "$BUILDLIB_PL";
4341
    require         "$MAKELIB_PL";
4342
 
4343
=back
4344
 
4345
=cut
4346
 
4347
1;