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