Subversion Repositories DevTools

Rev

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