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:
6088 dpurdie 33 
#                       Message                 - Display progress text
407 dpurdie 34 
#                       AddInitScript           - Add an init script
35 
#                       CatFile                 - Append to a file
4641 dpurdie 36 
#                       ConvertFile             - Convert file(s) to Unix or Dos Text
407 dpurdie 37 
#                       CopyDir                 - Copy directory tree
38 
#                       CopyFile                - Copy a file
39 
#                       CopyBinFile             - Copy an executable file
40 
#                       CopyLibFile             - Copy a library file
6088 dpurdie 41 
#                       CopyDebPackage          - Copy a Debian Package
407 dpurdie 42 
#                       CreateDir               - Create a directory
43 
#                       DebianFiles             - Specify control and script files
4636 dpurdie 44 
#                       DebianControlFile       - Specify control and script files
45 
#                       DebianDepends           - Add Depends entry to control file
407 dpurdie 46 
#                       EchoFile                - Place text into a file
47 
#                       MakeSymLink             - Create a symbolic link
48 
#                       PackageDescription      - Specify the package description
4641 dpurdie 49 
#                       ReplaceTags             - Replace Tags on target file
407 dpurdie 50 
#                       SetFilePerms            - Set file permissions
51 
#                       SetVerbose              - Control progress display
52 
#                       IsProduct               - Flow control
53 
#                       IsPlatform              - Flow control
54 
#                       IsTarget                - Flow control
427 dpurdie 55 
#                       IsVariant               - Flow control
6088 dpurdie 56 
#                       IsAlias                 - Flow control
407 dpurdie 57 
#
58 
#                 Thoughts for expansion:
59 
#                       SrcDir                  - Extend path for resolving local files
60 
#
61 
#                   Less used:
62 
#                        ExpandLinkFiles        - Expand .LINK files
63 
#
64 
#                   Internal Use:
65 
#                        FindFiles              - Find a file
66 
#                        ResolveFile            - Resolve a 'local' source file
4641 dpurdie 67 
#                        chmodItem              - Set file or directory permissions
407 dpurdie 68 
#
69 
#......................................................................#
70 
 
411 dpurdie 71 
require 5.006_001;
407 dpurdie 72 
use strict;
73 
use warnings;
74 
 
75 
use Getopt::Long;
76 
use File::Path;
77 
use File::Copy;
78 
use File::Find;
79 
use JatsSystem;
80 
use FileUtils;
81 
use JatsError;
4636 dpurdie 82 
use JatsLocateFiles;
407 dpurdie 83 
use ReadBuildConfig;
423 dpurdie 84 
use JatsCopy ();                            # Don't import anything
407 dpurdie 85 
 
86 
#
87 
#   Globals
88 
#
425 dpurdie 89 
my $DebianWorkDirBase;                      # Workspace
407 dpurdie 90 
my $DebianWorkDir;                          # Dir to create file system image within
91 
 
92 
#
93 
#   Command line options
94 
#
95 
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
96 
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
97 
my $opt_vargs;                              # Verbose arg
98 
my $opt_help = 0;
99 
my $opt_manual = 0;
100 
my $opt_clean = 0;
101 
my $opt_platform;
102 
my $opt_type;
103 
my $opt_buildname;
104 
my $opt_buildversion;
105 
my $opt_interfacedir;
106 
my $opt_target;
107 
my $opt_product;
108 
my $opt_package_script;
109 
my $opt_interfaceincdir;
110 
my $opt_interfacelibdir;
111 
my $opt_interfacebindir;
112 
my $opt_libdir;
113 
my $opt_bindir;
114 
my $opt_localincdir;
115 
my $opt_locallibdir;
116 
my $opt_localbindir;
117 
my $opt_pkgdir;
118 
my $opt_pkglibdir;
119 
my $opt_pkgbindir;
120 
my $opt_pkgpkgdir;
121 
my $opt_output;
417 dpurdie 122 
my $opt_name;
427 dpurdie 123 
my $opt_variant;
3921 dpurdie 124 
my $opt_pkgarch;
4740 dpurdie 125 
my $opt_tarFile;
5215 dpurdie 126 
my $opt_noarch;
407 dpurdie 127 
 
128 
#
129 
#   Options derived from script directives
130 
#
131 
my $opt_description;
132 
 
415 dpurdie 133 
#
134 
#   Globals
135 
#
136 
my @ResolveFileList;                    # Cached Package File List
137 
my @ResolveBinFileList;                 # Cached PackageBin File List
6088 dpurdie 138 
my @ResolveDebFileList;                 # Cached PackageDeb File List
415 dpurdie 139 
my @ResolveLibFileList;                 # Cached PackageLib File List
4635 dpurdie 140 
my %DebianControlFiles;                 # Control Files
141 
my %DebianControlFileNames;             # Control Files by name
142 
my @DependencyList;                     # Package Dependencies
4666 dpurdie 143 
my @ConfigList;                         # Config Files
407 dpurdie 144 
 
145 
#-------------------------------------------------------------------------------
146 
# Function        : Main Entry point
147 
#
148 
# Description     : This function will be called when the package is initialised
149 
#                   Extract arguments from the users environment
150 
#
151 
#                   Done here to greatly simplify the user script
152 
#                   There should be no junk in the user script - keep it simple
153 
#
154 
# Inputs          :
155 
#
156 
# Returns         :
157 
#
158 
main();
159 
sub main
160 
{
161 
    my $result = GetOptions (
162 
                "verbose:s"         => \$opt_vargs,
163 
                "clean"             => \$opt_clean,
164 
                "Type=s"            => \$opt_type,
4105 dpurdie 165 
                "BuildName=s"       => \$opt_buildname,                     # Raw Jats Package Name (Do not use)
166 
                "Name=s"            => \$opt_name,                          # Massaged Debian Package Name
407 dpurdie 167 
                "BuildVersion=s"    => \$opt_buildversion,
168 
                "Platform=s"        => \$opt_platform,
169 
                "Target=s"          => \$opt_target,
170 
                "Product=s"         => \$opt_product,
171 
                "DebianPackage=s"   => \$opt_package_script,
172 
                "InterfaceDir=s"    => \$opt_interfacedir,
173 
                "InterfaceIncDir=s" => \$opt_interfaceincdir,
174 
                "InterfaceLibDir=s" => \$opt_interfacelibdir,
175 
                "InterfaceBinDir=s" => \$opt_interfacebindir,
176 
                "LibDir=s"          => \$opt_libdir,
177 
                "BinDir=s"          => \$opt_bindir,
178 
                "LocalIncDir=s"     => \$opt_localincdir,
179 
                "LocalLibDir=s"     => \$opt_locallibdir,
180 
                "LocalBinDir=s"     => \$opt_localbindir,
181 
                "PackageDir=s"      => \$opt_pkgdir,
182 
                "PackageLibDir=s"   => \$opt_pkglibdir,
183 
                "PackageBinDir=s"   => \$opt_pkgbindir,
184 
                "PackagePkgDir=s"   => \$opt_pkgpkgdir,
185 
                "Output=s"          => \$opt_output,
4740 dpurdie 186 
                "tarFile=s"         => \$opt_tarFile,
427 dpurdie 187 
                "Variant:s"         => \$opt_variant,
3921 dpurdie 188 
                "PkgArch:s"         => \$opt_pkgarch,
5215 dpurdie 189 
                "NoArch"            => \$opt_noarch,
407 dpurdie 190 
    );
191 
    $opt_verbose++ unless ( $opt_vargs eq '@' );
192 
 
193 
    ErrorConfig( 'name'    => 'DebianUtils',
194 
                 'verbose' => $opt_verbose,
195 
                 'debug'   => $opt_debug );
196 
 
197 
    #
198 
    #   Init the FileSystem Uiltity interface
199 
    #
200 
    InitFileUtils();
201 
 
202 
    #
203 
    #   Ensure that we have all required options
204 
    #
205 
    Error ("Platform not set")                  unless ( $opt_platform );
206 
    Error ("Type not set")                      unless ( $opt_type );
207 
    Error ("BuildName not set")                 unless ( $opt_buildname );
4105 dpurdie 208 
    Error ("Debian Package Name not set")       unless ( $opt_name );
407 dpurdie 209 
    Error ("BuildVersion not set")              unless ( $opt_buildversion );
210 
    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );
211 
    Error ("Target not set")                    unless ( $opt_target );
212 
    Error ("Product not set")                   unless ( $opt_product );
213 
    Error ("DebianPackage not set")             unless ( $opt_package_script );
214 
    Error ("Ouput File not set")                unless ( $opt_output );
215 
 
216 
    #
217 
    #   Read in relevent config information
218 
    #
219 
    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );
220 
 
221 
    #
222 
    #   Build the package image in a directory based on the target being created
223 
    #
6088 dpurdie 224 
    $DebianWorkDirBase = uc("$opt_platform$opt_type.image");
425 dpurdie 225 
    $DebianWorkDir = "$DebianWorkDirBase/$opt_name";
407 dpurdie 226 
 
227 
    #
228 
    #   Configure the System command to fail on any error
229 
    #
230 
    SystemConfig ( ExitOnError => 1 );
231 
 
232 
    #
5217 dpurdie 233 
    #   Defaults
234 
    #
235 
    $opt_pkgarch = $opt_platform unless ( $opt_pkgarch );
236 
    $opt_pkgarch = 'all' if ( $opt_noarch );
237 
 
238 
    #
407 dpurdie 239 
    #   Display variables used
240 
    #
4740 dpurdie 241 
    Message    ("=Building Debian Package =============================================");
242 
    Message    ("Build $opt_name");
243 
    Message    ("       Package: $opt_buildname");
244 
    Message    ("       Variant: $opt_variant") if ($opt_variant);
245 
    Message    ("       Version: $opt_buildversion");
246 
    Message    ("  Building for: $opt_platform, $opt_target");
247 
    Message    ("       Product: $opt_product");
248 
    Message    ("          Type: $opt_type");
249 
    Message    ("      Pkg Arch: $opt_pkgarch") if ($opt_pkgarch);
250 
    Verbose    ("       Verbose: $opt_verbose");
251 
    Verbose    ("  InterfaceDir: $opt_interfacedir");
252 
    Message    ("       Package: " . StripDirExt($opt_output));
253 
    Message    ("       TarFile: " . StripDirExt($opt_tarFile)) if ($opt_tarFile);
254 
    Message    ("======================================================================");
407 dpurdie 255 
 
256 
    #
257 
    #   Perform Clean up
258 
    #   Invoked during "make clean" or "make clobber"
259 
    #
260 
    if ( $opt_clean )
261 
    {
262 
        Message ("Remove packaging directory: $DebianWorkDir");
425 dpurdie 263 
 
264 
        #
265 
        #   Remove the directory for this package
266 
        #   Remove the general work dir - if all packages have been cleaned
267 
        #
407 dpurdie 268 
        rmtree( $DebianWorkDir );
425 dpurdie 269 
        rmdir( $DebianWorkDirBase );
407 dpurdie 270 
        rmtree ($opt_output) if ( -f $opt_output );
271 
        exit;
272 
    }
273 
 
274 
    #
5215 dpurdie 275 
    #   NoArch sanity test
276 
    #   MUST only build no-arch for production
277 
    #   User MUST do this in the build.pl file
278 
    #
279 
    if ($opt_noarch && $opt_type ne 'P')
280 
    {
281 
        Error ("Debian Packages marked as NoArch (all) must be built ONLY for production",
282 
               "This must be configured in the build.pl" );
283 
    }
284 
 
285 
    #
407 dpurdie 286 
    #   Clean  out the WORK directory
287 
    #   Always start with a clean slate
288 
    #
289 
    #   Ensure that the base of the directory tree does not have 'setgid'
290 
    #       This will upset the debian packager
291 
    #       This may be an artifact from the users directory and not expected
292 
    #
293 
    rmtree( $DebianWorkDir );
294 
    mkpath( $DebianWorkDir );
295 
 
296 
    my $perm = (stat $DebianWorkDir)[2] & 0777;
297 
    chmod ( $perm & 0777, $DebianWorkDir );
298 
 
299 
    #
300 
    #   Invoke the user script to do the hard work
301 
    #
4139 dpurdie 302 
    unless (my $return = do $opt_package_script) {
303 
            Error ("Couldn't parse $opt_package_script: $@") if $@;
304 
            Error ("Couldn't do $opt_package_script: $!")    unless defined $return;
305 
        }
407 dpurdie 306 
 
307 
    #
308 
    #   Complete the building of the package
309 
    #
4740 dpurdie 310 
    if ($opt_tarFile)
311 
    {
312 
        BuildTarFile();
313 
        Message ("Created TGZ file");
314 
    }
315 
 
316 
 
407 dpurdie 317 
    BuildDebianPackage ();
318 
    Message ("Created Debian Package");
319 
}
320 
 
321 
#-------------------------------------------------------------------------------
322 
# Function        : BuildDebianPackage
323 
#
324 
# Description     : This function will create the Debian Package
325 
#                   and transfer it to the target directory
326 
#
327 
# Inputs          : None
328 
#
329 
# Returns         : Nothing
330 
#
331 
sub BuildDebianPackage
332 
{
333 
    Error ("BuildDebianPackage: No Control File or Package Description")
4635 dpurdie 334 
        unless ( exists($DebianControlFiles{'control'}) || $opt_description );
407 dpurdie 335 
 
336 
    #
337 
    #   Convert the FileSystem Image into a Debian Package
338 
    #       Insert Debian control files
339 
    #
340 
    Verbose ("Copy in the Debian Control Files");
341 
    mkdir ( "$DebianWorkDir/DEBIAN" );
342 
 
4635 dpurdie 343 
    #
344 
    #   Copy in all the named Debian Control files
345 
    #       Ignore any control file. It will be done next
346 
    #
347 
    foreach my $key ( keys %DebianControlFiles )
348 
    {
349 
        next if ($key eq 'control');
4676 dpurdie 350 
        CopyFile ( $DebianControlFiles{$key}, '/DEBIAN', $key  );
4635 dpurdie 351 
    }
4666 dpurdie 352 
 
353 
    #
354 
    #   Create 'conffiles'
355 
    #       Append to any user provided file
356 
    if ( @ConfigList )
357 
    {
358 
        my $conffiles = "$DebianWorkDir/DEBIAN/conffiles";
359 
        Warning("Appending user specified entries to conffiles") if ( -f $conffiles);
360 
        FileAppend( $conffiles, @ConfigList );
361 
    }
4635 dpurdie 362 
 
363 
    #
364 
    #   Massage the 'control' file
365 
    #
366 
    UpdateControlFile ($DebianControlFiles{'control'} );
407 dpurdie 367 
 
4635 dpurdie 368 
    #
369 
    #   Mark all files in the debian folder as read-execute
370 
    #
407 dpurdie 371 
    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );
372 
    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);
373 
    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );
374 
 
375 
    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));
376 
 
377 
}
378 
 
379 
#-------------------------------------------------------------------------------
4740 dpurdie 380 
# Function        : BuildTarFile
381 
#
382 
# Description     : This function will create a TGZ file of the constructed package
383 
#                   Not often used
384 
#
385 
# Inputs          : None
386 
#
387 
# Returns         : Nothing
388 
#
389 
sub BuildTarFile
390 
{
391 
    Verbose ("Create TGZ file containing body of the package");
392 
    System ('tar',
393 
            '--create',
394 
            '--auto-compress',
395 
            '--owner=0' ,
396 
            '--group=0' ,
397 
            '--one-file-system' ,
398 
            '--exclude=./DEBIAN' ,
399 
            '-C', $DebianWorkDir,
400 
            '--file', $opt_tarFile,
401 
            '.'
402 
            );
403 
}
404 
 
405 
 
406 
#-------------------------------------------------------------------------------
407 dpurdie 407 
# Function        : UpdateControlFile
408 
#
4188 dpurdie 409 
# Description     : Update the Debian 'control' file to fix up various fields
407 dpurdie 410 
#                   within the file.
411 
#
412 
#                   If the files has not been specified, then a basic control
413 
#                   file will be provided.
414 
#
415 
#                   This routine knows where the control file will be placed
416 
#                   within the output work space.
417 
#
418 
# Inputs          : $src            - Path to source file
419 
#                   Uses global variables
420 
#
421 
# Returns         : Nothing
422 
#
423 
sub UpdateControlFile
424 
{
425 
    my($src) = @_;
426 
    my $dst = "$DebianWorkDir/DEBIAN/control";
427 
 
428 
    unless ( $src )
429 
    {
430 
        CreateControlFile();
431 
        return;
432 
    }
433 
 
4635 dpurdie 434 
    #
435 
    #   User has provided a control file
436 
    #       Tweak the internals
437 
    #
407 dpurdie 438 
    Verbose ("UpdateControlFile: $dst" );
439 
    $src = ResolveFile( 0, $src );
440 
 
4635 dpurdie 441 
    #   Calc depends line
4636 dpurdie 442 
    my $depData = join (', ', @DependencyList );
4635 dpurdie 443 
 
444 
    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open:$src, $!");
445 
    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst, $!");
407 dpurdie 446 
    while ( <SF> )
447 
    {
448 
        s~\s*$~~;
449 
        if ( m~^Package:~ ) {
4105 dpurdie 450 
            $_ = "Package: $opt_name";
407 dpurdie 451 
 
452 
        } elsif ( m~^Version:~ ) {
453 
            $_ = "Version: $opt_buildversion";
454 
 
455 
        } elsif ( m~^Architecture:~ ) {
3921 dpurdie 456 
            $_ = "Architecture: $opt_pkgarch";
407 dpurdie 457 
 
458 
        } elsif ( $opt_description && m~^Description:~ ) {
459 
            $_ = "Description: $opt_description";
4635 dpurdie 460 
 
461 
        } elsif ( m~^Depends:~ ) {
462 
            $_ = "Depends: $depData";
463 
            $depData = '';
407 dpurdie 464 
        }
465 
        print DF $_ , "\n";
466 
    }
4635 dpurdie 467 
 
407 dpurdie 468 
    close (SF);
469 
    close (DF);
4635 dpurdie 470 
 
471 
    #
472 
    #   Warn if Depends section is needed
473 
    #
474 
    Error ("No Depends section seen in user control file")
475 
        if ($depData);
407 dpurdie 476 
}
477 
 
478 
#-------------------------------------------------------------------------------
479 
# Function        : CreateControlFile
480 
#
481 
# Description     : Craete a basic debian control file
482 
#
483 
# Inputs          : Uses global variables
484 
#
485 
# Returns         :
486 
#
487 
sub CreateControlFile
488 
{
489 
    my $dst = "$DebianWorkDir/DEBIAN/control";
490 
 
491 
    Verbose ("CreateControlFile: $dst" );
492 
 
4636 dpurdie 493 
    my $depData = join (', ', @DependencyList );
4635 dpurdie 494 
 
407 dpurdie 495 
    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");
4105 dpurdie 496 
    print DF "Package: $opt_name\n";
407 dpurdie 497 
    print DF "Version: $opt_buildversion\n";
498 
    print DF "Section: main\n";
499 
    print DF "Priority: standard\n";
3921 dpurdie 500 
    print DF "Architecture: $opt_pkgarch\n";
501 
    print DF "Essential: No\n";
502 
    print DF "Maintainer: Vix Technology\n";
407 dpurdie 503 
    print DF "Description: $opt_description\n";
4635 dpurdie 504 
    print DF "Depends: $depData\n" if ($depData);
505 
 
407 dpurdie 506 
    close (DF);
507 
}
508 
 
509 
#-------------------------------------------------------------------------------
510 
# Function        : SetVerbose
511 
#
512 
# Description     : Set the level of verbosity
513 
#                   Display activity
514 
#
515 
# Inputs          : Verbosity level
516 
#                       0 - Use makefile verbosity (Default)
517 
#                       1..2
518 
#
519 
# Returns         :
520 
#
521 
sub SetVerbose
522 
{
523 
    my ($level) = @_;
524 
 
525 
    $level = $opt_verbose unless ( $level );
526 
    $opt_verbose = $level;
527 
    ErrorConfig( 'verbose' => $level);
528 
}
529 
 
530 
 
531 
#-------------------------------------------------------------------------------
532 
# Function        : DebianFiles
533 
#
534 
# Description     : Name Debian builder control files
535 
#                   May be called multiple times
536 
#
537 
# Inputs          : Options
538 
#                       --Control=file
539 
#                       --PreRm=file
540 
#                       --PostRm=file
541 
#                       --PreInst=file
542 
#                       --PostInst=file
4635 dpurdie 543 
#
407 dpurdie 544 
#
545 
# Returns         : Nothing
546 
#
547 
sub DebianFiles
548 
{
549 
    #
4635 dpurdie 550 
    #   Extract names
407 dpurdie 551 
    #
552 
    Verbose ("Specify Debian Control Files and Scripts");
553 
    foreach  ( @_ )
554 
    {
4635 dpurdie 555 
        if ( m/^--Control=(.+)/i ) {
556 
            DebianControlFile('control',$1)
407 dpurdie 557 
 
4635 dpurdie 558 
        } elsif ( m/^--PreRm=(.+)/i ) {
559 
            DebianControlFile('prerm',$1)
407 dpurdie 560 
 
4635 dpurdie 561 
        } elsif ( m/^--PostRm=(.+)/i ) {
562 
            DebianControlFile('postrm',$1)
407 dpurdie 563 
 
4635 dpurdie 564 
        } elsif ( m/^--PreInst=(.+)/i ) {
565 
            DebianControlFile('preinst',$1)
407 dpurdie 566 
 
4635 dpurdie 567 
        } elsif ( m/^--PostInst=(.+)/i ) {
568 
            DebianControlFile('postinst',$1)
407 dpurdie 569 
 
570 
        } else {
571 
            Error ("DebianFiles: Unknown option: $_");
572 
        }
573 
    }
574 
}
575 
 
576 
#-------------------------------------------------------------------------------
4635 dpurdie 577 
# Function        : DebianControlFile
578 
#
579 
# Description     : Add special control files to the Debian Installer
580 
#                   Not useful for embedded installers
581 
#
582 
#                   More general than DebianFiles()
583 
#
584 
# Inputs          : name            - Target Name
585 
#                                     If the name starts with 'package.' then it will be replaced
586 
#                                     with the name of the current package
587 
#                   file            - Source File Name
4676 dpurdie 588 
#                   options         - Options include
589 
#                                       --FromPackage
4635 dpurdie 590 
#
591 
# Returns         :
592 
#
593 
sub DebianControlFile
594 
{
4676 dpurdie 595 
    my ($name, $file, @options) = @_;
596 
    my $fromPackage = 0;
4635 dpurdie 597 
 
598 
    #
4676 dpurdie 599 
    #   Process options
600 
    foreach ( @options)
601 
    {
602 
        if (m~^--FromPackage~) {
603 
            $fromPackage = 1;
604 
        }
605 
        else  {
606 
            ReportError(("DebianControlFile: Unknown argument: $_"));
607 
        }
608 
    }
609 
    ErrorDoExit();
610 
 
611 
    #
4635 dpurdie 612 
    #   Some control files need to have the package name prepended
613 
    #
614 
    $name =~ s~^package\.~$opt_name.~;
615 
 
616 
    #
617 
    #   Only allow one file of each type
618 
    #       Try to protect the user by testing for names by lowercase
619 
    #
620 
    my $simpleName = lc($name);
621 
    Error("DebianControlFile: Multiple definitions for '$name' not allowed")
622 
        if (exists $DebianControlFileNames{$simpleName});
623 
 
4676 dpurdie 624 
    my $filePath = ResolveFile($fromPackage, $file);
4635 dpurdie 625 
 
626 
    #
627 
    #   Add info to data structures
628 
    #
4676 dpurdie 629 
    $DebianControlFiles{$name} = $filePath;
4635 dpurdie 630 
    $DebianControlFileNames{$simpleName} = $name;
631 
}
632 
 
633 
#-------------------------------------------------------------------------------
634 
# Function        : DebianDepends
635 
#
636 
# Description     : This directive allows simple dependency information to be
637 
#                   inserted into the control file
638 
#
4636 dpurdie 639 
#                   Not useful in embedded system
4635 dpurdie 640 
#
641 
# Inputs          : Entry             - A dependency entry
642 
#                   ...               - More entries
643 
#
644 
#
645 
# Returns         : Nothing
646 
#
647 
sub DebianDepends
648 
{
649 
    push @DependencyList, @_;
650 
}
651 
 
652 
 
653 
#-------------------------------------------------------------------------------
407 dpurdie 654 
# Function        : PackageDescription
655 
#
656 
# Description     : Specify the Package Description
657 
#                   Keep it short
658 
#
659 
# Inputs          : $description
660 
#
661 
# Returns         :
662 
#
663 
sub PackageDescription
664 
{
665 
    ($opt_description) = @_;
666 
}
667 
 
668 
#-------------------------------------------------------------------------------
669 
# Function        : MakeSymLink
670 
#
671 
# Description     : Create a symlink - with error detection
672 
#
673 
# Inputs          : old_file    - Link Target
674 
#                                 Path to the link target
675 
#                                 If an ABS path is provided, the routine will
676 
#                                 attempt to create a relative link.
677 
#                   new_file    - Relative to the output work space
678 
#                                 Path to where the 'link' file will be created
679 
#                   Options     - Must be last
680 
#                                 --NoClean         - Don't play with links
681 
#                                 --NoDotDot        - Don't create symlinks with ..
682 
#
683 
# Returns         : Nothing
684 
#
685 
sub MakeSymLink
686 
{
687 
    my $no_clean;
688 
    my $no_dot;
689 
    my @args;
690 
 
691 
    #
692 
    #   Extract options
693 
    #
694 
    foreach ( @_ )
695 
    {
696 
        if ( m/^--NoClean/i ) {
697 
            $no_clean = 1;
698 
 
699 
        } elsif ( m/^--NoDotDot/i ) {
700 
            $no_dot = 1;
701 
 
702 
        } elsif ( m/^--/ ) {
703 
            Error ("MakeSymLink: Unknown option: $_");
704 
 
705 
        } else {
706 
            push @args, $_;
707 
        }
708 
    }
709 
 
710 
    my ($old_file, $new_file) = @args;
711 
 
712 
    my $tfile = $DebianWorkDir . '/' . $new_file;
713 
    $tfile =~ s~//~/~;
714 
    Verbose ("Symlink $old_file -> $new_file" );
715 
 
716 
    #
717 
    #   Create the directory in which the link will be placed
718 
    #   Remove any existing file of the same name
719 
    #
720 
    my $dir = StripFileExt( $tfile );
721 
    mkpath( $dir) unless -d $dir;
722 
    unlink $tfile;
723 
 
724 
    #
725 
    #   Determine a good name of the link
726 
    #   Convert to a relative link in an attempt to prune them
727 
    #
728 
    my $sfile = $old_file;
729 
    unless ( $no_clean )
730 
    {
731 
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
732 
        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );
733 
    }
734 
 
735 
    my $result = symlink $sfile, $tfile;
736 
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
737 
}
738 
 
739 
#-------------------------------------------------------------------------------
740 
# Function        : CopyFile
741 
#
742 
# Description     : Copy a file to a target dir
743 
#                   Used for text files, or files with fixed names
744 
#
745 
# Inputs          : $src
746 
#                   $dst_dir    - Within the output workspace
747 
#                   $dst_name   - Output Name [Optional]
748 
#                   Options     - Common Copy Options
749 
#
750 
# Returns         : Full path to destination file
751 
#
752 
sub CopyFile
753 
{
754 
    CopyFileCommon( \&ResolveFile, @_ );
755 
}
756 
 
757 
#-------------------------------------------------------------------------------
758 
# Function        : CopyBinFile
759 
#
760 
# Description     : Copy a file to a target dir
761 
#                   Used for executable programs. Will look in places where
762 
#                   programs are stored.
763 
#
764 
# Inputs          : $src
765 
#                   $dst_dir    - Within the output workspace
766 
#                   $dst_name   - Output Name [Optional]
767 
#
768 
#                   Options:
769 
#                       --FromPackage
770 
#                       --SoftLink=xxxx
771 
#                       --LinkFile=xxxx
772 
#
773 
#
774 
# Returns         : Full path to destination file
775 
#
776 
sub CopyBinFile
777 
{
778 
    CopyFileCommon( \&ResolveBinFile, @_ );
779 
}
780 
 
781 
#-------------------------------------------------------------------------------
782 
# Function        : CopyLibFile
783 
#
784 
# Description     : Copy a file to a target dir
785 
#                   Used for shared programs. Will look in places where
786 
#                   shared libraries are stored.
787 
#
788 
# Inputs          : $src        - Base for 'realname' (no lib, no extension)
789 
#                   $dst_dir    - Within the output workspace
790 
#                   $dst_name   - Output Name [Optional, but not suggested]
791 
#
792 
# Returns         : Full path to destination file
793 
#
794 
# Notes           : Copying 'lib' files
795 
#                   These are 'shared libaries. There is no provision for copying
796 
#                   static libraries.
797 
#
798 
#                   The tool will attempt to copy a well-formed 'realname' library
799 
#                   The soname of the library should be constructed on the target
800 
#                   platform using ldconfig.
801 
#                   There is no provision to copy the 'linker' name
802 
#
803 
#                   Given a request to copy a library called 'fred', then the
804 
#                   well formed 'realname' will be:
805 
#                           libfred[P|D|]].so.nnnnn
806 
#                   where:
807 
#                           nnnn is the library version
808 
#                           [P|D|] indicates Production, Debug or None
809 
#
810 
#                   The 'soname' is held within the realname form of the library
811 
#                   and will be created by lsconfig.
812 
#
813 
#                   The 'linkername' would be libfred[P|D|].so. This is only
814 
#                   needed when linking against the library.
815 
#
816 
#
817 
#                   The routine will also recognize Windows DLLs
818 
#                   These are of the form fred[P|D|].nnnnn.dll
819 
#
820 
sub CopyLibFile
821 
{
822 
    CopyFileCommon( \&ResolveLibFile, @_ );
823 
}
824 
 
825 
#-------------------------------------------------------------------------------
6088 dpurdie 826 
# Function        : CopyDebianPackage
827 
#
828 
# Description     : Copy a Debian Package to a target dir
829 
#                   Will look in places where Debian Packages are stored.
830 
#
831 
# Inputs          : $src        - BaseName for 'Debian Package' (no version, no extension)
832 
#                   $dst_dir    - Within the output workspace
833 
#                   Optional arguments embedded into the BaseName
834 
#                   --Arch=XXXX         - Architecture - if not current
835 
#                   --Product=XXXX      - Product - if required
836 
#                   --Debug             - If not the current type
837 
#                   --Prod              - If not the current type
838 
#
839 
# Returns         : Full path to destination file
840 
#
841 
# Notes           : Copying Debian Packages from external packages
842 
#
843 
#                   The tool will attempt to copy a well-formed debian packages
844 
#                   These are:
845 
#
846 
#                       "BaseName_VersionString[_Product]_Arch${PkgType}.deb";
847 
#
848 
#                   Where 'Product' is optional (and rare)
849 
#                   Where 'PkgType' is P or D or nothing
850 
#                   Where 'Arch' may be 'all'
851 
#
852 
#                   The routine will locate Debian packages in
853 
#                       - The root of the package
854 
#                       - bin/TARGET[P|D/]
855 
#                       - bin/Arch[P|D]
856 
#
857 
#
858 
sub CopyDebianPackage
859 
{
860 
    CopyFileCommon( \&ResolveDebPackage, @_ );
861 
}
862 
 
863 
#-------------------------------------------------------------------------------
407 dpurdie 864 
# Function        : CopyFileCommon
865 
#
866 
# Description     : Common ( internal File Copy )
867 
#
868 
# Inputs          : $resolver           - Ref to function to resolve source file
869 
#                   $src                - Source File Name
870 
#                   $dst_dir            - Target Dir
871 
#                   $dst_name           - Target Name (optional)
872 
#                   Options
873 
#                   Options:
874 
#                       --FromPackage
875 
#                       --SoftLink=xxxx
876 
#                       --LinkFile=xxxx
4666 dpurdie 877 
#                       --ConfigFile
407 dpurdie 878 
#
879 
# Returns         :
880 
#
881 
sub CopyFileCommon
882 
{
883 
    my $from_package = 0;
884 
    my $isa_linkfile = 0;
4666 dpurdie 885 
    my $isa_configFile = 0;
407 dpurdie 886 
    my @llist;
887 
    my @args;
888 
 
889 
    #
890 
    #   Parse options
891 
    #
892 
    foreach ( @_ )
893 
    {
894 
        if ( m/^--FromPackage/ ) {
895 
            $from_package = 1;
896 
 
897 
        } elsif ( m/^--LinkFile/ ) {
898 
            $isa_linkfile = 1;
899 
 
4666 dpurdie 900 
        } elsif ( m/^--ConfFile/i ) {
901 
            $isa_configFile = 1;
902 
 
407 dpurdie 903 
        } elsif ( m/^--SoftLink=(.+)/ ) {
904 
            push @llist, $1;
905 
 
906 
        } elsif ( m/^--/ ) {
907 
            Error ("FileCopy: Unknown option: $_");
908 
 
909 
        } else {
910 
            push @args, $_;
911 
        }
912 
    }
913 
 
914 
    #
915 
    #   Extract non-options.
916 
    #   These are the bits that are left over
917 
    #
918 
    my ($resolver, $src, $dst_dir, $dst_name ) = @args;
919 
 
920 
    #
921 
    #   Clean up dest_dir. Must start with a / and not end with one
922 
    #
923 
    $dst_dir = "/$dst_dir/";
924 
    $dst_dir =~ s~/+~/~g;
925 
    $dst_dir =~ s~/$~~;
926 
 
927 
    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));
928 
    foreach $src ( &$resolver( $from_package, $src ) )
929 
    {
930 
        my $dst_fname = $dst_name ? $dst_name : StripDir($src);
931 
        my $dst_file = "$dst_dir/$dst_fname";
932 
        Verbose ("CopyFile: Copy $src, $dst_file" );
933 
 
934 
 
935 
        #
936 
        #   LinkFiles are special
937 
        #   They get concatenated to any existing LINKS File
938 
        #
939 
        if ( $isa_linkfile )
940 
        {
941 
            CatFile ( $src, "$dst_dir/.LINKS" );
942 
        }
943 
        else
944 
        {
945 
            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);
946 
            unlink ("$DebianWorkDir$dst_file");
947 
            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );
948 
 
949 
            foreach my $lname ( @llist )
950 
            {
951 
                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
952 
                MakeSymLink( $dst_file ,$lname);
953 
            }
954 
        }
4666 dpurdie 955 
 
956 
        #
957 
        #   ConfigFiles are marked so that they can be handled by the debain installer
958 
        #
959 
        if ($isa_configFile)
960 
        {
961 
            push @ConfigList, $dst_file;
962 
        }
407 dpurdie 963 
    }
964 
}
965 
 
966 
#-------------------------------------------------------------------------------
967 
# Function        : CopyDir
968 
#
969 
# Description     : Copy a directory to a target dir
970 
#
971 
# Inputs          : $src_dir    - Local to the user
972 
#                                 Symbolic Name
973 
#                   $dst_dir    - Within the output workspace
974 
#                   Options
4714 dpurdie 975 
#                       --Merge                 - Don't delete first
976 
#                       --Source=Name           - Source via Symbolic Name
977 
#                       --FromPackage           - Source via package roots
978 
#                       --NoIgnoreDbgFiles      - Do not ignore .dbg and .debug files in dir copy
979 
#                       --IfPresent             - Not an error if the path cannot be found
980 
#                       --ConfFile              - Mark transferred files as config files
981 
#                       --Flatten               - Copy all to one directory
982 
#                       --FilterOut=xxx         - Ignore files. DOS Wildcard
983 
#                       --FilterOutRe=xxx       - Ignore files. Regular expression name
984 
#                       --FilterOutDir=xxx      - Ignore directories. DOS Wilcard
985 
#                       --FilterOutDirRe=xxx    - Ignore directories. Regular expression name
986 
#                       --SkipTLF               - Ignore files in the Top Level Directory
987 
#                       --NoRecurse             - Only process files in the Top Level Directory
988 
#                       --FilterIn=xxx          - Include files. DOS Wildcard
989 
#                       --FilterInRe=xxx        - Include files. Regular expression name
990 
#                       --FilterInDir=xxx       - Include directories. DOS Wilcard
991 
#                       --FilterInDirRe=xxx     - Include directories. Regular expression name
407 dpurdie 992 
#
993 
# Returns         :
994 
#
995 
sub CopyDir
996 
{
997 
    my ($src_dir, $dst_dir, @opts) = @_;
998 
    my $opt_base;
411 dpurdie 999 
    my $from_interface = 0;
4152 dpurdie 1000 
    my $ignoreDbg = 1;
1001 
    my $ignoreNoDir;
1002 
    my $user_src_dir = $src_dir;
1003 
    my $opt_source;
1004 
    my $opt_package;
4714 dpurdie 1005 
    my @fileList;
1006 
    my $isFiltered;
407 dpurdie 1007 
 
4714 dpurdie 1008 
    #
1009 
    #   Setup the basic copy options
1010 
    #       May be altered as we parse user options
1011 
    #
1012 
    my %copyOpts;
1013 
    $copyOpts{'IgnoreDirs'} = ['.svn', '.git', '.cvs', '.hg'];
1014 
    $copyOpts{'Ignore'} = ['.gbedir', '_gbedir'];
1015 
    $copyOpts{'Log'} = 1 if ( $opt_verbose > 1 );
4740 dpurdie 1016 
    $copyOpts{'DeleteFirst'} = 1;
4714 dpurdie 1017 
 
407 dpurdie 1018 
    $dst_dir = $DebianWorkDir . '/' . $dst_dir;
1019 
    $dst_dir =~ s~//~/~;
1020 
 
1021 
    #
4152 dpurdie 1022 
    #   Scan and collect user options
407 dpurdie 1023 
    #
1024 
    foreach  ( @opts )
1025 
    {
4152 dpurdie 1026 
        Verbose2 ("CopyDir: $_");
407 dpurdie 1027 
        if ( m/^--Merge/ ) {
4740 dpurdie 1028 
            $copyOpts{'DeleteFirst'} = 0;
4152 dpurdie 1029 
 
407 dpurdie 1030 
        } elsif ( m/^--Source=(.+)/ ) {
425 dpurdie 1031 
            Error ("Source directory can only be specified once")
4152 dpurdie 1032 
                if ( defined $opt_source );
1033 
            $opt_source = $1;
425 dpurdie 1034 
 
4152 dpurdie 1035 
        } elsif ( m/^--FromPackage/ ) {
1036 
            Error ("FromPackage can only be specified once")
1037 
                if ( defined $opt_package );
1038 
            $opt_package = 1;
1039 
 
1040 
        } elsif ( m/^--NoIgnoreDbgFiles/ ) {
1041 
            $ignoreDbg = 0;
1042 
 
1043 
        } elsif ( m/^--IfPresent/ ) {
1044 
            $ignoreNoDir = 1;
407 dpurdie 1045 
 
4714 dpurdie 1046 
        } elsif ( m/^--ConfFile/i ) {
1047 
            $copyOpts{'FileList'} = \@fileList;
1048 
 
1049 
        } elsif ( m/^--Flatten/i ) {
1050 
            $copyOpts{'Flatten'} = 1;
1051 
 
1052 
        } elsif ( m/^--FilterOut=(.+)/i ) {
1053 
            push (@{$copyOpts{'Ignore'}}, $1);
1054 
            $isFiltered = 1;
1055 
 
1056 
        } elsif ( m/^--FilterOutRe=(.+)/i ) {
1057 
            push (@{$copyOpts{'IgnoreRE'}}, $1);
1058 
            $isFiltered = 1;
1059 
 
1060 
        } elsif ( m/^--FilterOutDir=(.+)/i ) {
1061 
            push (@{$copyOpts{'IgnoreDirs'}}, $1);
1062 
            $isFiltered = 1;
1063 
 
1064 
        } elsif ( m/^--FilterOutDirRe=(.+)/i ) {
1065 
            push (@{$copyOpts{'IgnoreDirsRE'}}, $1);
1066 
            $isFiltered = 1;
1067 
 
1068 
        } elsif ( m/^--FilterIn=(.+)/i ) {
1069 
            push (@{$copyOpts{'Match'}}, $1);
1070 
            $isFiltered = 1;
1071 
 
1072 
        } elsif ( m/^--FilterInRe=(.+)/i ) {
1073 
            push (@{$copyOpts{'MatchRE'}}, $1);
1074 
            $isFiltered = 1;
1075 
 
1076 
        } elsif ( m/^--FilterInDir=(.+)/i ) {
1077 
            push (@{$copyOpts{'MatchDirs'}}, $1);
1078 
            $isFiltered = 1;
1079 
 
1080 
        } elsif ( m/^--FilterInDirRe=(.+)/i ) {
1081 
            push (@{$copyOpts{'MatchDirsRE'}}, $1);
1082 
            $isFiltered = 1;
1083 
 
1084 
        } elsif ( m/^--SkipTLF$/i ) {
1085 
            $copyOpts{'SkipTLF'} = 1;
1086 
 
1087 
        } elsif ( m/^--NoRecurse$/i ) {
1088 
            $copyOpts{'NoSubDirs'} = 1;
1089 
 
4152 dpurdie 1090 
        } else {
1091 
            Error ("CopyDir: Unknown option: $_" );
1092 
        }
1093 
    }
411 dpurdie 1094 
 
4152 dpurdie 1095 
    #
1096 
    #   All options have been gathered. Now process some of them
1097 
    #
1098 
    Error ("CopyDir: Cannot use both --Source and --FromPackage: $src_dir") if ($opt_source && $opt_package);
425 dpurdie 1099 
 
4152 dpurdie 1100 
    #
1101 
    #   Convert a symbolic path into a physical path
1102 
    #
1103 
    if ($opt_source)
1104 
    {
1105 
        Verbose2 ("CopyDir: Determine Source: $opt_source");
425 dpurdie 1106 
 
4152 dpurdie 1107 
        $opt_source = lc($opt_source);
1108 
        my %CopyDirSymbolic = (
1109 
            'interfaceincdir'   => $opt_interfaceincdir,
1110 
            'interfacelibdir'   => $opt_interfacelibdir,
1111 
            'interfacebindir'   => $opt_interfacebindir,
1112 
            'libdir'            => $opt_libdir,
1113 
            'bindir'            => $opt_bindir,
1114 
            'localincdir'       => $opt_localincdir,
1115 
            'locallibdir'       => $opt_locallibdir,
1116 
            'localbindir'       => $opt_localbindir,
1117 
            'packagebindir'     => $opt_pkgbindir,
1118 
            'packagelibdir'     => $opt_pkglibdir,
1119 
            'packagepkgdir'     => $opt_pkgpkgdir,
1120 
            'packagedir'        => $opt_pkgdir,
1121 
        );
425 dpurdie 1122 
 
4152 dpurdie 1123 
        if ( exists $CopyDirSymbolic{$opt_source} )
1124 
        {
1125 
            $opt_base = $CopyDirSymbolic{$opt_source};
425 dpurdie 1126 
 
1127 
            #
4152 dpurdie 1128 
            #   If sourceing from interface, then follow
1129 
            #   symlinks in the copy. All files will be links anyway
425 dpurdie 1130 
            #
1131 
            $from_interface = 1
4152 dpurdie 1132 
                if ( $opt_source =~ m~^interface~ );
1133 
        }
1134 
        else
1135 
        {
1136 
            DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);
1137 
            Error ("CopyDir: Unknown Source Name: $opt_source" );
1138 
        }
1139 
    }
425 dpurdie 1140 
 
4152 dpurdie 1141 
    #
1142 
    #   Locate the path within an external package
1143 
    #
1144 
    if ($opt_package)
1145 
    {
1146 
        Verbose2 ("CopyDir: FromPackage: $src_dir");
4147 dpurdie 1147 
 
4152 dpurdie 1148 
        my @path;
1149 
        foreach my $entry ( getPackageList() )
1150 
        {
1151 
            my $base = $entry->getBase(3);
1152 
            next unless ( defined $base );
1153 
            if ( -d $base . '/' . $src_dir )
1154 
            {
1155 
                push @path, $base;
1156 
                $from_interface = 1
1157 
                    if ( $entry->{'TYPE'} eq 'interface' );
1158 
            }
407 dpurdie 1159 
        }
4152 dpurdie 1160 
 
1161 
        if ( $#path < 0 )
1162 
        {
1163 
            Error ("CopyDir: Cannot find source dir in any package: $user_src_dir") unless ($ignoreNoDir);
1164 
            Message ("CopyDir: Optional path not found: $user_src_dir");
1165 
            return;
1166 
        }
1167 
 
1168 
        Error ("CopyDir: Requested path found in mutiple packages: $user_src_dir",
1169 
                @path ) if ( $#path > 0 );
1170 
        $opt_base = pop @path;
1171 
 
1172 
        #
1173 
        #   If sourceing from interface, then follow symlinks in the copy.
1174 
        #   All files will be links anyway
1175 
        #
1176 
        #   This is a very ugly test for 'interface'
1177 
        #
1178 
        $from_interface = 1
1179 
            if ( $opt_base =~ m~/interface/~ );
1180 
 
407 dpurdie 1181 
    }
1182 
 
4152 dpurdie 1183 
    #
1184 
    #   Create the full source path
4714 dpurdie 1185 
    #   May be: from a package, from a known directory, from a local directory
4152 dpurdie 1186 
    #
1187 
 
407 dpurdie 1188 
    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );
1189 
    $src_dir =~ s~//~/~g;
1190 
    $src_dir =~ s~/$~~;
1191 
 
1192 
    Verbose ("CopyDir: $src_dir, $dst_dir");
4152 dpurdie 1193 
    unless ( -d $src_dir )
1194 
    {
1195 
        Error ("CopyDir: Directory not found: $user_src_dir") unless ($ignoreNoDir);
1196 
        Message ("CopyDir: Optional path not found: $user_src_dir");
1197 
        return;
1198 
    }
407 dpurdie 1199 
 
1200 
    #
4714 dpurdie 1201 
    #   Continue to configure the copy options
407 dpurdie 1202 
    #
4147 dpurdie 1203 
    push (@{$copyOpts{'Ignore'}}, '*.debug', '*.dbg') if $ignoreDbg;
423 dpurdie 1204 
    $copyOpts{'DuplicateLinks'} = 1 unless ( $from_interface );
4714 dpurdie 1205 
    $copyOpts{'EmptyDirs'} = 1 unless ($isFiltered);
407 dpurdie 1206 
 
1207 
    #
423 dpurdie 1208 
    #   Transfer the directory
407 dpurdie 1209 
    #
423 dpurdie 1210 
    JatsCopy::CopyDir ( $src_dir, $dst_dir, \%copyOpts );
407 dpurdie 1211 
 
1212 
    #
4714 dpurdie 1213 
    #   If requested, mark files as config files
1214 
    #   Must remove the DebianWorkDir prefix
1215 
    #
1216 
    if(@fileList)
1217 
    {
1218 
        Verbose ("Mark all transfered files as ConfFiles");
1219 
        my $removePrefix = length ($DebianWorkDir);
1220 
        foreach my $file (@fileList)
1221 
        {
1222 
            push @ConfigList, substr($file, $removePrefix);
1223 
        }
1224 
    }
1225 
 
1226 
    #
407 dpurdie 1227 
    #   Expand link files that may have been copied in
1228 
    #
1229 
    Verbose ("Locate LINKFILES in $DebianWorkDir");
1230 
    ExpandLinkFiles();
1231 
}
1232 
 
1233 
#-------------------------------------------------------------------------------
1234 
# Function        : AddInitScript
1235 
#
1236 
# Description     : Add an Init Script to the target
1237 
#                   Optionally create start and stop links
1238 
#
1239 
# Inputs          : $script     - Name of the init script
1240 
#                   $start      - Start Number
1241 
#                   $stop       - Stop Number
1242 
#                   Options:
1243 
#                       --NoCopy        - Don't copy the script, just add links
1244 
#                       --Afc           - Place in AFC init area
1245 
#                       --FromPackage   - Source is in a package
1246 
#
1247 
# Returns         :
1248 
#
1249 
sub AddInitScript
1250 
{
1251 
    my $no_copy;
1252 
    my $basedir = "";
1253 
    my @args;
1254 
    my $from_package = 0;
1255 
 
4302 dpurdie 1256 
    # This directive is only available on the VIX platforms
1257 
    #   Kludgey test - at the moment
407 dpurdie 1258 
    #
4302 dpurdie 1259 
    if ($opt_pkgarch =~ m~i386~)
1260 
    {
1261 
        Error ("AddInitScript is not supported on this platform");
1262 
    }
1263 
 
1264 
    #
407 dpurdie 1265 
    #   Process and Remove options
1266 
    #
1267 
    foreach  ( @_ )
1268 
    {
1269 
        if ( m/^--NoCopy/ ) {
1270 
            $no_copy = 1;
1271 
 
1272 
        } elsif ( m/^--Afc/ ) {
1273 
            $basedir = "/afc";
1274 
 
1275 
        } elsif ( m/^--FromPackage/ ) {
1276 
            $from_package = 1;
1277 
 
1278 
        } elsif ( m/^--/ ) {
1279 
            Error ("AddInitScript: Unknown option: $_");
1280 
 
1281 
        } else {
1282 
            push @args, $_;
1283 
 
1284 
        }
1285 
    }
1286 
 
1287 
    my( $script, $start, $stop ) = @args;
1288 
    Error ("No script file specified") unless ( $script );
1289 
    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );
1290 
    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));
1291 
    $script = ResolveFile($from_package, $script );
1292 
 
1293 
    my $tdir = $basedir . "/etc/init.d/init.d";
1294 
    my $base = StripDir($script);
1295 
 
1296 
    CopyFile( $script, $tdir ) unless $no_copy;
1297 
 
1298 
    my $link;
1299 
    if ( $start )
1300 
    {
1301 
        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );
1302 
        MakeSymLink( "$tdir/$base", $link);
1303 
    }
1304 
 
1305 
    if ( $stop )
1306 
    {
1307 
        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );
1308 
        MakeSymLink( "$tdir/$base", $link);
1309 
    }
1310 
}
1311 
 
1312 
#-------------------------------------------------------------------------------
1313 
# Function        : CatFile
1314 
#
1315 
# Description     : Copy a file to the end of a file
1316 
#
1317 
# Inputs          : $src
1318 
#                   $dst    - Within the output workspace
1319 
#
1320 
# Returns         :
1321 
#
1322 
sub CatFile
1323 
{
1324 
    my ($src, $dst) = @_;
1325 
 
1326 
    $dst = $DebianWorkDir . '/' . $dst;
1327 
    $dst =~ s~//~/~;
1328 
    Verbose ("CatFile: $src, $dst");
1329 
    $src = ResolveFile(0, $src );
1330 
 
1331 
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
1332 
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
1333 
    while ( <SF> )
1334 
    {
1335 
        print DF $_;
1336 
    }
1337 
    close (SF);
1338 
    close (DF);
1339 
}
1340 
 
1341 
#-------------------------------------------------------------------------------
1342 
# Function        : EchoFile
1343 
#
1344 
# Description     : Echo simple text to a file
1345 
#
1346 
# Inputs          : $file   - Within the output workspace
1347 
#                   $text
1348 
#
1349 
# Returns         :
1350 
#
1351 
sub EchoFile
1352 
{
1353 
    my ($file, $text) = @_;
1354 
    Verbose ("EchoFile: $file");
1355 
 
1356 
    $file = $DebianWorkDir . '/' . $file;
1357 
    $file =~ s~//~/~;
1358 
 
1359 
    unlink $file;
1360 
    open (DT, ">", $file ) || Error ("Cannot create $file");
1361 
    print DT  $text || Error ("Cannot print to $file");
1362 
    close DT;
1363 
}
1364 
 
1365 
#-------------------------------------------------------------------------------
4640 dpurdie 1366 
# Function        : ConvertFiles
1367 
#
1368 
# Description     : This sub-routine is used to remove all carrage return\line
1369 
#                   feeds from a line and replace them with the platform
1370 
#                   specific equivalent chars.
1371 
#
1372 
#                   We let PERL determine what characters are written to the
1373 
#                   file base on the  platform you are running on.
1374 
#
1375 
#                   i.e. LF    for unix
1376 
#                        CR\LF for win32
1377 
#
1378 
# Inputs          : outPath                 - Output directory
1379 
#                   flist                   - List of files in that directory
1380 
#                   or
1381 
#                   SearchOptions           - Search options to find files
1382 
#                                           --Recurse
1383 
#                                           --NoRecurse
1384 
#                                           --FilterIn=xxx
1385 
#                                           --FilterInRe=xxx
1386 
#                                           --FilterOut=xxx
1387 
#                                           --FilterOutRe=xxx
1388 
#                   Common options
1389 
#                                           --Dos
1390 
#                                           --Unix
1391 
#
1392 
#
1393 
# Returns         : 1
1394 
#
1395 
sub ConvertFiles
1396 
{
1397 
    my @uargs;
1398 
    my $lineEnding = "\n";
1399 
    my ($dosSet, $unixSet);
1400 
    my $search =  JatsLocateFiles->new( '--NoRecurse' );
1401 
 
1402 
    #
1403 
    #   Process user arguments extracting options
1404 
    #
1405 
    foreach  ( @_ )
1406 
    {
1407 
        if ( m~^--Recurse~ ) {
1408 
            $search->recurse(1);
1409 
 
1410 
        } elsif ( m~^--NoRecurse~) {
1411 
            $search->recurse(0);
1412 
 
1413 
        } elsif ( /^--FilterOut=(.*)/ ) {
1414 
            $search->filter_out($1);
1415 
 
1416 
        } elsif ( /^--FilterOutRe=(.*)/ ) {
1417 
            $search->filter_out_re($1);
1418 
 
1419 
        } elsif ( /^--FilterIn=(.*)/ ) {
1420 
            $search->filter_in($1);
1421 
 
1422 
        } elsif ( /^--FilterInRe=(.*)/ ) {
1423 
            $search->filter_in_re($1);
1424 
 
1425 
        } elsif ( m~^--Dos~) {
1426 
            $lineEnding = "\r\n";
1427 
            $dosSet = 1;
1428 
 
1429 
        } elsif ( m~^--Unix~) {
1430 
            $lineEnding = "\n";
1431 
            $unixSet = 1;
1432 
 
1433 
        } elsif ( m~^--~) {
4641 dpurdie 1434 
            Error ("ConvertFiles: Unknown option: $_");
4640 dpurdie 1435 
 
1436 
        } else {
1437 
            push @uargs, $_;
1438 
        }
1439 
    }
1440 
 
1441 
    #
1442 
    #   Process non-option arguments
1443 
    #       - Base dir
1444 
    #       - List of files
1445 
    #
1446 
    my ($outPath, @flist) = @uargs;
1447 
    Error ("ConvertFiles: Target Dir must be specified" ) unless ( $outPath );
1448 
 
1449 
    #
1450 
    #   Sanity Tests
1451 
    #
1452 
    Error ("ConvertFiles: --Dos and --Unix are mutually exclusive" ) if ( $dosSet && $unixSet );
1453 
 
1454 
 
1455 
    #
1456 
    # Convert output path to physical path
1457 
    #
1458 
    my $topDir = catdir($DebianWorkDir, $outPath);
1459 
    Verbose("ConvertFiles: topDir: $topDir");
1460 
    Error ("ConvertFiles: Path does not exist", $topDir) unless ( -e $topDir );
1461 
    Error ("ConvertFiles: Path is not a directory", $topDir) unless ( -d $topDir );
1462 
 
1463 
    #
1464 
    #   Need to determine if we are searching or simply using a file list
1465 
    #   There are two forms of the functions. If any of the search options have
1466 
    #   been used then we assume that we are searchine
1467 
    #
1468 
    if ( $search->has_filter() )
1469 
    {
1470 
        Error ("ConvertFiles: Cannot mix search options with named files") if ( @flist );
1471 
        @flist = $search->search($topDir);
1472 
    }
1473 
    Error ("ConvertFiles: No files specified") unless ( @flist );
1474 
 
1475 
    #
1476 
    #   Process all named files
1477 
    #
1478 
    foreach my $file ( @flist )
1479 
    {
1480 
 
1481 
        # this is our file that we want to clean.
1482 
        my ($ifileLoc) = "$topDir/$file";
1483 
        my ($tfileLoc) = "$topDir/$file\.tmp";
4641 dpurdie 1484 
        Verbose("ConvertFiles: $file");
4640 dpurdie 1485 
 
1486 
        # we will check to see if the file exists.
1487 
        #
1488 
        my $ifile;
1489 
        my $tfile;
1490 
        if ( -f "$ifileLoc" )
1491 
        {
1492 
            open ($ifile, "< $ifileLoc" ) or
1493 
                Error("Failed to open file [$ifileLoc] : $!");
1494 
 
1495 
            open ($tfile, "> $tfileLoc" ) or
1496 
                Error("Failed to open file [$tfileLoc] : $!");
1497 
            binmode $tfile;
1498 
 
1499 
            while ( <$ifile> )
1500 
            {
1501 
                s~[\n\r]+$~~;               # Chomp
1502 
                print $tfile "$_" . $lineEnding;
1503 
            }
1504 
        }
1505 
        else
1506 
        {
1507 
            Error("ConvertFiles [$ifileLoc] does not exist.");
1508 
        }
1509 
 
1510 
        close $ifile;
1511 
        close $tfile;
1512 
 
1513 
 
1514 
        # lets replace our original file with the new one
1515 
        #
1516 
        if(File::Copy::move("$tfileLoc", "$ifileLoc"))
1517 
        {
1518 
            Verbose2("ConvertFiles: Renamed [$tfileLoc] to [$ifileLoc] ...");
1519 
        }
1520 
        else
1521 
        {
1522 
            Error("ConvertFiles: Failed to rename file [$tfileLoc] to [$ifileLoc]: $!");
1523 
        }
1524 
    }
1525 
 
1526 
    return 1;
1527 
}
1528 
 
4641 dpurdie 1529 
#----------------------------------------------------------------------------
1530 
# Function        : ReplaceTags
1531 
#
1532 
# Description     : This sub-routine is used to replace Tags in one or more files
1533 
#
1534 
# Inputs          : outPath                 - Output directory
1535 
#                   flist                   - List of files in that directory
1536 
#                   or
1537 
#                   SearchOptions           - Search options to find files
1538 
#                                           --Recurse
1539 
#                                           --NoRecurse
1540 
#                                           --FilterIn=xxx
1541 
#                                           --FilterInRe=xxx
1542 
#                                           --FilterOut=xxx
1543 
#                                           --FilterOutRe=xxx
1544 
#                   Common options
1545 
#                                           --Tag=Tag,Replace
1546 
#
1547 
#
1548 
# Returns         : 1
1549 
#
1550 
sub ReplaceTags
1551 
{
1552 
    my @uargs;
1553 
    my $search =  JatsLocateFiles->new( '--NoRecurse' );
1554 
    my @tagsList;
1555 
    my $tagSep = ',';
1556 
    my @tagOrder;
1557 
    my %tagData;
1558 
 
1559 
    #
1560 
    #   Process user arguments extracting options
1561 
    #
1562 
    foreach  ( @_ )
1563 
    {
1564 
        if ( m~^--Recurse~ ) {
1565 
            $search->recurse(1);
1566 
 
1567 
        } elsif ( m~^--NoRecurse~) {
1568 
            $search->recurse(0);
1569 
 
1570 
        } elsif ( /^--FilterOut=(.*)/ ) {
1571 
            $search->filter_out($1);
1572 
 
1573 
        } elsif ( /^--FilterOutRe=(.*)/ ) {
1574 
            $search->filter_out_re($1);
1575 
 
1576 
        } elsif ( /^--FilterIn=(.*)/ ) {
1577 
            $search->filter_in($1);
1578 
 
1579 
        } elsif ( /^--FilterInRe=(.*)/ ) {
1580 
            $search->filter_in_re($1);
1581 
 
1582 
        } elsif ( m~^--Tag=(.*)~) {
1583 
            push @tagsList, $1;
1584 
 
1585 
        } elsif ( m~^--~) {
1586 
            Error ("ReplaceTags: Unknown option: $_");
1587 
 
1588 
        } else {
1589 
            push @uargs, $_;
1590 
        }
1591 
    }
1592 
 
1593 
    #
1594 
    #   Process non-option arguments
1595 
    #       - Base dir
1596 
    #       - List of files
1597 
    #
1598 
    my ($outPath, @flist) = @uargs;
1599 
    Error ("ReplaceTags: Target Dir must be specified" ) unless ( $outPath );
1600 
 
1601 
    #
1602 
    #   Sanity Tests
1603 
    #
1604 
    Error ("ReplaceTags: No tags specified" ) unless ( @tagsList );
1605 
 
1606 
    #
1607 
    # Convert output path to physical path
1608 
    #
1609 
    my $topDir = catdir($DebianWorkDir, $outPath);
1610 
    Verbose("ReplaceTags: topDir: $topDir");
1611 
    Error ("ReplaceTags: Path does not exist", $topDir) unless ( -e $topDir );
1612 
    Error ("ReplaceTags: Path is not a directory", $topDir) unless ( -d $topDir );
1613 
 
1614 
    #
1615 
    #   Convert Tags into pairs for latter use
1616 
    #
1617 
    my $sep = quotemeta ($tagSep );
1618 
    foreach my $tag ( @tagsList )
1619 
    {
4714 dpurdie 1620 
        my ($tname,$tvalue) = split ( $sep, $tag, 2 );
4641 dpurdie 1621 
        Error ("No tag value in: $tag" ) unless ( defined $tvalue );
1622 
        Error ("Duplicate Tag: $tname" ) if ( exists $tagData{$tname} );
1623 
        Verbose ("Tag: $tname :: $tvalue");
1624 
        push @tagOrder, $tname;
1625 
        $tagData{$tname} = $tvalue;
1626 
    }
1627 
 
1628 
    #
1629 
    #   Need to determine if we are searching or simply using a file list
1630 
    #   There are two forms of the functions. If any of the search options have
1631 
    #   been used then we assume that we are searchine
1632 
    #
1633 
    if ( $search->has_filter() )
1634 
    {
1635 
        Error ("ReplaceTags: Cannot mix search options with named files") if ( @flist );
1636 
        @flist = $search->search($topDir);
1637 
    }
1638 
    Error ("ReplaceTags: No files specified") unless ( @flist );
1639 
 
1640 
    #
1641 
    #   Process all named files
1642 
    #
1643 
    foreach my $file ( @flist )
1644 
    {
1645 
 
1646 
        # this is our file that we want to clean.
1647 
        my ($ifileLoc) = "$topDir/$file";
1648 
        my ($tfileLoc) = "$topDir/$file\.tmp";
1649 
        Verbose("ReplaceTags: $file");
1650 
 
1651 
        # we will check to see if the file exists.
1652 
        #
1653 
        my $ifile;
1654 
        my $tfile;
1655 
        if ( -f "$ifileLoc" )
1656 
        {
1657 
            open ($ifile, "< $ifileLoc" ) or
1658 
                Error("Failed to open file [$ifileLoc] : $!");
1659 
 
1660 
            open ($tfile, "> $tfileLoc" ) or
1661 
                Error("Failed to open file [$tfileLoc] : $!");
1662 
 
1663 
            while ( <$ifile> )
1664 
            {
1665 
                s~[\n\r]+$~~;               # Chomp
1666 
 
1667 
                #
1668 
                #   Perform tag replacement
1669 
                #
1670 
                foreach my $tag ( @tagOrder )
1671 
                {
1672 
                    my $value = $tagData{$tag};
1673 
                    if ( s~$tag~$value~g )
1674 
                    {
1675 
                        Verbose2("Replaced: $tag with $value");
1676 
                    }
1677 
                }
1678 
 
1679 
                print $tfile "$_\n";
1680 
            }
1681 
        }
1682 
        else
1683 
        {
1684 
            Error("ReplaceTags [$ifileLoc] does not exist.");
1685 
        }
1686 
 
1687 
        close $ifile;
1688 
        close $tfile;
1689 
 
1690 
 
1691 
        # lets replace our original file with the new one
1692 
        #
1693 
        if(File::Copy::move("$tfileLoc", "$ifileLoc"))
1694 
        {
1695 
            Verbose2("ReplaceTags: Renamed [$tfileLoc] to [$ifileLoc] ...");
1696 
        }
1697 
        else
1698 
        {
1699 
            Error("ReplaceTags: Failed to rename file [$tfileLoc] to [$ifileLoc]: $!");
1700 
        }
1701 
    }
1702 
 
1703 
    return 1;
1704 
}
1705 
 
4640 dpurdie 1706 
#-------------------------------------------------------------------------------
407 dpurdie 1707 
# Function        : SetFilePerms
1708 
#
1709 
# Description     : Set file permissions on one or more files or directories
1710 
#
1711 
# Inputs          : $perm           - Perm Mask
1712 
#                   @paths          - List of paths/files to process
1713 
#                   Options
1714 
#                       --Recurse   - Recurse subdirs
1715 
#
1716 
# Returns         :
1717 
#
1718 
sub SetFilePerms
1719 
{
1720 
 
1721 
    my @args;
1722 
    my $perms;
1723 
    my $recurse = 0;
1724 
 
1725 
    #
1726 
    #   Process and Remove options
1727 
    #
1728 
    foreach  ( @_ )
1729 
    {
1730 
        if ( m/^--Recurse/ ) {
1731 
            $recurse = 1;
1732 
 
1733 
        } elsif ( m/^--/ ) {
1734 
            Error ("SetFilePerms: Unknown option: $_");
1735 
 
1736 
        } else {
1737 
            push @args, $_;
1738 
 
1739 
        }
1740 
    }
1741 
 
1742 
    $perms = shift @args;
1743 
    Error ("SetFilePerms: No Permissions" ) unless ( $perms );
1744 
 
1745 
    foreach my $path ( @args )
1746 
    {
1747 
        Verbose ("Set permissions; $perms, $path");
1748 
        my $full_path = $DebianWorkDir . '/' . $path;
1749 
        if ( -f $full_path )
1750 
        {
1751 
            System ('chmod', $perms, $full_path );
1752 
        }
1753 
        elsif ( -d $full_path )
1754 
        {
1755 
            System ('chmod', '-R', $perms, $full_path ) if ($recurse);
1756 
            System ('chmod', $perms, $full_path ) unless ($recurse);
1757 
        }
1758 
        else
1759 
        {
1760 
            Warning("SetFilePerms: Path not found: $path");
1761 
        }
1762 
    }
1763 
}
1764 
 
1765 
#-------------------------------------------------------------------------------
4636 dpurdie 1766 
# Function        : SetPermissions
1767 
#
1768 
# Description     : Called to set permissions of files/dirs in a directory structure.
1769 
#                   With no options sets DirTag and all files/dirs in it to perms
1770 
#
1771 
# Inputs          : path        - The directory tag to start setting permissions on
1772 
#                   Options     - See below
1773 
#
1774 
#   Required Options:
1775 
#       One or both of
1776 
#               --FilePerms=    Sets the permissions of files to this permission.
1777 
#                               If not supplied then no files have their permissions changed
1778 
#               --DirPerms=     Sets the permissions of directories to this permission
1779 
#                               If not supplied then no directories have their permissions changed
1780 
#       OR
1781 
#               --Perms=        Sets the permissions of both files and directories to this permissions
1782 
#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
1783 
#
1784 
#   Options:
1785 
#               --RootOnly      Only sets the permissions on the 'path' directory/file,
1786 
#                               all other options ignored
1787 
#               --SkipRoot      Does not set permissions on the 'path' directory/file,
1788 
#                               obviously mutually exlusive with --RootOnly
1789 
#
1790 
#       Any option supported by JatsLocateFiles.
1791 
#       Some of these include:
1792 
#
1793 
#               --Recurse       Recurse the directory tree.  Does a depth first recurse so that all
1794 
#                               dir entries are processed before the dir itself (default)
1795 
#               --NoRecurse     Dont recurse
1796 
#               --FilterIn=     Apply permissions to files/directories that matches this value.
1797 
#               --FilterInRe=   Perl RE's can be used (Not Shell wildcards) and this option
1798 
#                               can be supplied mulitple times
1799 
#               --FilterOut=    Dont apply permissions to any files/directories matching this value
1800 
#               --FilterOutRe=  Perl RE's can be used (Not Shell wildcards) and this option
1801 
#                               can be supplied mulitple times
1802 
#
1803 
#                               FilterIn is applied before FilterOut.  If Recurse is specified
1804 
#                               the directory will be recursed regardless of these filters, however
1805 
#                               the filter will be applied when it comes time to chmod the dir
1806 
#
1807 
#------------------------------------------------------------------------------
1808 
sub SetPermissions
1809 
{
1810 
    my ( $path, $filePerms, $dirPerms, $someDone );
1811 
    my ( $rootOnly, $skipRoot ) = ( 0, 0 );
1812 
 
1813 
    my $search =  JatsLocateFiles->new( '--Recurse', '--DirsToo' );
1814 
 
1815 
    foreach ( @_ )
1816 
    {
1817 
        if ( m/^--Perms=(.*)/ ) {
1818 
            $filePerms = $1;
1819 
            $dirPerms = $1;
1820 
 
1821 
        } elsif (m/^--FilePerms=(.*)/ )  {
1822 
            $filePerms = $1;
1823 
 
1824 
        } elsif ( m/^--DirPerms=(.*)/ )  {
1825 
            $dirPerms = $1;
1826 
 
1827 
        }  elsif ( m/^--RootOnly/ ) {
1828 
            $rootOnly = 1;
1829 
 
1830 
        } elsif ( m/^--SkipRoot/ )  {
1831 
            $skipRoot = 1;
1832 
 
1833 
        } elsif ( m/^--Filter/ && $search->option( $_ ) ) {
1834 
            Verbose2 ("Search Option: $_" );
1835 
 
1836 
        } elsif ( m/^--Recurse|--NoRecurse/ && $search->option( $_ ) ) {
1837 
            Verbose2 ("Search Option: $_" );
1838 
 
1839 
        } elsif (m/^--/ ) {
1840 
            Error ("SetPermissions: Unknown option: $_");
1841 
 
1842 
        } else  {
1843 
            Error("SetPermissions 'path' already set", "Path: $_") if ( $path );
1844 
            $path = $_;
1845 
        }
1846 
    }
1847 
 
1848 
    #
1849 
    #   Sanity test
1850 
    #
1851 
    Error("SetPermissions called with out a 'path' parameter") if ( !defined($path) );
1852 
    Error("SetPermissions called with out any Permissions specified") if ( !defined($filePerms) && !defined($dirPerms) );
1853 
    Error("SetPermissions: Options --RootOnly & --SkipRoot are mutually exclusive" ) if ( $rootOnly && $skipRoot );
1854 
 
1855 
 
1856 
    #   Convert the target directory name into a physical path
1857 
    #   User specifies '/' as the root of the image
1858 
    #   User specifies 'name' as relateve to the root of the image
1859 
    #
1860 
    my $topDir = $DebianWorkDir . '/' . $path;
1861 
    $topDir =~ s~/+$~~;
1862 
 
1863 
    Verbose("SetPermissions: Called with options " . join(", ", @_));
1864 
 
1865 
    #
1866 
    #   Only set perms on the root directory
1867 
    #       This is a trivial operation
1868 
    #
1869 
    if ( $rootOnly )
1870 
    {
1871 
        $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1872 
    }
1873 
    else
1874 
    {
1875 
        #
1876 
        #   Create a list of files/dirs to process
1877 
        #
1878 
        my @elements = $search->search( $topDir );
1879 
 
1880 
        foreach my $dirEntry ( @elements )
1881 
        {
1882 
            my $fullPath = "$topDir/$dirEntry";
1883 
 
1884 
            # A dir and we dont have dirperms, so skip
1885 
            if ( -d $fullPath && !defined($dirPerms) )
1886 
            {
1887 
                Verbose2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
1888 
                next;
1889 
            }
1890 
 
1891 
            # A file and we dont have fileperms, so skip
1892 
            if ( -f $fullPath && !defined($filePerms) )
1893 
            {
1894 
                Verbose2("SetPermissions: Skipping file $fullPath as we have no file permissions");
1895 
                next;
1896 
            }
1897 
 
1898 
            # a file or a dir and have the right permissions and we are not recursing
1899 
            if ( -f $fullPath || -d $fullPath )
1900 
            {
1901 
                $someDone += chmodItem( $fullPath, $filePerms, $dirPerms );
1902 
            }
1903 
            else
1904 
            {
1905 
                Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
1906 
            }
1907 
        }
1908 
 
1909 
        #
1910 
        #   Process the topDir
1911 
        #   May not be modified if --SkipRoot has been requested
1912 
        #
1913 
        if ( !$skipRoot && -e $topDir )
1914 
        {
1915 
            $someDone += chmodItem( $topDir, $filePerms, $dirPerms );
1916 
        }
1917 
    }
1918 
 
1919 
    #   Final warning
1920 
    #
1921 
    Warning ("SetPermissions: No files located", "Args: @_") unless ( $someDone );
1922 
}
1923 
 
4676 dpurdie 1924 
#************ INTERNAL USE ONLY  **********************************************
4636 dpurdie 1925 
# Function        : chmodItem
1926 
#
1927 
# Description     : Internal
1928 
#                   chmod a file or a folder
1929 
#
1930 
# Inputs          : item                        - Item to mod
1931 
#                   filePerms                   - File perms
1932 
#                   dirPerms                    - dire perms
1933 
#
1934 
# Returns         : 1   - Item modified
1935 
#                   0   - Item not modified
1936 
#
4676 dpurdie 1937 
#************ INTERNAL USE ONLY  **********************************************
4636 dpurdie 1938 
sub chmodItem
1939 
{
1940 
    my ($item, $filePerms, $dirPerms) = @_;
1941 
 
1942 
    if ( -d $item && defined $dirPerms)
1943 
    {
1944 
        Verbose("SetPermissions: $dirPerms : $item");
1945 
        System ('chmod', $dirPerms, $item );
1946 
        return 1;
1947 
    }
1948 
 
1949 
    if ( -f $item  && defined $filePerms)
1950 
    {
1951 
        Verbose("SetPermissions: $filePerms : $item");
1952 
        System ('chmod', $filePerms, $item );
1953 
        return 1;
1954 
    }
1955 
 
1956 
    return 0;
1957 
}
1958 
 
1959 
 
1960 
#-------------------------------------------------------------------------------
407 dpurdie 1961 
# Function        : CreateDir
1962 
#
1963 
# Description     : Create a directory within the target workspace
1964 
#
1965 
# Inputs          : $path           - Name of the target directory
1966 
#
1967 
# Returns         : Nothing
1968 
#
1969 
sub CreateDir
1970 
{
1971 
    my ($path) = @_;
1972 
 
1973 
    Verbose ("Create Dir: $path");
1974 
    mkpath( $DebianWorkDir . '/' . $path );
1975 
}
1976 
 
1977 
#-------------------------------------------------------------------------------
1978 
# Function        : IsProduct
1979 
#                   IsPlatform
1980 
#                   IsTarget
427 dpurdie 1981 
#                   IsVariant
6088 dpurdie 1982 
#                   IsAlias
407 dpurdie 1983 
#
1984 
# Description     : This function allows some level of control in the
1985 
#                   packaging scripts. It will return true if the current
1986 
#                   product is listed.
1987 
#
1988 
#                   Ugly after thought
1989 
#
1990 
#                   Intended use:
1991 
#                       Xxxxxx(...) if (IsProduct( 'aaa',bbb' );
1992 
#
1993 
# Inputs          : products    - a list of products to compare against
1994 
#
1995 
# Returns         : True if the current build is for one of the listed products
1996 
#
1997 
sub IsProduct
1998 
{
1999 
    foreach ( @_ )
2000 
    {
2001 
        return 1 if ( $opt_product eq $_ );
2002 
    }
2003 
    return 0;
2004 
}
2005 
 
2006 
sub IsPlatform
2007 
{
2008 
    foreach ( @_ )
2009 
    {
2010 
        return 1 if ( $opt_platform eq $_ );
2011 
    }
2012 
    return 0;
2013 
}
2014 
 
2015 
sub IsTarget
2016 
{
2017 
    foreach ( @_ )
2018 
    {
2019 
        return 1 if ( $opt_target eq $_ );
2020 
    }
2021 
    return 0;
2022 
}
2023 
 
427 dpurdie 2024 
sub IsVariant
2025 
{
2026 
    foreach ( @_ )
2027 
    {
2028 
        return 1 if ( $opt_variant eq $_ );
2029 
    }
2030 
    return 0;
2031 
}
407 dpurdie 2032 
 
6088 dpurdie 2033 
my %opt_aliases;
2034 
sub IsAlias
2035 
{
2036 
 
2037 
    #
2038 
    #   Get the aliases from the build info
2039 
    #   This function was introduced late so its not always available
2040 
    #
2041 
    Error("IsAlias not supported in this version of JATS")
2042 
        unless (defined &ReadBuildConfig::getAliases);
2043 
    #
2044 
    #   Create an hash of aliases to simplify testing
2045 
    #   Do it onceand cache the results
2046 
    #
2047 
    unless (%opt_aliases) {
2048 
        %opt_aliases = map { $_ => 1 } getAliases();
2049 
    }
2050 
 
2051 
    foreach ( @_ )
2052 
    {
2053 
        return 1 if ( exists $opt_aliases{$_} );
2054 
    }
2055 
    return 0;
2056 
}
2057 
 
2058 
 
4676 dpurdie 2059 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2060 
# Function        : FindFiles
2061 
#
2062 
# Description     : Locate files within a given dir tree
2063 
#
2064 
# Inputs          : $root           - Base of the search
2065 
#                   $match          - Re to match
2066 
#
2067 
# Returns         : A list of files that match
2068 
#
4676 dpurdie 2069 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2070 
my @FIND_LIST;
2071 
my $FIND_NAME;
2072 
 
2073 
sub FindFiles
2074 
{
2075 
    my ($root, $match ) = @_;
2076 
    Verbose2("FindFiles: Root: $root, Match: $match");
2077 
 
2078 
    #
2079 
    #   Becareful of closure, Must use globals
2080 
    #
2081 
    @FIND_LIST = ();
2082 
    $FIND_NAME = $match;
2083 
    File::Find::find( \&find_files, $root);
2084 
 
2085 
    #
2086 
    #   Find callback program
2087 
    #
2088 
    sub find_files
2089 
    {
2090 
        my $item =  $File::Find::name;
2091 
 
2092 
        return if ( -d $File::Find::name );
2093 
        return unless ( $_ =~ m~$FIND_NAME~ );
2094 
        push @FIND_LIST, $item;
2095 
    }
2096 
    return @FIND_LIST;
2097 
}
2098 
 
2099 
#-------------------------------------------------------------------------------
2100 
# Function        : CalcRelPath
2101 
#
2102 
# Description     : Return the relative path to the current working directory
2103 
#                   as provided in $Cwd
2104 
#
2105 
# Inputs          : $Cwd - Base dir
2106 
#                   $base - Path to convert
2107 
#
2108 
# Returns         : Relative path from the $Cwd
2109 
#
2110 
sub CalcRelPath
2111 
{
2112 
    my ($Cwd, $base) = @_;
2113 
 
2114 
    my @base = split ('/', $base );
2115 
    my @here = split ('/', $Cwd );
2116 
    my $result;
2117 
 
2118 
    Debug("RelPath: Source: $base");
2119 
 
2120 
    return $base unless ( $base =~ m~^/~ );
2121 
 
2122 
    #
2123 
    #   Remove common bits from the head of both lists
2124 
    #
2125 
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
2126 
    {
2127 
        shift @base;
2128 
        shift @here;
2129 
    }
2130 
 
2131 
    #
2132 
    #   Need to go up some directories from here and then down into base
2133 
    #
2134 
    $result = '../' x ($#here + 1);
2135 
    $result .= join ( '/', @base);
2136 
    $result = '.' unless ( $result );
2137 
    $result =~ s~//~/~g;
2138 
    $result =~ s~/$~~;
2139 
 
2140 
    Debug("RelPath: Result: $result");
2141 
    return $result;
2142 
}
2143 
 
2144 
#-------------------------------------------------------------------------------
2145 
# Function        : ExpandLinkFiles
2146 
#
2147 
# Description     : Look for .LINK files in the output image and expand
2148 
#                   the links into softlinks
2149 
#
2150 
# Inputs          : None
2151 
#                   The rouine works on the $DebianWorkDir directory tree
2152 
#
2153 
# Returns         : Nothing
2154 
#                   Will remove .LINKS files that are processed
2155 
#
2156 
sub ExpandLinkFiles
2157 
{
2158 
    foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))
2159 
    {
2160 
        next if ( $linkfile =~ m~/\.svn/~ );
2161 
        my $BASEDIR = StripFileExt( $linkfile );
2162 
        $BASEDIR =~ s~^$DebianWorkDir/~~;
2163 
        Verbose "Expand links: $BASEDIR";
2164 
 
2165 
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
2166 
        while ( <LF> )
2167 
        {
2168 
            chomp;
2169 
            next if ( m~^#~ );
2170 
            next unless ( $_ );
2171 
            my ($link, $file) = split;
2172 
 
2173 
            MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
2174 
        }
2175 
        close (LF);
2176 
        unlink $linkfile;
2177 
    }
2178 
}
2179 
 
4676 dpurdie 2180 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2181 
# Function        : ResolveFile
2182 
#
2183 
# Description     : Determine where the source for a file is
415 dpurdie 2184 
#                   Will look in (default):
407 dpurdie 2185 
#                       Local directory
2186 
#                       Local Include
415 dpurdie 2187 
#                   Or  (FromPackage)
2188 
#                       Our Package directory
2189 
#                       Interface directory (BuildPkgArchives)
2190 
#                       Packages (LinkPkgArchive)
2191 
#
407 dpurdie 2192 
#                   Will scan 'parts' subdirs
2193 
#
2194 
# Inputs          : $from_package       - 0 - Local File
2195 
#                   $file
2196 
#
2197 
# Returns         : Path
2198 
#
4676 dpurdie 2199 
#************ INTERNAL USE ONLY  **********************************************
407 dpurdie 2200 
sub ResolveFile
2201 
{
2202 
    my ($from_package, $file) = @_;
2203 
    my $wildcard = ($file =~ /[*?]/);
415 dpurdie 2204 
    my @path;
407 dpurdie 2205 
 
2206 
    #
415 dpurdie 2207 
    #   Determine the paths to search
2208 
    #
2209 
    if ( $from_package )
2210 
    {
2211 
        unless ( @ResolveFileList )
2212 
        {
2213 
            push @ResolveFileList, $opt_pkgdir;
2214 
            foreach my $entry ( getPackageList() )
2215 
            {
2216 
                push @ResolveFileList, $entry->getBase(3);
2217 
            }
2218 
        }
2219 
        @path = @ResolveFileList;
2220 
    }
2221 
    else
2222 
    {
2223 
        @path = ('.', $opt_localincdir);
2224 
    }
2225 
 
2226 
    #
407 dpurdie 2227 
    #   Determine a full list of 'parts' to search
2228 
    #   This is provided within the build information
2229 
    #
2230 
    my @parts = getPlatformParts ();
2231 
    push @parts, '';
2232 
 
2233 
    my @done;
2234 
    foreach my $root (  @path )
2235 
    {
2236 
        foreach my $subdir ( @parts )
2237 
        {
2238 
            my $sfile;
415 dpurdie 2239 
            $sfile = "$root/$subdir/$file";
2240 
            $sfile =~ s~//~/~g;
2241 
            $sfile =~ s~^./~~g;
2242 
            Verbose2("LocateFile: $sfile, $root, $subdir");
2243 
            if ( $wildcard )
2244 
            {
2245 
                push @done, glob ( $sfile );
2246 
            }
2247 
            else
2248 
            {
2249 
                push @done, $sfile if ( -f $sfile || -l $sfile )
2250 
            }
407 dpurdie 2251 
        }
2252 
    }
2253 
 
415 dpurdie 2254 
    Error ("ResolveFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2255 
        unless ( @done );
2256 
 
2257 
    Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)
2258 
        if ( $#done > 0 && ! $wildcard && !wantarray );
2259 
 
2260 
    return wantarray ? @done : $done[0];
2261 
}
2262 
 
2263 
#-------------------------------------------------------------------------------
2264 
# Function        : ResolveBinFile
2265 
#
415 dpurdie 2266 
# Description     : Determine where the source for a BIN file is
2267 
#                   Will look in (default):
2268 
#                       Local directory
2269 
#                       Local Include
2270 
#                   Or  (FromPackage)
2271 
#                       Our Package directory
2272 
#                       Interface directory (BuildPkgArchives)
2273 
#                       Packages (LinkPkgArchive)
407 dpurdie 2274 
#                   Will scan 'parts' subdirs
2275 
#
2276 
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 2277 
#                   $file
407 dpurdie 2278 
#
2279 
# Returns         : Path
2280 
#
2281 
sub ResolveBinFile
2282 
{
2283 
    my ($from_package, $file) = @_;
2284 
    my @path;
2285 
    my @types;
2286 
    my $wildcard = ($file =~ /[*?]/);
2287 
 
415 dpurdie 2288 
    #
2289 
    #   Determine the paths to search
2290 
    #
407 dpurdie 2291 
    if ( $from_package )
2292 
    {
415 dpurdie 2293 
        unless ( @ResolveBinFileList )
2294 
        {
2295 
            push @ResolveBinFileList, $opt_pkgdir . '/bin';
2296 
            foreach my $entry ( getPackageList() )
2297 
            {
2298 
                if ( my $path = $entry->getBase(3) )
2299 
                {
2300 
                    $path .= '/bin';
2301 
                    push @ResolveBinFileList, $path if ( -d $path );
2302 
                }
2303 
            }
2304 
        }
2305 
        @path = @ResolveBinFileList;
407 dpurdie 2306 
        @types = ($opt_type, '');
2307 
    }
2308 
    else
2309 
    {
2310 
        @path = ($opt_bindir, $opt_localbindir);
2311 
        @types = '';
2312 
    }
2313 
 
2314 
    #
2315 
    #   Determine a full list of 'parts' to search
2316 
    #   This is provided within the build information
2317 
    #
2318 
    my @parts = getPlatformParts ();
2319 
    push @parts, '';
2320 
 
2321 
    my @done;
2322 
    foreach my $root (  @path )
2323 
    {
2324 
        foreach my $subdir ( @parts )
2325 
        {
2326 
            foreach my $type ( @types )
2327 
            {
2328 
                my $sfile;
2329 
                $sfile = "$root/$subdir$type/$file";
2330 
                $sfile =~ s~//~/~g;
2331 
                Verbose2("LocateBinFile: $sfile");
2332 
                if ( $wildcard )
2333 
                {
429 dpurdie 2334 
                    foreach  ( glob ( $sfile ) )
2335 
                    {
4143 dpurdie 2336 
                        # Ignore .dbg (vix) and .debug (qt) files.
429 dpurdie 2337 
                        next if ( m~\.dbg$~ );
4143 dpurdie 2338 
                        next if ( m~\.debug$~ );
429 dpurdie 2339 
                        push @done, $_;
2340 
                    }
407 dpurdie 2341 
                }
2342 
                else
2343 
                {
415 dpurdie 2344 
                    push @done, $sfile if ( -f $sfile || -l $sfile )
407 dpurdie 2345 
                }
2346 
            }
2347 
        }
2348 
    }
2349 
 
415 dpurdie 2350 
    Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2351 
        unless ( @done );
2352 
 
5026 dpurdie 2353 
    if ( $#done > 0 && ! $wildcard )
2354 
    {
2355 
        Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done);
2356 
        splice (@done, 1);
2357 
    }
2358 
 
407 dpurdie 2359 
    return wantarray ? @done : $done[0];
2360 
}
2361 
 
2362 
#-------------------------------------------------------------------------------
2363 
# Function        : ResolveLibFile
2364 
#
415 dpurdie 2365 
# Description     : Determine where the source for a LIB file is
2366 
#                   Will look in (default):
2367 
#                       Local directory
2368 
#                       Local Include
2369 
#                   Or  (FromPackage)
2370 
#                       Our Package directory
2371 
#                       Interface directory (BuildPkgArchives)
2372 
#                       Packages (LinkPkgArchive)
407 dpurdie 2373 
#                   Will scan 'parts' subdirs
2374 
#
4672 dpurdie 2375 
# Inputs          : $from_package   - 0:Local File
2376 
#                   $file           - Basename for a 'realname'
2377 
#                                     Do not provide 'lib' or '.so' or version info
2378 
#                                     May contain embedded options
2379 
#                                       --Dll           - Use Windows style versioned DLL
2380 
#                                       --VersionDll    - Use the versioned DLL
2381 
#                                       --3rdParty      - Use exact name provided
407 dpurdie 2382 
#
2383 
# Returns         : Path
2384 
#
2385 
sub ResolveLibFile
2386 
{
2387 
    my ($from_package, $file) = @_;
2388 
    my $wildcard = ($file =~ /[*?]/);
2389 
    my @options;
2390 
    my $num_dll;
415 dpurdie 2391 
    my @path;
407 dpurdie 2392 
    #
2393 
    #   Extract options from file
2394 
    #
409 alewis 2395 
    $num_dll = 0;
407 dpurdie 2396 
    ($file, @options) = split ( ',', $file);
2397 
    foreach ( @options )
2398 
    {
2399 
        if ( m/^--Dll/ ) {
2400 
            $num_dll = 1;
2401 
        } elsif ( m/^--VersionDll/ ) {
2402 
            $num_dll = 2;
4672 dpurdie 2403 
        } elsif ( m/^--3rdParty/ ) {
2404 
            $num_dll = 3;
407 dpurdie 2405 
        } else {
2406 
            Error ("Unknown suboption to ResolveLibFile: $_" );
2407 
        }
2408 
    }
2409 
 
2410 
    #
415 dpurdie 2411 
    #   Determine the paths to search
2412 
    #
2413 
    if ( $from_package )
2414 
    {
2415 
        unless ( @ResolveLibFileList )
2416 
        {
2417 
            push @ResolveLibFileList, $opt_pkgdir . '/lib';
2418 
            foreach my $entry ( getPackageList() )
2419 
            {
2420 
                push @ResolveLibFileList, $entry->getLibDirs(3);
2421 
            }
2422 
        }
2423 
        @path = @ResolveLibFileList;
2424 
    }
2425 
    else
2426 
    {
2427 
        @path = ($opt_libdir, $opt_locallibdir);
2428 
    }
2429 
 
2430 
    #
407 dpurdie 2431 
    #   Determine a full list of 'parts' to search
2432 
    #   This is provided within the build information
2433 
    #
2434 
    my @parts = getPlatformParts ();
2435 
    push @parts, '';
2436 
 
2437 
    my @done;
2438 
    foreach my $root (  @path )
2439 
    {
2440 
        foreach my $type ( $opt_type, '' )
2441 
        {
2442 
            foreach my $subdir ( @parts )
2443 
            {
2444 
                my $sfile;
2445 
                my $exact;
2446 
                if ( $num_dll == 2 ) {
2447 
                    $sfile = $file . $type . '.*.dll' ;
2448 
                } elsif ( $num_dll == 1 ) {
2449 
                    $sfile = $file . $type . '.dll' ;
2450 
                    $exact = 1;
4672 dpurdie 2451 
                } elsif ( $num_dll == 3 ) {
2452 
                    $sfile = $file;
2453 
                    $exact = 1;
407 dpurdie 2454 
                } else {
2455 
                    $sfile = "lib" . $file . $type . '.so.*';
2456 
                }
2457 
 
2458 
                $sfile = "$root/$subdir/$sfile";
2459 
                $sfile =~ s~//~/~g;
2460 
                Verbose2("LocateLibFile: $sfile");
2461 
                if ( $exact )
2462 
                {
415 dpurdie 2463 
                    push @done, $sfile if ( -f $sfile || -l $sfile );
407 dpurdie 2464 
                }
419 dpurdie 2465 
                elsif ($num_dll)
407 dpurdie 2466 
                {
2467 
                    push @done, glob ( $sfile );
2468 
                }
419 dpurdie 2469 
                else
2470 
                {
2471 
                    #
2472 
                    #   Looking for .so files
2473 
                    #   Filter out the soname so files
2474 
                    #   Assume that the soname is shorter than the realname
4143 dpurdie 2475 
                    #       Ignore .dbg (vix) and .debug (qt) files.
419 dpurdie 2476 
                    #
2477 
                    my %sieve;
2478 
                    foreach ( glob ( $sfile )  )
2479 
                    {
429 dpurdie 2480 
                        next if ( m~\.dbg$~ );
4143 dpurdie 2481 
                        next if ( m~\.debug$~ );
421 alewis 2482 
                        m~(.*\.so\.)([\d\.]*\d)$~;
2483 
                        if ( $1 )
2484 
                        {
2485 
                            my $file = $1;
2486 
                            my $len = exists $sieve{$file} ? length($sieve{$file}) : 0;
2487 
                            $sieve{$file} = $_
2488 
                                if ( $len == 0 || length($_) > $len );
2489 
                        }
419 dpurdie 2490 
                    }
2491 
 
2492 
                    push @done, values %sieve;
2493 
                }
407 dpurdie 2494 
            }
2495 
        }
2496 
    }
2497 
 
415 dpurdie 2498 
    Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)
407 dpurdie 2499 
        unless ( @done );
2500 
 
5026 dpurdie 2501 
    if ( $#done > 0 && ! $wildcard )
2502 
    {
2503 
        Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done);
2504 
        splice (@done, 1);
2505 
    }
407 dpurdie 2506 
    return wantarray ? @done : $done[0];
2507 
}
2508 
 
6088 dpurdie 2509 
#-------------------------------------------------------------------------------
2510 
# Function        : ResolveDebPackage
2511 
#
2512 
# Description     : Determine where the source for a Debian Package is
2513 
#                   Will look in (default):
2514 
#                       Local directory
2515 
#                       Local Include
2516 
#                   Or  (FromPackage)
2517 
#                       Our Package directory
2518 
#                       Interface directory (BuildPkgArchives)
2519 
#                       Packages (LinkPkgArchive)
2520 
#
2521 
# Inputs          : $from_package   - 0:Local File
2522 
#                   $baseName       - Basename for a 'DebianPackage'
2523 
#                                     Do not provide version info, architecture or suffix
2524 
#                                     May contain embedded options
2525 
#                                       --Arch=XXX      - Specify alternate architcute
2526 
#                                       --Product=YYYY  - Specify product family
2527 
#                                       --Debug         - Use alternate build type
2528 
#                                       --Prod          - Use alternate build type
2529 
#
2530 
# Returns         : Path
2531 
#
2532 
sub ResolveDebPackage
2533 
{
2534 
    my ($from_package, $file) = @_;
2535 
    my @path;
2536 
    my $arch;
2537 
    my $product;
2538 
    my $buildType;
2539 
    my @types;
2540 
    my $baseName;
2541 
    my @options;
407 dpurdie 2542 
 
6088 dpurdie 2543 
    #
2544 
    #   Extract options from file
2545 
    #
2546 
    ($baseName, @options) = split ( ',', $file);
2547 
    foreach ( @options )
2548 
    {
2549 
        if ( m/^--Arch=(.+)/ ) {
2550 
            $arch=$1;
2551 
        } elsif ( m/^--Product=(.+)/ ) {
2552 
            $product = $1;
2553 
        } elsif ( m/^--Debug/ ) {
2554 
            Error ("ResolveDebPackage: Cannot specify --Prod and --Debug") if defined $buildType;
2555 
            $buildType = 'D';
2556 
        } elsif ( m/^--Prod/ ) {
2557 
            Error ("ResolveDebPackage: Cannot specify --Prod and --Debug") if defined $buildType;
2558 
            $buildType = 'P';
2559 
        } else {
2560 
            Error ("Unknown suboption to ResolveDebPackage: $_" );
2561 
        }
2562 
    }
2563 
 
2564 
    #
2565 
    #   Insert defaults
2566 
    #
2567 
    $buildType = $opt_type unless ($buildType);
2568 
    $arch = $opt_target unless ($arch);
2569 
 
2570 
    #
2571 
    #   Determine the paths to search
2572 
    #
2573 
    if ( $from_package )
2574 
    {
2575 
        unless ( @ResolveDebFileList )
2576 
        {
2577 
            push @ResolveDebFileList,  $opt_pkgdir, $opt_pkgdir . '/bin';
2578 
            foreach my $entry ( getPackageList() )
2579 
            {
2580 
                if ( my $path = $entry->getBase(3) )
2581 
                {
2582 
                    push @ResolveDebFileList, $path if ( -d $path );
2583 
 
2584 
                    $path .= '/bin';
2585 
                    push @ResolveDebFileList, $path if ( -d $path );
2586 
                }
2587 
            }
2588 
        }
2589 
        @path = @ResolveDebFileList;
2590 
        @types = ($opt_type, '');
2591 
    }
2592 
    else
2593 
    {
2594 
        @path = ($opt_bindir, $opt_localbindir);
2595 
        @types = ($opt_type, '');
2596 
    }
2597 
 
2598 
    #
2599 
    #   The debian  package name is
2600 
    #   In packages BIN dir
2601 
    #       (BaseName)_VersionString(_Product)(_Arch).deb
2602 
    #
2603 
    #   In root of package
2604 
    #       (BaseName)_VersionString(_Product)(_Arch)(_Type).deb
2605 
    #
2606 
    #
2607 
    #   The package may be found in
2608 
    #       Package Root
2609 
    #       Package bin directory
2610 
    #
2611 
    $file = $baseName . '_*';
2612 
    if (defined $product) {
2613 
        $file .= ( '_' . $product)
2614 
        }
2615 
    $file .= '_' . $arch;
2616 
 
2617 
    #
2618 
    #   Determine a full list of 'parts' to search
2619 
    #   This is provided within the build information
2620 
    #
2621 
    my @parts = getPlatformParts ();
2622 
    push @parts, '';
2623 
 
2624 
    my @done;
2625 
    foreach my $root (  @path )
2626 
    {
2627 
        foreach my $subdir ( @parts )
2628 
        {
2629 
            foreach my $type ( @types )
2630 
            {
2631 
                my $sfile;
2632 
                $sfile = "$root/$subdir$type/$file";
2633 
                $sfile =~ s~//~/~g;
2634 
                foreach my $type2 ( @types )
2635 
                {
2636 
                    my $tfile = $sfile;
2637 
                    $tfile .= '_' . $type2 if $type2;
2638 
                    $tfile .= '.deb';
2639 
                    Verbose2("ResolveDebPackage: $tfile");
2640 
                    foreach  ( glob ( $tfile ) )
2641 
                    {
2642 
                        push @done, $_;
2643 
                    }
2644 
                }
2645 
            }
2646 
        }
2647 
    }
2648 
 
2649 
    Error ("ResolveDebPackage: Package not found: $file", "Search Path:", @path)
2650 
        unless ( @done );
2651 
 
2652 
    if ( $#done > 0 )
2653 
    {
2654 
        Error ("ResolveDebPackage: Multiple instances of Package found.", @done);
2655 
    }
2656 
    return wantarray ? @done : $done[0];
2657 
}
2658 
 
2659 
 
2660 
 
407 dpurdie 2661 
#-------------------------------------------------------------------------------
2662 
# Function        : AUTOLOAD
2663 
#
2664 
# Description     : Intercept bad user directives and issue a nice error message
2665 
#                   This is a simple routine to report unknown user directives
2666 
#                   It does not attempt to distinguish between user errors and
2667 
#                   programming errors. It assumes that the program has been
2668 
#                   tested. The function simply report filename and line number
2669 
#                   of the bad directive.
2670 
#
2671 
# Inputs          : Original function arguments ( not used )
2672 
#
2673 
# Returns         : This function does not return
2674 
#
2675 
our $AUTOLOAD;
2676 
sub AUTOLOAD
2677 
{
2678 
    my $fname = $AUTOLOAD;
2679 
    $fname =~ s~^main::~~;
2680 
    my ($package, $filename, $line) = caller;
2681 
 
2682 
    Error ("Directive not known or not allowed in this context: $fname",
2683 
           "Directive: $fname( @_ );",
2684 
           "File: $filename, Line: $line" );
2685 
}
2686 
 
2687 
 
2688 
1;
2689