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