Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
407 dpurdie 1
########################################################################
3921 dpurdie 2
# Copyright (C) 1998-2013 Vix Technology, All rights reserved
407 dpurdie 3
#
3921 dpurdie 4
# Module name   : DebianPackager.pl
407 dpurdie 5
# Module type   : Makefile system
3921 dpurdie 6
# Compiler(s)   : Perl
407 dpurdie 7
# Environment(s): jats
8
#
9
# Description   : This program is invoked by the MakeDebianPackage
10
#                 directive, that is a part of this package
11
#
12
#                 The program will use a user-provided script in order
13
#                 to create a Debian Package.
14
#
15
#                 The user script may call a number of directives in order to
16
#                 construct an image of the package being installed.
17
#
18
#                 The script specifies Debian configuration scaripts that
19
#                 will be embedded in the package.
20
#
21
#                 This program will:
22
#                   Construct a filesystem image under control of the directives
23
#                   within the user script
24
#
25
#                   Massage the Debian control file
26
#
27
#                   Create a Debian Package
28
#
29
#                   Transfer it to the users 'BIN' directory, where it is
30
#                   available to be packaged.
31
#
32
#                 Summary of directives available to the user-script:
33
#                       AddInitScript           - Add an init script
34
#                       CatFile                 - Append to a file
35
#                       CopyDir                 - Copy directory tree
36
#                       CopyFile                - Copy a file
37
#                       CopyBinFile             - Copy an executable file
38
#                       CopyLibFile             - Copy a library file
39
#                       CreateDir               - Create a directory
40
#                       DebianFiles             - Specify control and script files
41
#                       EchoFile                - Place text into a file
42
#                       MakeSymLink             - Create a symbolic link
43
#                       PackageDescription      - Specify the package description
44
#                       SetFilePerms            - Set file permissions
45
#                       SetVerbose              - Control progress display
46
#                       IsProduct               - Flow control
47
#                       IsPlatform              - Flow control
48
#                       IsTarget                - Flow control
427 dpurdie 49
#                       IsVariant               - Flow control
407 dpurdie 50
#
51
#                 Thoughts for expansion:
52
#                       ConvertFile             - Option to convert file(s) to Unix Text
53
#                       ReplaceTags             - Replace Tags on target file
54
#                       SrcDir                  - Extend path for resolving local files
55
#
56
#                   Less used:
57
#                        ExpandLinkFiles        - Expand .LINK files
58
#
59
#                   Internal Use:
60
#                        FindFiles              - Find a file
61
#                        ResolveFile            - Resolve a 'local' source file
62
#                        
63
#......................................................................#
64
 
411 dpurdie 65
require 5.006_001;
407 dpurdie 66
use strict;
67
use warnings;
68
 
69
use Getopt::Long;
70
use File::Path;
71
use File::Copy;
72
use File::Find;
73
use JatsSystem;
74
use FileUtils;
75
use JatsError;
76
use ReadBuildConfig;
423 dpurdie 77
use JatsCopy ();                            # Don't import anything
407 dpurdie 78
 
79
#
80
#   Globals
81
#
425 dpurdie 82
my $DebianWorkDirBase;                      # Workspace
407 dpurdie 83
my $DebianWorkDir;                          # Dir to create file system image within
84
 
85
#
86
#   Command line options
87
#
88
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
89
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
90
my $opt_vargs;                              # Verbose arg
91
my $opt_help = 0;
92
my $opt_manual = 0;
93
my $opt_clean = 0;
94
my $opt_platform;
95
my $opt_type;
96
my $opt_buildname;
97
my $opt_buildversion;
98
my $opt_interfacedir;
99
my $opt_target;
100
my $opt_product;
101
my $opt_package_script;
102
my $opt_interfaceincdir;
103
my $opt_interfacelibdir;
104
my $opt_interfacebindir;
105
my $opt_libdir;
106
my $opt_bindir;
107
my $opt_localincdir;
108
my $opt_locallibdir;
109
my $opt_localbindir;
110
my $opt_pkgdir;
111
my $opt_pkglibdir;
112
my $opt_pkgbindir;
113
my $opt_pkgpkgdir;
114
my $opt_output;
417 dpurdie 115
my $opt_name;
427 dpurdie 116
my $opt_variant;
3921 dpurdie 117
my $opt_pkgarch;
407 dpurdie 118
 
119
#
120
#   Options derived from script directives
121
#
122
my $opt_description;
123
 
415 dpurdie 124
#
125
#   Globals
126
#
127
my @ResolveFileList;                    # Cached Package File List
128
my @ResolveBinFileList;                 # Cached PackageBin File List
129
my @ResolveLibFileList;                 # Cached PackageLib File List
4635 dpurdie 130
my %DebianControlFiles;                 # Control Files
131
my %DebianControlFileNames;             # Control Files by name
132
my @DependencyList;                     # Package Dependencies
407 dpurdie 133
 
134
#-------------------------------------------------------------------------------
135
# Function        : Main Entry point
136
#
137
# Description     : This function will be called when the package is initialised
138
#                   Extract arguments from the users environment
139
#
140
#                   Done here to greatly simplify the user script
141
#                   There should be no junk in the user script - keep it simple
142
#
143
# Inputs          :
144
#
145
# Returns         : 
146
#
147
main();
148
sub main
149
{
150
    my $result = GetOptions (
151
                "verbose:s"         => \$opt_vargs,
152
                "clean"             => \$opt_clean,
153
                "Type=s"            => \$opt_type,
4105 dpurdie 154
                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)
155
                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name
407 dpurdie 156
                "BuildVersion=s"    => \$opt_buildversion,
157
                "Platform=s"        => \$opt_platform,
158
                "Target=s"          => \$opt_target,
159
                "Product=s"         => \$opt_product,
160
                "DebianPackage=s"   => \$opt_package_script,
161
                "InterfaceDir=s"    => \$opt_interfacedir,
162
                "InterfaceIncDir=s" => \$opt_interfaceincdir,
163
                "InterfaceLibDir=s" => \$opt_interfacelibdir,
164
                "InterfaceBinDir=s" => \$opt_interfacebindir,
165
                "LibDir=s"          => \$opt_libdir,
166
                "BinDir=s"          => \$opt_bindir,
167
                "LocalIncDir=s"     => \$opt_localincdir,
168
                "LocalLibDir=s"     => \$opt_locallibdir,
169
                "LocalBinDir=s"     => \$opt_localbindir,
170
                "PackageDir=s"      => \$opt_pkgdir,
171
                "PackageLibDir=s"   => \$opt_pkglibdir,
172
                "PackageBinDir=s"   => \$opt_pkgbindir,
173
                "PackagePkgDir=s"   => \$opt_pkgpkgdir,
174
                "Output=s"          => \$opt_output,
427 dpurdie 175
                "Variant:s"         => \$opt_variant,
3921 dpurdie 176
                "PkgArch:s"         => \$opt_pkgarch,
407 dpurdie 177
    );
178
    $opt_verbose++ unless ( $opt_vargs eq '@' );
179
 
180
    ErrorConfig( 'name'    => 'DebianUtils',
181
                 'verbose' => $opt_verbose,
182
                 'debug'   => $opt_debug );
183
 
184
    #
185
    #   Init the FileSystem Uiltity interface
186
    #
187
    InitFileUtils();
188
 
189
    #
190
    #   Ensure that we have all required options
191
    #
192
    Error ("Platform not set")                  unless ( $opt_platform );
193
    Error ("Type not set")                      unless ( $opt_type );
194
    Error ("BuildName not set")                 unless ( $opt_buildname );
4105 dpurdie 195
    Error ("Debian Package Name not set")       unless ( $opt_name );
407 dpurdie 196
    Error ("BuildVersion not set")              unless ( $opt_buildversion );
197
    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );
198
    Error ("Target not set")                    unless ( $opt_target );
199
    Error ("Product not set")                   unless ( $opt_product );
200
    Error ("DebianPackage not set")             unless ( $opt_package_script );
201
    Error ("Ouput File not set")                unless ( $opt_output );
202
 
203
    #
204
    #   Read in relevent config information
205
    #
206
    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );
207
 
208
    #
209
    #   Build the package image in a directory based on the target being created
210
    #
425 dpurdie 211
    $DebianWorkDirBase = "$opt_platform$opt_type.image";
212
    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";
407 dpurdie 213
 
214
    #
215
    #   Configure the System command to fail on any error
216
    #
217
    SystemConfig ( ExitOnError => 1 );
218
 
219
    #
220
    #   Extract the 'name' of the package from the output path
221
    #   Display purposes only
222
    #
223
    my $DebianPkgName = StripDirExt($opt_output);
224
 
225
    #
226
    #   Display variables used
227
    #
228
    Message    "=Building Debian Package =============================================";
417 dpurdie 229
    Message    "Build $opt_name";
407 dpurdie 230
    Message    "       Package: $opt_buildname";
427 dpurdie 231
    Message    "       Variant: $opt_variant" if ($opt_variant);
407 dpurdie 232
    Message    "       Version: $opt_buildversion";
233
    Message    "  Building for: $opt_platform, $opt_target";
234
    Message    "       Product: $opt_product";
235
    Message    "          Type: $opt_type";
3921 dpurdie 236
    Message    "      Pkg Arch: $opt_pkgarch" if ($opt_pkgarch);
407 dpurdie 237
    Verbose    "       Verbose: $opt_verbose";
238
    Verbose    "  InterfaceDir: $opt_interfacedir";
239
    Message    "       Package: $DebianPkgName";
240
    Message    "======================================================================";
241
 
242
    #
3921 dpurdie 243
    #   Defaults
244
    #
245
    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );
246
 
247
    #
407 dpurdie 248
    #   Perform Clean up
249
    #   Invoked during "make clean" or "make clobber"
250
    #
251
    if ( $opt_clean )
252
    {
253
        Message ("Remove packaging directory: $DebianWorkDir");
425 dpurdie 254
 
255
        #
256
        #   Remove the directory for this package
257
        #   Remove the general work dir - if all packages have been cleaned
258
        #
407 dpurdie 259
        rmtree( $DebianWorkDir );
425 dpurdie 260
        rmdir( $DebianWorkDirBase );
407 dpurdie 261
        rmtree ($opt_output) if ( -f $opt_output );
262
        exit;
263
    }
264
 
265
    #
266
    #   Clean  out the WORK directory
267
    #   Always start with a clean slate
268
    #
269
    #   Ensure that the base of the directory tree does not have 'setgid'
270
    #       This will upset the debian packager
271
    #       This may be an artifact from the users directory and not expected
272
    #
273
    rmtree( $DebianWorkDir );
274
    mkpath( $DebianWorkDir );
275
 
276
    my $perm = (stat $DebianWorkDir)[2] & 0777;
277
    chmod ( $perm & 0777, $DebianWorkDir );
278
 
279
    #
280
    #   Invoke the user script to do the hard work
281
    #
4139 dpurdie 282
    unless (my $return = do $opt_package_script) {
283
            Error ("Couldn't parse $opt_package_script: $@") if $@;
284
            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;
285
        }
407 dpurdie 286
 
287
    #
288
    #   Complete the building of the package
289
    #
290
    BuildDebianPackage ();
291
    Message ("Created Debian Package");
292
}
293
 
294
#-------------------------------------------------------------------------------
295
# Function        : BuildDebianPackage
296
#
297
# Description     : This function will create the Debian Package
298
#                   and transfer it to the target directory
299
#
300
# Inputs          : None
301
#
302
# Returns         : Nothing
303
#
304
sub BuildDebianPackage
305
{
306
    Error ("BuildDebianPackage: No Control File or Package Description")
4635 dpurdie 307
        unless ( exists($DebianControlFiles{'control'}) || $opt_description );
407 dpurdie 308
 
309
    #
310
    #   Convert the FileSystem Image into a Debian Package
311
    #       Insert Debian control files
312
    #
313
    Verbose ("Copy in the Debian Control Files");
314
    mkdir ( "$DebianWorkDir/DEBIAN" );
315
 
4635 dpurdie 316
    #
317
    #   Copy in all the named Debian Control files
318
    #       Ignore any control file. It will be done next
319
    #
320
    foreach my $key ( keys %DebianControlFiles )
321
    {
322
        next if ($key eq 'control');
323
        CopyFile ( $DebianControlFiles{$key},    "/DEBIAN", $key );
324
    }
325
 
326
    #
327
    #   Massage the 'control' file
328
    #
329
    UpdateControlFile ($DebianControlFiles{'control'} );
407 dpurdie 330
 
4635 dpurdie 331
    #
332
    #   Mark all files in the debian folder as read-execute
333
    #
407 dpurdie 334
    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );
335
    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);
336
    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );
337
 
338
    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));
339
 
340
}
341
 
342
#-------------------------------------------------------------------------------
343
# Function        : UpdateControlFile
344
#
4188 dpurdie 345
# Description     : Update the Debian 'control' file to fix up various fields
407 dpurdie 346
#                   within the file.
347
#
348
#                   If the files has not been specified, then a basic control
349
#                   file will be provided.
350
#
351
#                   This routine knows where the control file will be placed
352
#                   within the output work space.
353
#
354
# Inputs          : $src            - Path to source file
355
#                   Uses global variables
356
#
357
# Returns         : Nothing
358
#
359
sub UpdateControlFile
360
{
361
    my($src) = @_;
362
    my $dst = "$DebianWorkDir/DEBIAN/control";
363
 
364
    unless ( $src )
365
    {
366
        CreateControlFile();
367
        return;
368
    }
369
 
4635 dpurdie 370
    #
371
    #   User has provided a control file
372
    #       Tweak the internals
373
    #
407 dpurdie 374
    Verbose ("UpdateControlFile: $dst" );
375
    $src = ResolveFile( 0, $src );
376
 
4635 dpurdie 377
    #   Calc depends line
378
    my $depData = join (',', @DependencyList );
379
 
380
    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open:$src, $!");
381
    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst, $!");
407 dpurdie 382
    while ( <SF> )
383
    {
384
        s~\s*$~~;
385
        if ( m~^Package:~ ) {
4105 dpurdie 386
            $_ = "Package: $opt_name";
407 dpurdie 387
 
388
        } elsif ( m~^Version:~ ) {
389
            $_ = "Version: $opt_buildversion";
390
 
391
        } elsif ( m~^Architecture:~ ) {
3921 dpurdie 392
            $_ = "Architecture: $opt_pkgarch";
407 dpurdie 393
 
394
        } elsif ( $opt_description && m~^Description:~ ) {
395
            $_ = "Description: $opt_description";
4635 dpurdie 396
 
397
        } elsif ( m~^Depends:~ ) {
398
            $_ = "Depends: $depData";
399
            $depData = '';
407 dpurdie 400
        }
401
        print DF $_ , "\n";
402
    }
4635 dpurdie 403
 
407 dpurdie 404
    close (SF);
405
    close (DF);
4635 dpurdie 406
 
407
    #
408
    #   Warn if Depends section is needed
409
    #
410
    Error ("No Depends section seen in user control file") 
411
        if ($depData);
407 dpurdie 412
}
413
 
414
#-------------------------------------------------------------------------------
415
# Function        : CreateControlFile
416
#
417
# Description     : Craete a basic debian control file
418
#
419
# Inputs          : Uses global variables
420
#
421
# Returns         : 
422
#
423
sub CreateControlFile
424
{
425
    my $dst = "$DebianWorkDir/DEBIAN/control";
426
 
427
    Verbose ("CreateControlFile: $dst" );
428
 
4635 dpurdie 429
    my $depData = join (',', @DependencyList );
430
 
407 dpurdie 431
    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");
4105 dpurdie 432
    print DF "Package: $opt_name\n";
407 dpurdie 433
    print DF "Version: $opt_buildversion\n";
434
    print DF "Section: main\n";
435
    print DF "Priority: standard\n";
3921 dpurdie 436
    print DF "Architecture: $opt_pkgarch\n";
437
    print DF "Essential: No\n";
438
    print DF "Maintainer: Vix Technology\n";
407 dpurdie 439
    print DF "Description: $opt_description\n";
4635 dpurdie 440
    print DF "Depends: $depData\n" if ($depData);
441
 
407 dpurdie 442
    close (DF);
443
}
444
 
445
#-------------------------------------------------------------------------------
446
# Function        : SetVerbose
447
#
448
# Description     : Set the level of verbosity
449
#                   Display activity
450
#
451
# Inputs          : Verbosity level
452
#                       0 - Use makefile verbosity (Default)
453
#                       1..2
454
#
455
# Returns         : 
456
#
457
sub SetVerbose
458
{
459
    my ($level) = @_;
460
 
461
    $level = $opt_verbose unless ( $level );
462
    $opt_verbose = $level;
463
    ErrorConfig( 'verbose' => $level);
464
}
465
 
466
 
467
#-------------------------------------------------------------------------------
468
# Function        : DebianFiles
469
#
470
# Description     : Name Debian builder control files
471
#                   May be called multiple times
472
#
473
# Inputs          : Options
474
#                       --Control=file
475
#                       --PreRm=file
476
#                       --PostRm=file
477
#                       --PreInst=file
478
#                       --PostInst=file
4635 dpurdie 479
#                         
407 dpurdie 480
#
481
# Returns         : Nothing
482
#
483
sub DebianFiles
484
{
485
    #
4635 dpurdie 486
    #   Extract names
407 dpurdie 487
    #
488
    Verbose ("Specify Debian Control Files and Scripts");
489
    foreach  ( @_ )
490
    {
4635 dpurdie 491
        if ( m/^--Control=(.+)/i ) {
492
            DebianControlFile('control',$1)
407 dpurdie 493
 
4635 dpurdie 494
        } elsif ( m/^--PreRm=(.+)/i ) {
495
            DebianControlFile('prerm',$1)
407 dpurdie 496
 
4635 dpurdie 497
        } elsif ( m/^--PostRm=(.+)/i ) {
498
            DebianControlFile('postrm',$1)
407 dpurdie 499
 
4635 dpurdie 500
        } elsif ( m/^--PreInst=(.+)/i ) {
501
            DebianControlFile('preinst',$1)
407 dpurdie 502
 
4635 dpurdie 503
        } elsif ( m/^--PostInst=(.+)/i ) {
504
            DebianControlFile('postinst',$1)
407 dpurdie 505
 
506
        } else {
507
            Error ("DebianFiles: Unknown option: $_");
508
        }
509
    }
510
}
511
 
512
#-------------------------------------------------------------------------------
4635 dpurdie 513
# Function        : DebianControlFile 
514
#
515
# Description     : Add special control files to the Debian Installer 
516
#                   Not useful for embedded installers
517
#
518
#                   More general than DebianFiles()
519
#
520
# Inputs          : name            - Target Name
521
#                                     If the name starts with 'package.' then it will be replaced
522
#                                     with the name of the current package
523
#                   file            - Source File Name
524
#
525
# Returns         : 
526
#
527
sub DebianControlFile
528
{
529
    my ($name, $file, $misc) = @_;
530
    Error ("DebianControlFile: Unknown argument: $misc") if defined $misc;
531
 
532
    #
533
    #   Some control files need to have the package name prepended
534
    #
535
    $name =~ s~^package\.~$opt_name.~;
536
 
537
    #
538
    #   Only allow one file of each type
539
    #       Try to protect the user by testing for names by lowercase
540
    #
541
    my $simpleName = lc($name);
542
    Error("DebianControlFile: Multiple definitions for '$name' not allowed")
543
        if (exists $DebianControlFileNames{$simpleName});
544
 
545
    Error("DebianControlFile: $name. File not found", "Control target: $name", "File not found: $file")
546
        unless (-f $file);
547
 
548
    #
549
    #   Add info to data structures
550
    #
551
    $DebianControlFiles{$name} = $file;
552
    $DebianControlFileNames{$simpleName} = $name;
553
}
554
 
555
#-------------------------------------------------------------------------------
556
# Function        : DebianDepends 
557
#
558
# Description     : This directive allows simple dependency information to be  
559
#                   inserted into the control file
560
#
561
#                   Note useful in embedded system
562
#
563
# Inputs          : Entry             - A dependency entry
564
#                   ...               - More entries
565
#                   
566
#
567
# Returns         : Nothing
568
#
569
sub DebianDepends
570
{
571
    push @DependencyList, @_;
572
}
573
 
574
 
575
#-------------------------------------------------------------------------------
407 dpurdie 576
# Function        : PackageDescription
577
#
578
# Description     : Specify the Package Description
579
#                   Keep it short
580
#
581
# Inputs          : $description
582
#
583
# Returns         : 
584
#
585
sub PackageDescription
586
{
587
    ($opt_description) = @_;
588
}
589
 
590
#-------------------------------------------------------------------------------
591
# Function        : MakeSymLink
592
#
593
# Description     : Create a symlink - with error detection
594
#
595
# Inputs          : old_file    - Link Target
596
#                                 Path to the link target
597
#                                 If an ABS path is provided, the routine will
598
#                                 attempt to create a relative link.
599
#                   new_file    - Relative to the output work space
600
#                                 Path to where the 'link' file will be created
601
#                   Options     - Must be last
602
#                                 --NoClean         - Don't play with links
603
#                                 --NoDotDot        - Don't create symlinks with ..
604
#
605
# Returns         : Nothing
606
#
607
sub MakeSymLink
608
{
609
    my $no_clean;
610
    my $no_dot;
611
    my @args;
612
 
613
    #
614
    #   Extract options
615
    #
616
    foreach ( @_ )
617
    {
618
        if ( m/^--NoClean/i ) {
619
            $no_clean = 1;
620
 
621
        } elsif ( m/^--NoDotDot/i ) {
622
            $no_dot = 1;
623
 
624
        } elsif ( m/^--/ ) {
625
            Error ("MakeSymLink: Unknown option: $_");
626
 
627
        } else {
628
            push @args, $_;
629
        }
630
    }
631
 
632
    my ($old_file, $new_file) = @args;
633
 
634
    my $tfile = $DebianWorkDir . '/' . $new_file;
635
    $tfile =~ s~//~/~;
636
    Verbose ("Symlink $old_file -> $new_file" );
637
 
638
    #
639
    #   Create the directory in which the link will be placed
640
    #   Remove any existing file of the same name
641
    #
642
    my $dir = StripFileExt( $tfile );
643
    mkpath( $dir) unless -d $dir;
644
    unlink $tfile;
645
 
646
    #
647
    #   Determine a good name of the link
648
    #   Convert to a relative link in an attempt to prune them
649
    #
650
    my $sfile = $old_file;
651
    unless ( $no_clean )
652
    {
653
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
654
        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );
655
    }
656
 
657
    my $result = symlink $sfile, $tfile;
658
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
659
}
660
 
661
#-------------------------------------------------------------------------------
662
# Function        : CopyFile
663
#
664
# Description     : Copy a file to a target dir
665
#                   Used for text files, or files with fixed names
666
#
667
# Inputs          : $src
668
#                   $dst_dir    - Within the output workspace
669
#                   $dst_name   - Output Name [Optional]
670
#                   Options     - Common Copy Options
671
#
672
# Returns         : Full path to destination file
673
#
674
sub CopyFile
675
{
676
    CopyFileCommon( \&ResolveFile, @_ );
677
}
678
 
679
#-------------------------------------------------------------------------------
680
# Function        : CopyBinFile
681
#
682
# Description     : Copy a file to a target dir
683
#                   Used for executable programs. Will look in places where
684
#                   programs are stored.
685
#
686
# Inputs          : $src
687
#                   $dst_dir    - Within the output workspace
688
#                   $dst_name   - Output Name [Optional]
689
#
690
#                   Options:
691
#                       --FromPackage
692
#                       --SoftLink=xxxx
693
#                       --LinkFile=xxxx
694
#
695
#
696
# Returns         : Full path to destination file
697
#
698
sub CopyBinFile
699
{
700
    CopyFileCommon( \&ResolveBinFile, @_ );
701
}
702
 
703
#-------------------------------------------------------------------------------
704
# Function        : CopyLibFile
705
#
706
# Description     : Copy a file to a target dir
707
#                   Used for shared programs. Will look in places where
708
#                   shared libraries are stored.
709
#
710
# Inputs          : $src        - Base for 'realname' (no lib, no extension)
711
#                   $dst_dir    - Within the output workspace
712
#                   $dst_name   - Output Name [Optional, but not suggested]
713
#
714
# Returns         : Full path to destination file
715
#
716
# Notes           : Copying 'lib' files
717
#                   These are 'shared libaries. There is no provision for copying
718
#                   static libraries.
719
#
720
#                   The tool will attempt to copy a well-formed 'realname' library
721
#                   The soname of the library should be constructed on the target
722
#                   platform using ldconfig.
723
#                   There is no provision to copy the 'linker' name
724
#
725
#                   Given a request to copy a library called 'fred', then the
726
#                   well formed 'realname' will be:
727
#                           libfred[P|D|]].so.nnnnn
728
#                   where:
729
#                           nnnn is the library version
730
#                           [P|D|] indicates Production, Debug or None
731
#
732
#                   The 'soname' is held within the realname form of the library
733
#                   and will be created by lsconfig.
734
#
735
#                   The 'linkername' would be libfred[P|D|].so. This is only
736
#                   needed when linking against the library.
737
#
738
#
739
#                   The routine will also recognize Windows DLLs
740
#                   These are of the form fred[P|D|].nnnnn.dll
741
#
742
sub CopyLibFile
743
{
744
    CopyFileCommon( \&ResolveLibFile, @_ );
745
}
746
 
747
#-------------------------------------------------------------------------------
748
# Function        : CopyFileCommon
749
#
750
# Description     : Common ( internal File Copy )
751
#
752
# Inputs          : $resolver           - Ref to function to resolve source file
753
#                   $src                - Source File Name
754
#                   $dst_dir            - Target Dir
755
#                   $dst_name           - Target Name (optional)
756
#                   Options
757
#                   Options:
758
#                       --FromPackage
759
#                       --SoftLink=xxxx
760
#                       --LinkFile=xxxx
761
#
762
# Returns         : 
763
#
764
sub CopyFileCommon
765
{
766
    my $from_package = 0;
767
    my $isa_linkfile = 0;
768
    my @llist;
769
    my @args;
770
 
771
    #
772
    #   Parse options
773
    #
774
    foreach ( @_ )
775
    {
776
        if ( m/^--FromPackage/ ) {
777
            $from_package = 1;
778
 
779
        } elsif ( m/^--LinkFile/ ) {
780
            $isa_linkfile = 1;
781
 
782
        } elsif ( m/^--SoftLink=(.+)/ ) {
783
            push @llist, $1;
784
 
785
        } elsif ( m/^--/ ) {
786
            Error ("FileCopy: Unknown option: $_");
787
 
788
        } else {
789
            push @args, $_;
790
        }
791
    }
792
 
793
    #
794
    #   Extract non-options.
795
    #   These are the bits that are left over
796
    #
797
    my ($resolver, $src, $dst_dir, $dst_name ) = @args;
798
 
799
    #
800
    #   Clean up dest_dir. Must start with a / and not end with one
801
    #
802
    $dst_dir = "/$dst_dir/";
803
    $dst_dir =~ s~/+~/~g;
804
    $dst_dir =~ s~/$~~;
805
 
806
    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));
807
    foreach $src ( &$resolver( $from_package, $src ) )
808
    {
809
        my $dst_fname = $dst_name ? $dst_name : StripDir($src);
810
        my $dst_file = "$dst_dir/$dst_fname";
811
        Verbose ("CopyFile: Copy $src, $dst_file" );
812
 
813
 
814
        #
815
        #   LinkFiles are special
816
        #   They get concatenated to any existing LINKS File
817
        #
818
        if ( $isa_linkfile )
819
        {
820
            CatFile ( $src, "$dst_dir/.LINKS" );
821
        }
822
        else
823
        {
824
            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);
825
            unlink ("$DebianWorkDir$dst_file");
826
            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );
827
 
828
            foreach my $lname ( @llist )
829
            {
830
                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
831
                MakeSymLink( $dst_file ,$lname);
832
            }
833
        }
834
    }
835
}
836
 
837
#-------------------------------------------------------------------------------
838
# Function        : CopyDir
839
#
840
# Description     : Copy a directory to a target dir
841
#
842
# Inputs          : $src_dir    - Local to the user
843
#                                 Symbolic Name
844
#                   $dst_dir    - Within the output workspace
845
#                   Options
423 dpurdie 846
#                       --Merge             - Don't delete first
847
#                       --Source=Name       - Source via Symbolic Name
4147 dpurdie 848
#                       --FromPackage       - Source via package roots
4152 dpurdie 849
#                       --NoIgnoreDbgFiles  - Do not ignore .dbg and .debug files in dir copy
850
#                       --IfPresent         - Not an error if the path cannot be found
407 dpurdie 851
#
852
# Returns         :
853
#
854
sub CopyDir
855
{
856
    my ($src_dir, $dst_dir, @opts) = @_;
857
    my $opt_merge;
858
    my $opt_base;
411 dpurdie 859
    my $from_interface = 0;
4152 dpurdie 860
    my $ignoreDbg = 1;
861
    my $ignoreNoDir;
862
    my $user_src_dir = $src_dir;
863
    my $opt_source;
864
    my $opt_package;
407 dpurdie 865
 
866
    $dst_dir = $DebianWorkDir . '/' . $dst_dir;
867
    $dst_dir =~ s~//~/~;
868
 
869
    #
4152 dpurdie 870
    #   Scan and collect user options
407 dpurdie 871
    #
872
    foreach  ( @opts )
873
    {
4152 dpurdie 874
        Verbose2 ("CopyDir: $_");
407 dpurdie 875
        if ( m/^--Merge/ ) {
876
            $opt_merge = 1;
4152 dpurdie 877
 
407 dpurdie 878
        } elsif ( m/^--Source=(.+)/ ) {
425 dpurdie 879
            Error ("Source directory can only be specified once")
4152 dpurdie 880
                if ( defined $opt_source );
881
            $opt_source = $1;
425 dpurdie 882
 
4152 dpurdie 883
        } elsif ( m/^--FromPackage/ ) {
884
            Error ("FromPackage can only be specified once")
885
                if ( defined $opt_package );
886
            $opt_package = 1;
887
 
888
        } elsif ( m/^--NoIgnoreDbgFiles/ ) {
889
            $ignoreDbg = 0;
890
 
891
        } elsif ( m/^--IfPresent/ ) {
892
            $ignoreNoDir = 1;
407 dpurdie 893
 
4152 dpurdie 894
        } else {
895
            Error ("CopyDir: Unknown option: $_" );
896
        }
897
    }
411 dpurdie 898
 
4152 dpurdie 899
    #
900
    #   All options have been gathered. Now process some of them
901
    #
902
    Error ("CopyDir: Cannot use both --Source and --FromPackage: $src_dir") if ($opt_source && $opt_package);
425 dpurdie 903
 
4152 dpurdie 904
    #
905
    #   Convert a symbolic path into a physical path
906
    #
907
    if ($opt_source)
908
    {
909
        Verbose2 ("CopyDir: Determine Source: $opt_source");
425 dpurdie 910
 
4152 dpurdie 911
        $opt_source = lc($opt_source);
912
        my %CopyDirSymbolic = (
913
            'interfaceincdir'   => $opt_interfaceincdir,
914
            'interfacelibdir'   => $opt_interfacelibdir,
915
            'interfacebindir'   => $opt_interfacebindir,
916
            'libdir'            => $opt_libdir,
917
            'bindir'            => $opt_bindir,
918
            'localincdir'       => $opt_localincdir,
919
            'locallibdir'       => $opt_locallibdir,
920
            'localbindir'       => $opt_localbindir,
921
            'packagebindir'     => $opt_pkgbindir,
922
            'packagelibdir'     => $opt_pkglibdir,
923
            'packagepkgdir'     => $opt_pkgpkgdir,
924
            'packagedir'        => $opt_pkgdir,
925
        );
425 dpurdie 926
 
4152 dpurdie 927
        if ( exists $CopyDirSymbolic{$opt_source} )
928
        {
929
            $opt_base = $CopyDirSymbolic{$opt_source};
425 dpurdie 930
 
931
            #
4152 dpurdie 932
            #   If sourceing from interface, then follow
933
            #   symlinks in the copy. All files will be links anyway
425 dpurdie 934
            #
935
            $from_interface = 1
4152 dpurdie 936
                if ( $opt_source =~ m~^interface~ );
937
        }
938
        else
939
        {
940
            DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);
941
            Error ("CopyDir: Unknown Source Name: $opt_source" );
942
        }
943
    }
425 dpurdie 944
 
4152 dpurdie 945
    #
946
    #   Locate the path within an external package
947
    #
948
    if ($opt_package)
949
    {
950
        Verbose2 ("CopyDir: FromPackage: $src_dir");
4147 dpurdie 951
 
4152 dpurdie 952
        my @path;
953
        foreach my $entry ( getPackageList() )
954
        {
955
            my $base = $entry->getBase(3);
956
            next unless ( defined $base );
957
            if ( -d $base . '/' . $src_dir )
958
            {
959
                push @path, $base;
960
                $from_interface = 1
961
                    if ( $entry->{'TYPE'} eq 'interface' );
962
            }
407 dpurdie 963
        }
4152 dpurdie 964
 
965
        if ( $#path < 0 )
966
        {
967
            Error ("CopyDir: Cannot find source dir in any package: $user_src_dir") unless ($ignoreNoDir);
968
            Message ("CopyDir: Optional path not found: $user_src_dir");
969
            return;
970
        }
971
 
972
        Error ("CopyDir: Requested path found in mutiple packages: $user_src_dir",
973
                @path ) if ( $#path > 0 );
974
        $opt_base = pop @path;
975
 
976
        #
977
        #   If sourceing from interface, then follow symlinks in the copy.
978
        #   All files will be links anyway
979
        #
980
        #   This is a very ugly test for 'interface'
981
        #
982
        $from_interface = 1
983
            if ( $opt_base =~ m~/interface/~ );
984
 
407 dpurdie 985
    }
986
 
4152 dpurdie 987
    #
988
    #   Create the full source path
989
    #   May be: from a package, from a known directoru, from a local directory
990
    #
991
 
407 dpurdie 992
    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );
993
    $src_dir =~ s~//~/~g;
994
    $src_dir =~ s~/$~~;
995
 
996
    Verbose ("CopyDir: $src_dir, $dst_dir");
4152 dpurdie 997
    unless ( -d $src_dir )
998
    {
999
        Error ("CopyDir: Directory not found: $user_src_dir") unless ($ignoreNoDir);
1000
        Message ("CopyDir: Optional path not found: $user_src_dir");
1001
        return;
1002
    }
407 dpurdie 1003
 
1004
    #
423 dpurdie 1005
    #   Setup the copy options
407 dpurdie 1006
    #
423 dpurdie 1007
    my %copyOpts;
4101 dpurdie 1008
    $copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];
1009
    $copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];
4147 dpurdie 1010
    push (@{$copyOpts{'Ignore'}}, '*.debug', '*.dbg') if $ignoreDbg;
423 dpurdie 1011
    $copyOpts{'EmptyDirs'} = 1;
1012
    $copyOpts{'DeleteFirst'} = 1 unless $opt_merge;
1013
    $copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );
1014
    $copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );
407 dpurdie 1015
 
1016
    #
423 dpurdie 1017
    #   Transfer the directory
407 dpurdie 1018
    #
423 dpurdie 1019
    JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );
407 dpurdie 1020
 
1021
    #
1022
    #   Expand link files that may have been copied in
1023
    #
1024
    Verbose ("Locate LINKFILES in $DebianWorkDir");
1025
    ExpandLinkFiles();
1026
}
1027
 
1028
#-------------------------------------------------------------------------------
1029
# Function        : AddInitScript
1030
#
1031
# Description     : Add an Init Script to the target
1032
#                   Optionally create start and stop links
1033
#
1034
# Inputs          : $script     - Name of the init script
1035
#                   $start      - Start Number
1036
#                   $stop       - Stop Number
1037
#                   Options:
1038
#                       --NoCopy        - Don't copy the script, just add links
1039
#                       --Afc           - Place in AFC init area
1040
#                       --FromPackage   - Source is in a package
1041
#
1042
# Returns         : 
1043
#
1044
sub AddInitScript
1045
{
1046
    my $no_copy;
1047
    my $basedir = "";
1048
    my @args;
1049
    my $from_package = 0;
1050
 
4302 dpurdie 1051
    # This directive is only available on the VIX platforms
1052
    #   Kludgey test - at the moment
407 dpurdie 1053
    #
4302 dpurdie 1054
    if ($opt_pkgarch =~ m~i386~)
1055
    {
1056
        Error ("AddInitScript is not supported on this platform"); 
1057
    }
1058
 
1059
    #
407 dpurdie 1060
    #   Process and Remove options
1061
    #
1062
    foreach  ( @_ )
1063
    {
1064
        if ( m/^--NoCopy/ ) {
1065
            $no_copy = 1;
1066
 
1067
        } elsif ( m/^--Afc/ ) {
1068
            $basedir = "/afc";
1069
 
1070
        } elsif ( m/^--FromPackage/ ) {
1071
            $from_package = 1;
1072
 
1073
        } elsif ( m/^--/ ) {
1074
            Error ("AddInitScript: Unknown option: $_");
1075
 
1076
        } else {
1077
            push @args, $_;
1078
 
1079
        }
1080
    }
1081
 
1082
    my( $script, $start, $stop ) = @args;
1083
    Error ("No script file specified") unless ( $script );
1084
    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );
1085
    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));
1086
    $script = ResolveFile($from_package, $script );
1087
 
1088
    my $tdir = $basedir . "/etc/init.d/init.d";
1089
    my $base = StripDir($script);
1090
 
1091
    CopyFile( $script, $tdir ) unless $no_copy;
1092
 
1093
    my $link;
1094
    if ( $start )
1095
    {
1096
        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );
1097
        MakeSymLink( "$tdir/$base", $link);
1098
    }
1099
 
1100
    if ( $stop )
1101
    {
1102
        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );
1103
        MakeSymLink( "$tdir/$base", $link);
1104
    }
1105
}
1106
 
1107
#-------------------------------------------------------------------------------
1108
# Function        : CatFile
1109
#
1110
# Description     : Copy a file to the end of a file
1111
#
1112
# Inputs          : $src
1113
#                   $dst    - Within the output workspace
1114
#
1115
# Returns         :
1116
#
1117
sub CatFile
1118
{
1119
    my ($src, $dst) = @_;
1120
 
1121
    $dst = $DebianWorkDir . '/' . $dst;
1122
    $dst =~ s~//~/~;
1123
    Verbose ("CatFile: $src, $dst");
1124
    $src = ResolveFile(0, $src );
1125
 
1126
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
1127
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
1128
    while ( <SF> )
1129
    {
1130
        print DF $_;
1131
    }
1132
    close (SF);
1133
    close (DF);
1134
}
1135
 
1136
#-------------------------------------------------------------------------------
1137
# Function        : EchoFile
1138
#
1139
# Description     : Echo simple text to a file
1140
#
1141
# Inputs          : $file   - Within the output workspace
1142
#                   $text
1143
#
1144
# Returns         : 
1145
#
1146
sub EchoFile
1147
{
1148
    my ($file, $text) = @_;
1149
    Verbose ("EchoFile: $file");
1150
 
1151
    $file = $DebianWorkDir . '/' . $file;
1152
    $file =~ s~//~/~;
1153
 
1154
    unlink $file;
1155
    open (DT, ">", $file ) || Error ("Cannot create $file");
1156
    print DT  $text || Error ("Cannot print to $file");
1157
    close DT;
1158
}
1159
 
1160
#-------------------------------------------------------------------------------
1161
# Function        : SetFilePerms
1162
#
1163
# Description     : Set file permissions on one or more files or directories
1164
#
1165
# Inputs          : $perm           - Perm Mask
1166
#                   @paths          - List of paths/files to process
1167
#                   Options
1168
#                       --Recurse   - Recurse subdirs
1169
#
1170
# Returns         : 
1171
#
1172
sub SetFilePerms
1173
{
1174
 
1175
    my @args;
1176
    my $perms;
1177
    my $recurse = 0;
1178
 
1179
    #
1180
    #   Process and Remove options
1181
    #
1182
    foreach  ( @_ )
1183
    {
1184
        if ( m/^--Recurse/ ) {
1185
            $recurse = 1;
1186
 
1187
        } elsif ( m/^--/ ) {
1188
            Error ("SetFilePerms: Unknown option: $_");
1189
 
1190
        } else {
1191
            push @args, $_;
1192
 
1193
        }
1194
    }
1195
 
1196
    $perms = shift @args;
1197
    Error ("SetFilePerms: No Permissions" ) unless ( $perms );
1198
 
1199
    foreach my $path ( @args )
1200
    {
1201
        Verbose ("Set permissions; $perms, $path");
1202
        my $full_path = $DebianWorkDir . '/' . $path;
1203
        if ( -f $full_path )
1204
        {
1205
            System ('chmod', $perms, $full_path );
1206
        }
1207
        elsif ( -d $full_path )
1208
        {
1209
            System ('chmod', '-R', $perms, $full_path ) if ($recurse);
1210
            System ('chmod', $perms, $full_path ) unless ($recurse);
1211
        }
1212
        else
1213
        {
1214
            Warning("SetFilePerms: Path not found: $path");
1215
        }
1216
    }
1217
}
1218
 
1219
#-------------------------------------------------------------------------------
1220
# Function        : CreateDir
1221
#
1222
# Description     : Create a directory within the target workspace
1223
#
1224
# Inputs          : $path           - Name of the target directory
1225
#
1226
# Returns         : Nothing
1227
#
1228
sub CreateDir
1229
{
1230
    my ($path) = @_;
1231
 
1232
    Verbose ("Create Dir: $path");
1233
    mkpath( $DebianWorkDir . '/' . $path );
1234
}
1235
 
1236
#-------------------------------------------------------------------------------
1237
# Function        : IsProduct
1238
#                   IsPlatform
1239
#                   IsTarget
427 dpurdie 1240
#                   IsVariant
407 dpurdie 1241
#
1242
# Description     : This function allows some level of control in the
1243
#                   packaging scripts. It will return true if the current
1244
#                   product is listed.
1245
#
1246
#                   Ugly after thought
1247
#
1248
#                   Intended use:
1249
#                       Xxxxxx(...) if (IsProduct( 'aaa',bbb' );
1250
#
1251
# Inputs          : products    - a list of products to compare against
1252
#
1253
# Returns         : True if the current build is for one of the listed products
1254
#
1255
sub IsProduct
1256
{
1257
    foreach ( @_ )
1258
    {
1259
        return 1 if ( $opt_product eq $_ );
1260
    }
1261
    return 0;
1262
}
1263
 
1264
sub IsPlatform
1265
{
1266
    foreach ( @_ )
1267
    {
1268
        return 1 if ( $opt_platform eq $_ );
1269
    }
1270
    return 0;
1271
}
1272
 
1273
sub IsTarget
1274
{
1275
    foreach ( @_ )
1276
    {
1277
        return 1 if ( $opt_target eq $_ );
1278
    }
1279
    return 0;
1280
}
1281
 
427 dpurdie 1282
sub IsVariant
1283
{
1284
    foreach ( @_ )
1285
    {
1286
        return 1 if ( $opt_variant eq $_ );
1287
    }
1288
    return 0;
1289
}
407 dpurdie 1290
 
1291
#-------------------------------------------------------------------------------
1292
# Function        : FindFiles
1293
#
1294
# Description     : Locate files within a given dir tree
1295
#
1296
# Inputs          : $root           - Base of the search
1297
#                   $match          - Re to match
1298
#
1299
# Returns         : A list of files that match
1300
#
1301
my @FIND_LIST;
1302
my $FIND_NAME;
1303
 
1304
sub FindFiles
1305
{
1306
    my ($root, $match ) = @_;
1307
    Verbose2("FindFiles: Root: $root, Match: $match");
1308
 
1309
    #
1310
    #   Becareful of closure, Must use globals
1311
    #
1312
    @FIND_LIST = ();
1313
    $FIND_NAME = $match;
1314
    File::Find::find( \&find_files, $root);
1315
 
1316
    #
1317
    #   Find callback program
1318
    #
1319
    sub find_files
1320
    {
1321
        my $item =  $File::Find::name;
1322
 
1323
        return if ( -d $File::Find::name );
1324
        return unless ( $_ =~ m~$FIND_NAME~ );
1325
        push @FIND_LIST, $item;
1326
    }
1327
    return @FIND_LIST;
1328
}
1329
 
1330
#-------------------------------------------------------------------------------
1331
# Function        : CalcRelPath
1332
#
1333
# Description     : Return the relative path to the current working directory
1334
#                   as provided in $Cwd
1335
#
1336
# Inputs          : $Cwd - Base dir
1337
#                   $base - Path to convert
1338
#
1339
# Returns         : Relative path from the $Cwd
1340
#
1341
sub CalcRelPath
1342
{
1343
    my ($Cwd, $base) = @_;
1344
 
1345
    my @base = split ('/', $base );
1346
    my @here = split ('/', $Cwd );
1347
    my $result;
1348
 
1349
    Debug("RelPath: Source: $base");
1350
 
1351
    return $base unless ( $base =~ m~^/~ );
1352
 
1353
    #
1354
    #   Remove common bits from the head of both lists
1355
    #
1356
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
1357
    {
1358
        shift @base;
1359
        shift @here;
1360
    }
1361
 
1362
    #
1363
    #   Need to go up some directories from here and then down into base
1364
    #
1365
    $result = '../' x ($#here + 1);
1366
    $result .= join ( '/', @base);
1367
    $result = '.' unless ( $result );
1368
    $result =~ s~//~/~g;
1369
    $result =~ s~/$~~;
1370
 
1371
    Debug("RelPath: Result: $result");
1372
    return $result;
1373
}
1374
 
1375
#-------------------------------------------------------------------------------
1376
# Function        : ExpandLinkFiles
1377
#
1378
# Description     : Look for .LINK files in the output image and expand
1379
#                   the links into softlinks
1380
#
1381
# Inputs          : None
1382
#                   The rouine works on the $DebianWorkDir directory tree
1383
#
1384
# Returns         : Nothing
1385
#                   Will remove .LINKS files that are processed
1386
#
1387
sub ExpandLinkFiles
1388
{
1389
    foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))
1390
    {
1391
        next if ( $linkfile =~ m~/\.svn/~ );
1392
        my $BASEDIR = StripFileExt( $linkfile );
1393
        $BASEDIR =~ s~^$DebianWorkDir/~~;
1394
        Verbose "Expand links: $BASEDIR";
1395
 
1396
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
1397
        while ( <LF> )
1398
        {
1399
            chomp;
1400
            next if ( m~^#~ );
1401
            next unless ( $_ );
1402
            my ($link, $file) = split;
1403
 
1404
            MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
1405
        }
1406
        close (LF);
1407
        unlink $linkfile;
1408
    }
1409
}
1410
 
1411
#-------------------------------------------------------------------------------
1412
# Function        : ResolveFile
1413
#
1414
# Description     : Determine where the source for a file is
415 dpurdie 1415
#                   Will look in (default):
407 dpurdie 1416
#                       Local directory
1417
#                       Local Include
415 dpurdie 1418
#                   Or  (FromPackage)
1419
#                       Our Package directory
1420
#                       Interface directory (BuildPkgArchives)
1421
#                       Packages (LinkPkgArchive)
1422
#
407 dpurdie 1423
#                   Will scan 'parts' subdirs
1424
#
1425
# Inputs          : $from_package       - 0 - Local File
1426
#                   $file
1427
#
1428
# Returns         : Path
1429
#
1430
sub ResolveFile
1431
{
1432
    my ($from_package, $file) = @_;
1433
    my $wildcard = ($file =~ /[*?]/);
415 dpurdie 1434
    my @path;
407 dpurdie 1435
 
1436
    #
415 dpurdie 1437
    #   Determine the paths to search
1438
    #
1439
    if ( $from_package )
1440
    {
1441
        unless ( @ResolveFileList )
1442
        {
1443
            push @ResolveFileList, $opt_pkgdir;
1444
            foreach my $entry ( getPackageList() )
1445
            {
1446
                push @ResolveFileList, $entry->getBase(3);
1447
            }
1448
        }
1449
        @path = @ResolveFileList;
1450
    }
1451
    else
1452
    {
1453
        @path = ('.', $opt_localincdir);
1454
    }
1455
 
1456
    #
407 dpurdie 1457
    #   Determine a full list of 'parts' to search
1458
    #   This is provided within the build information
1459
    #
1460
    my @parts = getPlatformParts ();
1461
    push @parts, '';
1462
 
1463
    my @done;
1464
    foreach my $root (  @path )
1465
    {
1466
        foreach my $subdir ( @parts )
1467
        {
1468
            my $sfile;
415 dpurdie 1469
            $sfile = "$root/$subdir/$file";
1470
            $sfile =~ s~//~/~g;
1471
            $sfile =~ s~^./~~g;
1472
            Verbose2("LocateFile: $sfile, $root, $subdir");
1473
            if ( $wildcard )
1474
            {
1475
                push @done, glob ( $sfile );
1476
            }
1477
            else
1478
            {
1479
                push @done, $sfile if ( -f $sfile || -l $sfile )
1480
            }
407 dpurdie 1481
        }
1482
    }
1483
 
415 dpurdie 1484
    Error ("ResolveFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1485
        unless ( @done );
1486
 
1487
    Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)
1488
        if ( $#done > 0 && ! $wildcard && !wantarray );
1489
 
1490
    return wantarray ? @done : $done[0];
1491
}
1492
 
1493
#-------------------------------------------------------------------------------
1494
# Function        : ResolveBinFile
1495
#
415 dpurdie 1496
# Description     : Determine where the source for a BIN file is
1497
#                   Will look in (default):
1498
#                       Local directory
1499
#                       Local Include
1500
#                   Or  (FromPackage)
1501
#                       Our Package directory
1502
#                       Interface directory (BuildPkgArchives)
1503
#                       Packages (LinkPkgArchive)
407 dpurdie 1504
#                   Will scan 'parts' subdirs
1505
#
1506
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1507
#                   $file
407 dpurdie 1508
#
1509
# Returns         : Path
1510
#
1511
sub ResolveBinFile
1512
{
1513
    my ($from_package, $file) = @_;
1514
    my @path;
1515
    my @types;
1516
    my $wildcard = ($file =~ /[*?]/);
1517
 
415 dpurdie 1518
    #
1519
    #   Determine the paths to search
1520
    #
407 dpurdie 1521
    if ( $from_package )
1522
    {
415 dpurdie 1523
        unless ( @ResolveBinFileList )
1524
        {
1525
            push @ResolveBinFileList, $opt_pkgdir . '/bin';
1526
            foreach my $entry ( getPackageList() )
1527
            {
1528
                if ( my $path = $entry->getBase(3) )
1529
                {
1530
                    $path .= '/bin';
1531
                    push @ResolveBinFileList, $path if ( -d $path );
1532
                }
1533
            }
1534
        }
1535
        @path = @ResolveBinFileList;
407 dpurdie 1536
        @types = ($opt_type, '');
1537
    }
1538
    else
1539
    {
1540
        @path = ($opt_bindir, $opt_localbindir);
1541
        @types = '';
1542
    }
1543
 
1544
    #
1545
    #   Determine a full list of 'parts' to search
1546
    #   This is provided within the build information
1547
    #
1548
    my @parts = getPlatformParts ();
1549
    push @parts, '';
1550
 
1551
    my @done;
1552
    foreach my $root (  @path )
1553
    {
1554
        foreach my $subdir ( @parts )
1555
        {
1556
            foreach my $type ( @types )
1557
            {
1558
                my $sfile;
1559
                $sfile = "$root/$subdir$type/$file";
1560
                $sfile =~ s~//~/~g;
1561
                Verbose2("LocateBinFile: $sfile");
1562
                if ( $wildcard )
1563
                {
429 dpurdie 1564
                    foreach  ( glob ( $sfile ) )
1565
                    {
4143 dpurdie 1566
                        # Ignore .dbg (vix) and .debug (qt) files.
429 dpurdie 1567
                        next if ( m~\.dbg$~ );
4143 dpurdie 1568
                        next if ( m~\.debug$~ );
429 dpurdie 1569
                        push @done, $_;
1570
                    }
407 dpurdie 1571
                }
1572
                else
1573
                {
415 dpurdie 1574
                    push @done, $sfile if ( -f $sfile || -l $sfile )
407 dpurdie 1575
                }
1576
            }
1577
        }
1578
    }
1579
 
415 dpurdie 1580
    Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1581
        unless ( @done );
1582
 
1583
    Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done)
1584
        if ( $#done > 0 && ! $wildcard && !wantarray );
1585
    return wantarray ? @done : $done[0];
1586
}
1587
 
1588
#-------------------------------------------------------------------------------
1589
# Function        : ResolveLibFile
1590
#
415 dpurdie 1591
# Description     : Determine where the source for a LIB file is
1592
#                   Will look in (default):
1593
#                       Local directory
1594
#                       Local Include
1595
#                   Or  (FromPackage)
1596
#                       Our Package directory
1597
#                       Interface directory (BuildPkgArchives)
1598
#                       Packages (LinkPkgArchive)
407 dpurdie 1599
#                   Will scan 'parts' subdirs
1600
#
1601
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1602
#                   $file       - Basename for a 'realname'
407 dpurdie 1603
#                                 Do not provide 'lib' or '.so' or version info
1604
#                                 May contain embedded options
1605
#                                   --Dll - use Windows style versioned DLL
1606
#                                   --VersionDll - USe the versioned DLL
1607
#
1608
# Returns         : Path
1609
#
1610
sub ResolveLibFile
1611
{
1612
    my ($from_package, $file) = @_;
1613
    my $wildcard = ($file =~ /[*?]/);
1614
    my @options;
1615
    my $num_dll;
415 dpurdie 1616
    my @path;
407 dpurdie 1617
    #
1618
    #   Extract options from file
1619
    #
409 alewis 1620
    $num_dll = 0;
407 dpurdie 1621
    ($file, @options) = split ( ',', $file);
1622
    foreach ( @options )
1623
    {
1624
        if ( m/^--Dll/ ) {
1625
            $num_dll = 1;
1626
        } elsif ( m/^--VersionDll/ ) {
1627
            $num_dll = 2;
1628
        } else {
1629
            Error ("Unknown suboption to ResolveLibFile: $_" );
1630
        }
1631
    }
1632
 
1633
    #
415 dpurdie 1634
    #   Determine the paths to search
1635
    #
1636
    if ( $from_package )
1637
    {
1638
        unless ( @ResolveLibFileList )
1639
        {
1640
            push @ResolveLibFileList, $opt_pkgdir . '/lib';
1641
            foreach my $entry ( getPackageList() )
1642
            {
1643
                push @ResolveLibFileList, $entry->getLibDirs(3);
1644
            }
1645
        }
1646
        @path = @ResolveLibFileList;
1647
    }
1648
    else
1649
    {
1650
        @path = ($opt_libdir, $opt_locallibdir);
1651
    }
1652
 
1653
    #
407 dpurdie 1654
    #   Determine a full list of 'parts' to search
1655
    #   This is provided within the build information
1656
    #
1657
    my @parts = getPlatformParts ();
1658
    push @parts, '';
1659
 
1660
    my @done;
1661
    foreach my $root (  @path )
1662
    {
1663
        foreach my $type ( $opt_type, '' )
1664
        {
1665
            foreach my $subdir ( @parts )
1666
            {
1667
                my $sfile;
1668
                my $exact;
1669
                if ( $num_dll == 2 ) {
1670
                    $sfile = $file . $type . '.*.dll' ;
1671
                } elsif ( $num_dll == 1 ) {
1672
                    $sfile = $file . $type . '.dll' ;
1673
                    $exact = 1;
1674
                } else {
1675
                    $sfile = "lib" . $file . $type . '.so.*';
1676
                }
1677
 
1678
                $sfile = "$root/$subdir/$sfile";
1679
                $sfile =~ s~//~/~g;
1680
                Verbose2("LocateLibFile: $sfile");
1681
                if ( $exact )
1682
                {
415 dpurdie 1683
                    push @done, $sfile if ( -f $sfile || -l $sfile );
407 dpurdie 1684
                }
419 dpurdie 1685
                elsif ($num_dll)
407 dpurdie 1686
                {
1687
                    push @done, glob ( $sfile );
1688
                }
419 dpurdie 1689
                else
1690
                {
1691
                    #
1692
                    #   Looking for .so files
1693
                    #   Filter out the soname so files
1694
                    #   Assume that the soname is shorter than the realname
4143 dpurdie 1695
                    #       Ignore .dbg (vix) and .debug (qt) files.
419 dpurdie 1696
                    #
1697
                    my %sieve;
1698
                    foreach ( glob ( $sfile )  )
1699
                    {
429 dpurdie 1700
                        next if ( m~\.dbg$~ );
4143 dpurdie 1701
                        next if ( m~\.debug$~ );
421 alewis 1702
                        m~(.*\.so\.)([\d\.]*\d)$~;
1703
                        if ( $1 )
1704
                        {
1705
                            my $file = $1;
1706
                            my $len = exists $sieve{$file} ? length($sieve{$file}) : 0;
1707
                            $sieve{$file} = $_
1708
                                if ( $len == 0 || length($_) > $len );
1709
                        }                                
419 dpurdie 1710
                    }
1711
 
1712
                    push @done, values %sieve;
1713
                }
407 dpurdie 1714
            }
1715
        }
1716
    }
1717
 
415 dpurdie 1718
    Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1719
        unless ( @done );
1720
 
1721
    Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done)
1722
        if ( $#done > 0 && ! $wildcard && !wantarray );
1723
 
1724
    return wantarray ? @done : $done[0];
1725
}
1726
 
1727
 
1728
#-------------------------------------------------------------------------------
1729
# Function        : AUTOLOAD
1730
#
1731
# Description     : Intercept bad user directives and issue a nice error message
1732
#                   This is a simple routine to report unknown user directives
1733
#                   It does not attempt to distinguish between user errors and
1734
#                   programming errors. It assumes that the program has been
1735
#                   tested. The function simply report filename and line number
1736
#                   of the bad directive.
1737
#
1738
# Inputs          : Original function arguments ( not used )
1739
#
1740
# Returns         : This function does not return
1741
#
1742
our $AUTOLOAD;
1743
sub AUTOLOAD
1744
{
1745
    my $fname = $AUTOLOAD;
1746
    $fname =~ s~^main::~~;
1747
    my ($package, $filename, $line) = caller;
1748
 
1749
    Error ("Directive not known or not allowed in this context: $fname",
1750
           "Directive: $fname( @_ );",
1751
           "File: $filename, Line: $line" );
1752
}
1753
 
1754
 
1755
1;
1756