Subversion Repositories DevTools

Rev

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

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