Subversion Repositories DevTools

Rev

Rev 4695 | Details | Compare with Previous | Last modification | View Log | RSS feed

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