Subversion Repositories DevTools

Rev

Rev 6857 | Rev 6861 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

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