Subversion Repositories DevTools

Rev

Rev 6856 | Rev 6859 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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