Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
1544 dpurdie 1
########################################################################
2
# Copyright (C) 2006 ERG Limited, All rights reserved
1530 dpurdie 3
#
4
# Program Name        : deploylib.pm
5
#
6
# Program Type        : Perl Module (.pm)
7
#
8
# Original Author(s)  : V.Chatzimichail(vasilic)
9
#
10
# Description / Purpose:
11
#      Deploylib is a set of high-level functions written in Perl (for portability) 
12
#      that allow a user to quickly setup a deployment configuration and produce a 
13
#      deliverable package.
14
#
1544 dpurdie 15
# Description:
16
#
17
#
1556 lkelly 18
#
19
# 2008-08-13 Note on --InstallProdAndDebug option and AlternateBuildType:
20
#   This option has been added to several functions to allow for the a build
21
#   to contain both debug and production files. 
22
#   Most of the deploylib is based on the use of $BuildType to determine where 
23
#   to look for things and what files to include. To allow for both types, 
24
#   $AlternateBuildType is set up to hold the opposite of $BuildType 
25
#   (e.g. D vs P). and the DpkgBinDirListAlternate and DpkgLibDirListAlternate
26
#   variables are set up to hold 'alternate' sets of directories to search.
27
#   In theory, we should support 'any' build type, in which case this option
28
#   would be implemented differently, but P/D are hardcoded throughout here,
29
#   so this was done as a minimal impact change.
30
#   
31
#
1544 dpurdie 32
#......................................................................#
1530 dpurdie 33
 
1556 lkelly 34
require 5.006_001;
1530 dpurdie 35
 
1556 lkelly 36
 
1530 dpurdie 37
#------------------------------------------------------------------------------
38
# Package definition
39
#------------------------------------------------------------------------------
40
package deploylib;
41
 
42
#------------------------------------------------------------------------------
43
# Pragmas
44
#------------------------------------------------------------------------------
45
use strict;
46
use Getopt::Std;
47
use File::Copy;
48
use File::Find;
49
use File::Basename;
50
use File::Path;
51
use Cwd;
52
use Carp;
53
use DBI;
54
use DeployUtils::RmPkgInfo;
1532 dpurdie 55
use BuildConfig;
1530 dpurdie 56
use Exporter();
1534 dpurdie 57
 
1530 dpurdie 58
use ArrayHashUtils;
1556 lkelly 59
use JatsEnv;
1534 dpurdie 60
use JatsError;
61
use JatsSystem;
1530 dpurdie 62
 
1538 dpurdie 63
 
1530 dpurdie 64
#-------------------------------------------------------------------------------
65
#   Export variables and function into the users name space
66
#-------------------------------------------------------------------------------
67
our @ISA    = qw(Exporter);
68
our @EXPORT = qw(
69
                    &Init
70
                    &setPkgDescription
71
                    &setPkgName
72
                    &setErgAfcBaseDir
73
                    &setPkgOverview
74
                    &addInstallshieldFiles
75
                    &installAllDpkgArchivePkgFiles
76
                    &installAllDpkgArchivePkgFiles2
77
                    &installAllDpkgArchiveDevcdFiles
78
                    &installAllDpkgArchiveJspFiles
79
                    &installAllDpkgArchiveFiles
80
                    &installAllDpkgArchiveAcHtmlFiles
81
                    &installAllDpkgArchiveInfoFilesFiles
82
                    &installAllDpkgArchiveSqlFiles
83
                    &installAllDpkgArchiveWarFiles
84
                    &installAllDpkgArchiveJarFiles
85
                    &installAllDpkgArchiveEtcFiles
86
                    &installAllDpkgArchiveScriptsFiles
87
                    &installAllDpkgArchiveIncludeFiles
88
                    &installAllDpkgArchiveDocFiles
89
                    &installDpkgArchiveFile
90
                    &installDpkgArchiveAcHtmlFile
91
                    &installDpkgArchiveRptFile
92
                    &installDpkgArchiveRoxFile
93
                    &installDpkgArchiveDatFile
94
                    &installDpkgArchiveThxFile
95
                    &installDpkgArchiveMugFile
96
                    &installDpkgArchiveInfoFilesFile
97
                    &installDpkgArchiveSqlFile
98
                    &installDpkgArchiveWarFile
99
                    &installDpkgArchiveJarFile
100
                    &installDpkgArchiveSarFile
101
                    &installDpkgArchiveEtcFile
102
                    &installDpkgArchiveScriptsFile
103
                    &installDpkgArchiveIncludeFile
104
                    &installDpkgArchiveDocFile
105
                    &installDpkgArchiveBinFile
106
                    &installDpkgArchiveLibFile
107
                    &installPkgAddConfigFile
108
                    &installPkgAddSystemClassFile
1540 dpurdie 109
                    &installDpkgArchivePkgRaw
1530 dpurdie 110
                    &updatePrototypeFileAddItem
111
                    &updatePrototypeFileAddItem2
112
                    &addPath2Prototype
113
                    &createAfcRcScriptLink
114
                    &createAfcRcScriptLink2
115
                    &installAllDpkgArchiveBinFiles
116
                    &CreateTargetDirStructure
117
                    &createPatch
118
                    &createPackage
119
                    &createPrototypeFile
120
                    &addPatchInfo2ProtoTypeFile
121
                    &addPkgInfoClasses
122
                    &addPkgInfoField
123
                    &updatePrototypeFileItemClass
124
                    &useReplaceClass
125
                    &setReplaceClassFiles
126
                    &createPkginfoFile
127
                    &updatePrototypeFileItemOwner
1556 lkelly 128
                    &setPermissions
1530 dpurdie 129
                    &chmod
130
                    &chmodRecursive
131
                    &chmodDir
132
                    &chmodFile
133
                    &createSymbolicLink
134
                    &createPrototypeFile2
135
                    &installDeployFile
136
                    &createDpkgArchive
137
                    &generateHtmlReleaseNote
138
                    &generateIShieldIncludeFile
139
                    &createPerlSvcWin32
140
                    &createPerlAppWin32
141
                    &convertFile
142
 
143
                    &getErgAfcBaseDir
144
                    &getGenericNameNoVersionForLib
145
                    &getGenericNameForLib
1534 dpurdie 146
                    &createZip
1544 dpurdie 147
                    &generateXmlDependancy
1530 dpurdie 148
 
149
                    %TargetDstDirStructure
150
                    %LocalSrcDirStructure
151
                    %BuildPkgArchive
152
                    $MachType
153
                    $TargetHomeDir
154
                    $TargetBaseDir
155
 
156
                    $PkgName
1540 dpurdie 157
                    $PkgVersionUser
158
                    $PkgVersion
1530 dpurdie 159
 
160
                );
161
 
162
#------------------------------------------------------------------------------
163
# Constants global/local to this package
164
#------------------------------------------------------------------------------
165
use vars qw ( $opt_n $opt_v $opt_r $opt_t $opt_m $opt_d $opt_p $opt_o $opt_k $opt_g );
166
 
167
my ($VENDOR_DESC)            = "ERG Transit Systems Ltd";
168
my ($CATEGORY_DESC)          = "application";
169
my ($ERGAFC_BASEDIR)         = "/afc";
170
my ($MAXINST)                = "1000";
171
my ($PKG_OVERVIEW)           = "To Be Defined.";
172
 
173
my (@PATCH_INFO_FILES) = qw (
174
    checkinstall 
175
    copyright 
176
    patch_checkinstall 
177
    patch_postinstall 
178
    i.none 
179
    postinstall 
180
    preinstall 
181
) ;
182
 
183
my (@PATCH_UTIL_FILES) = qw ( backoutpatch installpatch );
184
 
1572 gchristi 185
my (@PKG_UTIL_FILES) = qw ( requestlib.sh chkuser.pl );
1530 dpurdie 186
 
187
my (@PKG_ISHIELD_FILES)   = qw ( ishieldlib.rul ishieldlib.h );
188
 
189
my (@PKG_ISHIELD_IMG_FILES) = qw ( 
190
   islib_pane.bmp
191
   islib_splash.bmp
192
   islib_topicon.bmp
193
);
194
 
195
 
196
my (@PATCH_ISHIELD_FILES) = qw ( 
197
    postinstall.rul
198
    preinstall.rul 
199
    postremove.rul 
200
    preremove.rul 
201
);
202
 
203
my ($PKG_ISHIELD_DEF_FILE) = "pkgdef.h";
204
my ($PKG_ISHIELD_DIR)      = "";
205
 
206
my ($PKG_UTIL_DIR)   = "";
207
my ($PATCH_UTIL_DIR) = "";
208
 
209
 
210
my ($m_UID)  = "";
211
my ($m_GID)  = "";
212
my ($m_MASK) = "";
1550 dpurdie 213
my ($m_KEEP_MASK) = "";
1556 lkelly 214
my ($m_KEEP_LINKS) = "";
1530 dpurdie 215
 
216
 
217
#------------------------------------------------------------------------------
218
# Variables global/local to this package
219
#------------------------------------------------------------------------------
220
our $InterfaceDir       = "";
221
 
222
our $DpkgBinDir         = "";
223
our %DpkgBinDirList     = ();
1556 lkelly 224
our %DpkgBinDirListAlternate = (); # bin dir list for $AlternateBuildType
1530 dpurdie 225
our $DpkgLibDir         = "";
226
our %DpkgLibDirList     = ();
1556 lkelly 227
our %DpkgLibDirListAlternate = (); # lib dir list for $AlternateBuildType
1530 dpurdie 228
our $DpkgScriptsDir     = "";
229
our $DpkgEtcDir         = "";
230
our $DpkgJarDir         = "";
231
our $DpkgSarDir         = "";
232
our $DpkgWarDir         = "";
233
our $DpkgSqlDir         = "";
234
our $DpkgInfoFilesDir   = "";
235
our $DpkgPkgDir         = "";
236
our $DpkgJspDir         = "";
237
our $DpkgRoxDir         = "";
238
our $DpkgRptDir         = "";
239
our $DpkgAcHtmlDir      = "";
240
our $DpkgIncludeDir     = "";
241
our $DpkgDevcdDir       = "";
242
our $DpkgDatDir         = "";
243
our $DpkgThxDir         = "";
244
our $DpkgMugDir         = "";
245
our $DpkgDocDir         = "";
246
 
247
our @LibCheckList       = ();
248
 
249
our $CurrentDir         = "";
250
our $RootDir            = "";
251
our $BuildType          = "";
1556 lkelly 252
our $AlternateBuildType = ""; # the opposite of $BuildType
1530 dpurdie 253
our $MachType           = "";
1568 dpurdie 254
our $MachArch           = "";
1570 gchristi 255
our $MachISA            = "";
1530 dpurdie 256
our $Platform           = "";
257
our $Product            = "";
258
our $Target             = "";
259
our $SrcDir             = "";
260
our $PkgDir             = "";
261
our $ReleaseDir         = "";
262
our $Username           = "";
263
 
264
our $PkgBaseDir         = "";
265
our $PkgInfoFileName    = "pkginfo";
266
our $PkgInfoFile        = "";
267
our $ProtoTypeFileName  = "prototype";
268
our $ProtoTypeFile      = "";
269
 
270
our $PkgPatchName       = "";
271
our $PkgPatchID         = "";
272
our $PkgPatchNum        = "";
273
our $PkgPatchReadme     = "";
274
our $PkgPatchTmpDir     = "";
275
 
276
our $PkgVersion         = "";
277
our $PkgVersionStr      = "";
278
our $PkgVersionUser     = "";
279
our $PkgName            = "";
280
our $PkgBuildNum        = "";
281
our $PkgOutputFile      = "";
282
our $PkgReleaseNote     = "";
283
our $PkgLabel           = "";
284
our $PkgDesc            = "";
285
our $PkgNameLong        = "";
286
our $PkgInfoClasses     = "none";
287
 
288
our $PkgPreviousVersionStr = "";
289
our $TargetBaseDir      = "";
290
our $TargetHomeDir      = "";
291
 
292
our $SandBoxName        = "";
293
our $ProjectAcronym     = "";
294
 
295
our $TmpGlobalVariable  = ""; # used to pass variables into PERL find functions
296
 
297
our %TargetDstDirStructure = ();
298
our %LocalSrcDirStructure  = ();
299
 
300
our $BuildFileInfo       = "";
301
# This was removed to add the use of the Buildfile.pm module, but this hash is needed 
302
# because the deployfiles use it for library version numbers in the file lists.
303
# So it is left here and is a simply copy of the hash from buildfile pm
304
our %BuildPkgArchive     = ();
305
 
306
our $RmPkgDetails        = undef;
307
our $RmPvPkgDetails      = undef;
308
 
309
 
310
#------------------------------------------------------------------------------
311
# Initialization actions
312
#------------------------------------------------------------------------------
313
 
1534 dpurdie 314
#
315
#   Init the error and message subsystem
316
#
317
ErrorConfig( 'name'    => 'DEPLOYLIB' ,
318
             'debug'   => $ENV{GBE_DEBUG},
319
             'verbose' => $ENV{GBE_VERBOSE},
320
             );
1530 dpurdie 321
 
1534 dpurdie 322
 
1530 dpurdie 323
#------------------------------------------------------------------------------
324
# Package Interface Subroutines
325
#
326
# The following functions are used by the Makefile.pl scripts.  Programmers
327
# call the following functions to set up the basic requirements that the
328
# automated make system requires.
329
#------------------------------------------------------------------------------
330
 
331
 
332
#------------------------------------------------------------------------------
333
sub Init
334
#
335
# Description:
336
#       Tests Environment Variables, it also checks the required command line 
337
#       variables.
338
#
339
# Inputs:
340
#       Command line.
341
#
342
# Returns:
343
#  1
344
#
345
# Globals:
346
#  $makelib::RootDir
347
#
348
# Notes:
349
#  -
350
#
351
# Todo:
352
#  -
353
#------------------------------------------------------------------------------
354
{
355
 
356
    # first we deal with the command line values we expect, these include:
357
    #  	GBE_ROOT                                                       (-r)
358
    #  	Package Name                                                   (-n)
359
    #  	Package Home Directory (relative to the ERGAFC_BASEDIR)        (-d)
360
    #  	Package Version                                                (-v)
361
    #  	Build Type                                                     (-t)
362
    #  	Patch Number                                                   (-p)
363
    #  	Previous (old) version number                                  (-o)
364
    #  	Platform                                                       (-m)
365
    # 	Product (optional)                                             (-k)
366
    #  	Machine Type (optional)                                        (-g)
367
 
368
    $CurrentDir = cwd;
369
 
370
    my ($i);
371
    Getopt::Std::getopts ('v:n:r:t:m:d:p:o:k:g:');
372
    if ( $opt_n )
373
    {
374
        $PkgName      = $opt_n;
375
    }
376
    else
377
    {
1534 dpurdie 378
        Error("Package Name not supplied!");
1530 dpurdie 379
    }
380
 
381
    if ( $opt_r )
382
    {
383
        # lets change to root dir and get fully qualified path from cwd and return back
384
        chdir($opt_r);
385
        $RootDir = cwd;
386
        chdir($CurrentDir);
387
 
388
        $SandBoxName      = File::Basename::basename($RootDir);
389
    }
390
    else
391
    {
1534 dpurdie 392
        Error("GBE_ROOT not supplied!");
1530 dpurdie 393
    }
394
 
395
    if ( $opt_t )
396
    {
397
        $BuildType = $opt_t;
398
    }
399
    else
400
    {
1534 dpurdie 401
        Error("GBE_TYPE not supplied!");
1530 dpurdie 402
    }
403
 
404
    #
405
    #   Target machine type ( Underlying machine type in a Product Family)
406
    #   If not provided, the assume that its the same as the platform (compat)
407
    #
408
    $opt_g = $opt_m unless ( $opt_g );
409
    if ( $opt_g )
410
    {
411
        $Target = $opt_g;
412
        if ( $Target =~ /^SOLARIS/ )
413
        {
414
            $MachType = 'sparc';
1570 gchristi 415
            if ( $Target =~ /X86/i )
1568 dpurdie 416
            {
1570 gchristi 417
                $MachArch = 'i386';
418
                $MachISA = "";
1568 dpurdie 419
            }
1570 gchristi 420
            elsif ( $Target =~ /X64/i )
421
            {
422
                $MachArch = 'i386';
423
                $MachISA = "amd64";
424
            }
425
            elsif ( $Target =~ /SPARC64/i )
426
            {
427
                $MachArch = 'sparc';
428
                $MachISA = "sparcv9";
429
            }
430
            else
431
            {
432
                $MachArch = 'sparc';
433
                $MachISA = "";
434
            }
1530 dpurdie 435
        }
436
        elsif ( $Target =~ /^WCE/ )
437
        {
438
            $MachType = 'WinCE';
439
        }
440
        elsif ( $Target =~ /^WIN32/ )
441
        {
442
            $MachType = 'win32';
443
        }
444
        else
445
        {
1534 dpurdie 446
            Error("Unknown target [$opt_g] supplied!");
1530 dpurdie 447
        }
448
    }
449
 
450
    #
451
    #   Platform
452
    #   This is the full product name in a product family.
453
    #
454
    if ( $opt_m )
455
    {
456
        $Platform = $opt_m;
457
    }
458
    else
459
    {
1534 dpurdie 460
        Error("Platform not supplied!");
1530 dpurdie 461
    }
462
 
463
    #
464
    #   Setup Product
465
    #   If not defined then use the platform
466
    #
467
    $Product = $opt_k ? $opt_k : $Platform;
468
 
469
    if ( $opt_d )
470
    {
1570 gchristi 471
        # if no targetbasedir then set it to "." to simulate targetbasedir
472
        if ( $opt_d eq "--NoDir" || $opt_d eq "--NoTargetBaseDir" )
473
        {
474
            $TargetBaseDir = ".";   
475
        }
476
        else
477
        {
478
            $TargetBaseDir = $opt_d;
479
        }
1530 dpurdie 480
    }
481
    else
482
    {
1534 dpurdie 483
        Error("Package base directory not supplied!");
1530 dpurdie 484
    }
485
 
486
    if ( $opt_p )
487
    {
488
        my $pNum = sprintf("%02s", $opt_p);
489
        if ( "$pNum" =~ m/^[0-9][0-9]$/ )
490
        {
491
            $PkgPatchNum = $pNum;
492
        }
493
        else
494
        {
1534 dpurdie 495
            Error("-p command line arg [$opt_p] has invalid format",
496
                     "Required format is an integer value.");
1530 dpurdie 497
        }
498
    }
499
 
500
    if ($opt_v)
501
    {
1576 dpurdie 502
        if( "$opt_v" =~ m/^(\d*)\.(\d*)\.(\d*)-(\d*)\.([a-z]{2,4})$/ ) # N.N.N-N.pppp
1530 dpurdie 503
        {
1554 dpurdie 504
            my ($s1, $s2, $s3, $s4, $s5) = ($1, $2, $3, $4, $5);
1530 dpurdie 505
 
1554 dpurdie 506
            $PkgVersionStr = sprintf("%02s%02s%02s", $s1,$s2,$s3);
507
            $PkgVersion  = "$s1\.$s2\.$s3";
508
            $PkgBuildNum = $s4;
509
            $ProjectAcronym   = $s5;
1530 dpurdie 510
        }
1576 dpurdie 511
        elsif( "$opt_v" =~ m/^(\d*)\.(\d*)\.(\d*)\.([a-z]{2,4})$/ ) # N.N.N.pppp
1530 dpurdie 512
        {
1554 dpurdie 513
            my ($s1, $s2, $s3, $s4) = ($1, $2, $3, $4);
1530 dpurdie 514
 
515
            $PkgVersionStr = sprintf("%02s%02s%02s", $s1,$s2,$s3);
516
            $PkgVersion  = "$s1\.$s2\.$s3";
517
            $PkgBuildNum = "1";
1554 dpurdie 518
            $ProjectAcronym   = $s4;
1530 dpurdie 519
        }
520
        else
521
        {
1534 dpurdie 522
            Error("-v command line arg [$opt_v] has invalid format",
523
                  "Allowed formats are N.N.N-B.ppp and N.N.N.ppp where:",
524
                  "    N is an integer",
525
                  "    B is an integer",
1576 dpurdie 526
                  "    ppp is the project acronym (2..4 characters)",
1534 dpurdie 527
                  "Check propject acronym.");
528
 
1530 dpurdie 529
        }
530
        $PkgVersionUser  = $opt_v;
531
    }
532
    else
533
    {
1534 dpurdie 534
        Error("Package Version not supplied!");
1530 dpurdie 535
    }
536
 
537
 
538
    # lets check to see if we have a previous version 
539
    if ($opt_o)
540
    {
541
        $PkgPreviousVersionStr = $opt_o;
542
    }
543
 
1532 dpurdie 544
    # Load the JATS-parsed information from the build.pl file
545
    #
546
    $BuildFileInfo = DeployUtils::BuildConfig->new($RootDir, $Platform);
1530 dpurdie 547
 
1532 dpurdie 548
    # Load all our build dependencies
549
    #
550
    %BuildPkgArchive = $BuildFileInfo->getDpkgArchiveHash();
551
 
1570 gchristi 552
    # TargetHomeDir should not really be used for anything
1530 dpurdie 553
    #
1570 gchristi 554
    $TargetHomeDir = ($TargetBaseDir ne ".") ? "$ERGAFC_BASEDIR/$TargetBaseDir" : "$ERGAFC_BASEDIR"; 
555
    $TargetHomeDir =~ s|/{2,}|/|g;
556
 
1530 dpurdie 557
    $PkgDir       = "$RootDir/pkg";
558
    $SrcDir       = "$RootDir/src"; 
559
    $InterfaceDir = "$RootDir/interface";
560
    $ReleaseDir   = "$RootDir/build/deploy";
561
 
562
    $PKG_UTIL_DIR   = "$InterfaceDir/deployfiles";
563
    $PATCH_UTIL_DIR = $PKG_UTIL_DIR;
564
    #
565
    #   InstallShield files are provided via a package
566
    #   Ensure that a suitable package has been provided
567
    #
568
    if ( ! -d  $PKG_UTIL_DIR )
569
    {
1534 dpurdie 570
        Error("No deployment support files found",
571
              "These MUST be provided by a dependant package in build.pl");
1530 dpurdie 572
    }
573
 
1532 dpurdie 574
 
1530 dpurdie 575
    $Username     = getlogin || getpwuid($<);
576
 
577
    if ( "$BuildType" eq "D" )
578
    {
579
        $PkgBaseDir = "$PkgDir/debug"; 
1556 lkelly 580
        $AlternateBuildType = "P";
1530 dpurdie 581
    }
582
    else
583
    {
584
        $PkgBaseDir = "$PkgDir/prod"; 
1556 lkelly 585
        $AlternateBuildType = "D";
1530 dpurdie 586
    }
587
 
588
    $PkgInfoFile   = "$PkgBaseDir/$PkgInfoFileName";
589
    $ProtoTypeFile = "$PkgBaseDir/$ProtoTypeFileName";
590
 
591
    $DpkgScriptsDir = "$InterfaceDir/scripts";
592
 
593
 
594
    $DpkgEtcDir     = "$InterfaceDir/etc";
595
    $DpkgJarDir     = "$InterfaceDir/jar";
596
    $DpkgSarDir     = "$InterfaceDir/sar";
597
    $DpkgWarDir     = "$InterfaceDir/war";
598
    $DpkgSqlDir     = "$InterfaceDir/sql";
599
 
600
    $DpkgInfoFilesDir = "$InterfaceDir/infofiles";
601
    $DpkgPkgDir       = "$InterfaceDir/pkg";
602
    $DpkgJspDir       = "$InterfaceDir/jsp";
603
    $DpkgRoxDir       = "$InterfaceDir/rox";
604
    $DpkgRptDir       = "$InterfaceDir/rpt";
605
    $DpkgAcHtmlDir    = "$InterfaceDir/achtml";
606
    $DpkgIncludeDir   = "$InterfaceDir/include";
607
    $DpkgDevcdDir     = "$InterfaceDir/devcd";
608
    $DpkgDatDir       = "$InterfaceDir/dat";
609
    $DpkgThxDir       = "$InterfaceDir/thx";
610
    $DpkgMugDir       = "$InterfaceDir/mug";
611
    $DpkgDocDir       = "$InterfaceDir/doc";
612
 
613
 
614
    $DpkgLibDir     = "$InterfaceDir";
615
    $DpkgBinDir     = "$InterfaceDir";
616
 
617
 
618
    #   Define where we might find our artifacts
1532 dpurdie 619
    #   The search order is: Platform, Product, --Uses extensions,Target, MachineType
620
    #   Much of this list, and its described in the build.pl file, use the JATS
621
    #   generated information to extract the correct information
1530 dpurdie 622
    #
623
    #   Only add the directory to the list if it actually exists
624
    #   This will speed up searching later.
625
    #
626
    #   Create multiple search paths
627
    #       One for an exaustive search
628
    #       Others for selective searchs
629
    #
630
    #
1532 dpurdie 631
    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
1530 dpurdie 632
    {
633
        next unless ( $part );
634
        foreach my $subdir ( "lib." . "$part",
635
                             "lib." . "$part" . "$BuildType",
636
                             "lib/lib." . "$part" . "$BuildType",
637
                             "lib/$part" . "$BuildType",
638
                             "lib/$part" )
639
        {
640
            if ( -d "$DpkgLibDir/$subdir" )
641
            {
642
                UniquePush( \@{$DpkgLibDirList{_ALL_}}, $subdir);
643
                UniquePush( \@{$DpkgLibDirList{$part}}, $subdir);
644
            }
645
        }
646
    }
647
 
1532 dpurdie 648
    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
1530 dpurdie 649
    {
650
        next unless ( $part );
651
        foreach my $subdir ( "bin." . "$part" . "$BuildType",
652
                             "bin." . "$part",
653
                             "bin/bin." . "$part" . "$BuildType",
654
                             "bin/" . "$part" . "$BuildType",
655
                             "bin/" . uc($part) . "$BuildType",
656
                             "bin/$part",
657
 
658
                             "bin." . "$part" . "P",
659
                             "bin/bin." . "$part" . "P",
660
                             "bin/" . "$part" . "P",
661
                             "bin/" . uc($part) . "P" )
662
        {
663
            if ( -d "$DpkgBinDir/$subdir" )
664
            {
665
                UniquePush( \@{$DpkgBinDirList{_ALL_}}, $subdir);
666
                UniquePush( \@{$DpkgBinDirList{$part}}, $subdir);
667
            }
668
        }
669
 
670
    }
671
 
1556 lkelly 672
    # Here we are going to build the same lists but for the $AlternateBuildType
673
    # (i.e P if $BuildType=D) 
674
    # We use these when we need to work with both production and debug files.
675
    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
676
    {
677
        next unless ( $part );
678
        foreach my $subdir ( "lib." . "$part",
679
                             "lib." . "$part" . "$AlternateBuildType",
680
                             "lib/lib." . "$part" . "$AlternateBuildType",
681
                             "lib/$part" . "$AlternateBuildType",
682
                             "lib/$part" )
683
        {
684
            if ( -d "$DpkgLibDir/$subdir" )
685
            {
686
                UniquePush( \@{$DpkgLibDirListAlternate{_ALL_}}, $subdir);
687
                UniquePush( \@{$DpkgLibDirListAlternate{$part}}, $subdir);
688
            }
689
        }
690
    }
691
 
692
    foreach my $part ( $BuildFileInfo->getPlatformParts($Platform), $MachType )
693
    {
694
        next unless ( $part );
695
        foreach my $subdir ( "bin." . "$part" . "$AlternateBuildType",
696
                             "bin." . "$part",
697
                             "bin/bin." . "$part" . "$AlternateBuildType",
698
                             "bin/" . "$part" . "$AlternateBuildType",
699
                             "bin/" . uc($part) . "$AlternateBuildType",
700
                             "bin/$part",
701
 
702
                             "bin." . "$part" . "P",
703
                             "bin/bin." . "$part" . "P",
704
                             "bin/" . "$part" . "P",
705
                             "bin/" . uc($part) . "P" )
706
        {
707
            if ( -d "$DpkgBinDir/$subdir" )
708
            {
709
                UniquePush( \@{$DpkgBinDirListAlternate{_ALL_}}, $subdir);
710
                UniquePush( \@{$DpkgBinDirListAlternate{$part}}, $subdir);
711
            }
712
        }
713
   }
1534 dpurdie 714
    Information("------------------------------------------------------------");
1530 dpurdie 715
 
716
 
717
    # lets generate the patch id if we are building a patch
718
    #
719
    if ( "x$PkgPatchNum" ne "x" )
720
    {
1534 dpurdie 721
        Information("This is a PATCH build...");
1530 dpurdie 722
 
723
        $PkgPatchName = uc ($PkgName);
724
 
725
 
726
        my ($_tmpStr) = sprintf("%s%s", $PkgPatchName, 
727
                                        $PkgVersionStr);
728
 
729
 
730
        $PkgPatchID     = "$_tmpStr" . "-" . "$PkgPatchNum"; 
731
        $PkgPatchReadme = "$PkgBaseDir" . "/README." . "$PkgPatchID"; 
732
        $PkgPatchTmpDir = "$PkgBaseDir/tmp";
733
 
1532 dpurdie 734
        $PkgReleaseNote = "$ReleaseDir" . "/$PkgPatchName" .
1530 dpurdie 735
                                                                "$PkgVersionStr\_" . 
736
                                                                "$PkgPatchNum\_" . 
737
                                                                "$ProjectAcronym\_" . 
738
                                                                "$Platform"; 
739
 
740
        $PkgLabel = uc ($ProjectAcronym) . "_" .
741
                               $PkgPatchName . "_" .
742
                               $PkgVersionStr . 
743
                               "_P" . $PkgPatchNum;  
744
 
745
 
746
        # lets define what our output package name shall be
747
        #
748
        $PkgOutputFile = "na"; 
749
    }
750
    else
751
    {
1534 dpurdie 752
        Information("This is a normal RELEASE build...");
1532 dpurdie 753
        $PkgReleaseNote = "$ReleaseDir" . "/" .
1530 dpurdie 754
                                                                "$PkgName" . "-" . 
755
                                                                "$PkgVersion" . "." .
756
                                                                "$ProjectAcronym" . "-" .
757
                                                                "$Platform";
758
 
759
        $PkgLabel = uc ($ProjectAcronym) . "_" .
760
                               uc ($PkgName) . "_" .
761
                               "R_" .
762
                               "$PkgVersionStr";  
763
 
764
 
765
        # lets define what our output package name shall be
766
        #
767
        $PkgOutputFile = "$PkgName" . "-" . 
768
                         "$PkgVersion" . "." .
769
                         "$ProjectAcronym" . "-" .
770
                         "$Platform" . "-" .
771
                         "$BuildType\.pkg";
772
    }
773
 
1534 dpurdie 774
    Information("------------------------------------------------------------");
1530 dpurdie 775
 
776
 
777
    # lets just show what we have determined.
778
    #
1534 dpurdie 779
    Information("Current environment definitions (Increase Verbose Level to see all definitions)...");
1530 dpurdie 780
 
1534 dpurdie 781
    Verbose("DeployFiles      =[$PKG_UTIL_DIR]");
1530 dpurdie 782
 
1534 dpurdie 783
    Information("PkgName          =[$PkgName]");
784
    Information("PkgVersionUser   =[$PkgVersionUser]");
1530 dpurdie 785
 
1534 dpurdie 786
    Information("PkgVersion       =[$PkgVersion]");
787
    Information("PkgVersionStr    =[$PkgVersionStr]");
1530 dpurdie 788
 
1534 dpurdie 789
    Information("PkgBuildNum      =[$PkgBuildNum]");
1530 dpurdie 790
 
791
    if ( "x$PkgPatchID" ne "x" )
792
    {
1534 dpurdie 793
        Information("PkgPatchName     =[$PkgPatchName]");
794
        Information("PkgPatchNum      =[$PkgPatchNum]");
795
        Information("PkgPatchID       =[$PkgPatchID]");
796
        Information("PkgPatchTmpDir   =[$PkgPatchTmpDir]");
1530 dpurdie 797
    }
798
 
1560 dpurdie 799
    Information("PkgReleaseNote   =[Generated later by ABT]");
1534 dpurdie 800
    Information("PkgLabel         =[$PkgLabel]");
1530 dpurdie 801
 
1534 dpurdie 802
    Information("PkgPreviousVersionStr=[$PkgPreviousVersionStr]");
1530 dpurdie 803
 
1534 dpurdie 804
    Information("ProjectAcronym   =[$ProjectAcronym]");
805
    Information("BuildType        =[$BuildType]");
806
    Information("MachType         =[$MachType]");
1568 dpurdie 807
    Information("MachArch         =[$MachArch]") if ( $MachArch );
1570 gchristi 808
    Information("MachISA          =[$MachISA]") if ( $MachISA );
1534 dpurdie 809
    Information("Platform         =[$Platform]");
810
    Information("Product          =[$Product]");
811
    Information("Target           =[$Target]");
812
    Verbose("BuildParts       =[" . join(',',$BuildFileInfo->getPlatformParts($Platform)) . "]");
1530 dpurdie 813
 
1534 dpurdie 814
    Information("CurrentDir       =[$CurrentDir]");
815
    Information("RootDir          =[$RootDir]");
816
    Information("SandBoxName      =[$SandBoxName]");
817
    Information("Username         =[$Username]");
1530 dpurdie 818
 
1570 gchristi 819
    Information("TargetBaseDir    =[" . ($TargetBaseDir ne "." ? $TargetBaseDir : $opt_d) . "]");
1534 dpurdie 820
    Information("TargetHomeDir    =[$TargetHomeDir]");
1530 dpurdie 821
 
1534 dpurdie 822
    Information("PkgBaseDir       =[$PkgBaseDir]");
823
    Information("SrcDir           =[$SrcDir]");
824
    Information("PkgDir           =[$PkgDir]");
825
    Information("ReleaseDir       =[$ReleaseDir]");
1530 dpurdie 826
 
1534 dpurdie 827
    Verbose("InterfaceDir     =[$InterfaceDir]");
828
    Verbose("DpkgScriptsDir   =[$DpkgScriptsDir]");
829
    Verbose("DpkgBinDir(s)    =[");
1530 dpurdie 830
    foreach $i (@{$DpkgBinDirList{'_ALL_'}})
831
    {
1534 dpurdie 832
        Verbose("                   $DpkgBinDir/$i");
1530 dpurdie 833
    }
1534 dpurdie 834
    Verbose("                  ]");
1530 dpurdie 835
 
836
 
1534 dpurdie 837
    Verbose("DpkgLibDir(s)    =[");
1530 dpurdie 838
    foreach $i (@{$DpkgLibDirList{'_ALL_'}})
839
    {
1534 dpurdie 840
        Verbose("                   $DpkgLibDir/$i");
1530 dpurdie 841
    }
1534 dpurdie 842
    Verbose("                  ]");
1530 dpurdie 843
 
844
 
1534 dpurdie 845
    Verbose("DpkgEtcDir       =[$DpkgEtcDir]");
846
    Verbose("DpkgJarDir       =[$DpkgJarDir]");
847
    Verbose("DpkgSarDir       =[$DpkgSarDir]");
848
    Verbose("DpkgWarDir       =[$DpkgWarDir]");
849
    Verbose("DpkgSqlDir       =[$DpkgSqlDir]");
850
    Verbose("DpkgJspDir       =[$DpkgJspDir]");
851
    Verbose("DpkgRoxDir       =[$DpkgRoxDir]");
852
    Verbose("DpkgRptDir       =[$DpkgRptDir]");
853
    Verbose("DpkgAcHtmlDir    =[$DpkgAcHtmlDir]");
854
    Verbose("DpkgIncludeDir   =[$DpkgIncludeDir]");
855
    Verbose("DpkgDevcdDir     =[$DpkgDevcdDir]");
856
    Verbose("DpkgDatDir       =[$DpkgDatDir]");
857
    Verbose("DpkgThxDir       =[$DpkgThxDir]");
858
    Verbose("DpkgMugDir       =[$DpkgMugDir]");
859
    Verbose("DpkgDocDir       =[$DpkgDocDir]");
1530 dpurdie 860
 
1534 dpurdie 861
    Verbose("DpkgInfoFilesDir =[$DpkgInfoFilesDir]");
862
    Verbose("DpkgPkgDir       =[$DpkgPkgDir]");
1530 dpurdie 863
 
1534 dpurdie 864
    Verbose("PkgInfoFile      =[$PkgInfoFile]");
865
    Verbose("ProtoTypeFile    =[$ProtoTypeFile]");
1530 dpurdie 866
 
867
    foreach $i ( $BuildFileInfo->getDpkgArchiveList() )
868
    {
869
        my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
870
 
1534 dpurdie 871
        Verbose(  "Build Dependency =" .
1530 dpurdie 872
                  "[$moduleInfo->{type}] " .
873
                  "[$i] " .
874
                  "[$moduleInfo->{version}] " .
875
                  "[$moduleInfo->{proj}]");
876
    }
877
 
878
    if ( "$MachType" eq "sparc" )
879
    {
1534 dpurdie 880
        Information("PkgOutputFile    =[$PkgOutputFile]");
1530 dpurdie 881
    }
882
 
1534 dpurdie 883
    Information("PkgOverview      =[$PKG_OVERVIEW]");
1530 dpurdie 884
 
885
 
886
    # Lets evaluate TargetDstDirStructure to expand any vars
887
    foreach $i ( keys %TargetDstDirStructure )
888
    {
889
        if ( $TargetDstDirStructure{$i} =~ /\$/ )
890
        {
1534 dpurdie 891
            Debug("-n", "Expanding TargetDstDirStructure [$TargetDstDirStructure{$i}] to ");
1530 dpurdie 892
            $TargetDstDirStructure{$i} = eval "sprintf " . qq/"$TargetDstDirStructure{$i}"/;
1540 dpurdie 893
            Information("TargetDstDir $i =[$TargetDstDirStructure{$i}]");
1530 dpurdie 894
        }
895
    }
896
 
897
    # lets check waht we can before proceeding.
898
    #
899
    ValidateLocalSrcDirStructure();
900
 
901
    # Everything went ok lets begin by creating some dirs...
902
    #
903
    CreateTargetDirStructure();
904
 
905
    # done
906
    return 1;
907
}
908
 
909
 
910
#------------------------------------------------------------------------------
911
sub setPkgDescription
912
#
913
# Description:
914
#       This sub-routine is used to set the Package DESC field
915
#       from within the deployfile.
916
#
917
#------------------------------------------------------------------------------
918
{
919
    # correct number of parameters?
920
    if ( ($#_+1) != 1 )
921
    {
1534 dpurdie 922
        Error("Incorrect number of params passed to setPkgDescription() function.",
923
              "Check deploy config.");
1530 dpurdie 924
    }
925
    my ($lpkgDesc) = shift;
926
 
927
    # we use what was defined in deployfile if
928
    # the RM details are not available
929
    if ( ! defined($RmPkgDetails) )
930
    {
931
        $PkgDesc = $lpkgDesc;
932
    }
933
    else
934
    {
935
        # let's use the details if we have them
936
        if ( $RmPkgDetails->foundDetails() )
937
        {
938
            # we have RM details, we will only use them
939
            # if nothing is locally defined,
940
            # (ie locally defined details takes precedence)
941
            if ( "x$lpkgDesc" eq "x" )
942
            {
943
                $PkgDesc = $RmPkgDetails->pv_description();
944
            }
945
            else
946
            {
947
                $PkgDesc = $lpkgDesc;
948
            }
949
        }
950
        else
951
        {
952
            $PkgDesc = $lpkgDesc;
953
        }
954
    }
955
 
956
    # done
957
    return 1;
958
}
959
 
960
#------------------------------------------------------------------------------
961
sub setPkgName
962
#
963
# Description:
964
#       This sub-routine is used to set the Package NAME field
965
#       from within the deployfile.
966
#
967
#------------------------------------------------------------------------------
968
{
969
    # correct number of parameters?
970
    if ( ($#_+1) != 1 )
971
    {
1534 dpurdie 972
        Error("Incorrect number of params passed to " .
973
                  "setPkgName() function. ",
1530 dpurdie 974
                  "Check deploy config.");
975
    }
976
    $PkgNameLong = shift;
977
 
978
    # done
979
    return 1;
980
}
981
 
982
 
983
#------------------------------------------------------------------------------
984
sub setErgAfcBaseDir
985
#
986
# Description:
987
#       This sub-routine is used to reset the ERG AFC base dir global variable
988
#       from within the deployfile.
989
#
990
#------------------------------------------------------------------------------
991
{
992
    # if TargetBaseDir is empty then init has not been called yet so we can set 
993
    # base dir, if however it is not null then init has been called and setting
994
    # base dir after init causes problems in some cases.
995
    if ( $TargetBaseDir ne "" )
996
    {
1534 dpurdie 997
        Error("setErgAfcBaseDir() cannot be called after Init(), place before Init() in deployfile.pl");
1530 dpurdie 998
    }
999
 
1000
    # correct number of parameters?
1001
    if ( ($#_+1) != 1 )
1002
    {
1534 dpurdie 1003
        Error("Incorrect number of params passed to " .
1004
                  "setErgBaseDir() function. ",
1530 dpurdie 1005
                  "Check deploy config.");
1006
    }
1007
 
1008
    my ($newDir) = @_;
1009
    $ERGAFC_BASEDIR = "$newDir";
1010
 
1011
    return 1;
1012
}
1013
 
1014
 
1015
 
1016
#------------------------------------------------------------------------------
1017
sub getErgAfcBaseDir
1018
#
1019
# Description:
1020
#       This sub-routine is used to get the ERG AFC base dir global variable
1021
#       to be used within the deployfile.
1022
#
1023
#------------------------------------------------------------------------------
1024
{
1025
    # correct number of parameters?
1026
    if ( ($#_+1) != 0 )
1027
    {
1534 dpurdie 1028
        Error("Incorrect number of params passed to " .
1029
                  "getErgBaseDir() function. ",
1530 dpurdie 1030
                  "Check deploy config.");
1031
    }
1032
 
1033
    return "$ERGAFC_BASEDIR";
1034
}
1035
 
1036
 
1037
#------------------------------------------------------------------------------
1038
sub setPkgOverview
1039
#
1040
# Description:
1041
#       This sub-routine is used to reset the package overview that
1042
#       is used to build the package from within the deployfile.
1043
#
1044
#------------------------------------------------------------------------------
1045
{
1046
    # correct number of parameters?
1047
    if ( ($#_+1) != 1 )
1048
    {
1534 dpurdie 1049
        Error("Incorrect number of params passed to " .
1050
                  "setPkgOverview() function. ",
1530 dpurdie 1051
                  "Check deploy config.");
1052
    }
1053
 
1054
    my ($mStr) = @_;
1055
    $PKG_OVERVIEW = "$mStr";
1056
 
1057
    return 1;
1058
}
1059
 
1060
 
1061
#------------------------------------------------------------------------------
1062
sub getPkgOverview
1063
#
1064
# Description:
1065
#       This sub-routine is used to get the package overview string global variable
1066
#       to be used within the deployfile.
1067
#
1068
#------------------------------------------------------------------------------
1069
{
1070
    # correct number of parameters?
1071
    if ( ($#_+1) != 0 )
1072
    {
1534 dpurdie 1073
        Error("Incorrect number of params passed to " .
1074
                  "getPkgOverview() function. ",
1530 dpurdie 1075
                  "Check deploy config.");
1076
    }
1077
 
1078
    return "$PKG_OVERVIEW";
1079
}
1080
 
1081
 
1082
 
1083
#------------------------------------------------------------------------------
1084
sub addInstallshieldFiles
1085
#
1086
#    Description:
1087
#        This is called to add extra installshield files to the PKG_ISHIELD_FILES array.
1088
#        For each parameter it checks for the existense of arg.* in the PKG_UTIL_DIR
1089
#        and adds all found files to the array
1090
#        This must be called before init() is called.
1091
#
1092
#    INPUT:
1093
#        files to add
1094
#
1095
#    RETURN:
1096
#        nothing
1097
#
1098
#------------------------------------------------------------------------------
1099
{
1100
    my @files;
1101
 
1102
    # lets just check to see if we can execute this function on this machine.
1103
    if ( "$MachType" eq "sparc" )
1104
    {
1534 dpurdie 1105
        Warning("addInstallshieldFiles() not supported on this machine type.");
1530 dpurdie 1106
        return 1;
1107
    }
1108
 
1109
    foreach my $i ( @_ )
1110
    {
1111
        @files = glob("$PKG_UTIL_DIR/$i.*");
1112
        foreach my $j ( @files )
1113
        {
1114
            $j = basename($j);
1534 dpurdie 1115
            Verbose("Adding Installshield file $j");
1530 dpurdie 1116
            push(@PKG_ISHIELD_FILES, $j);
1117
        }
1118
    }
1119
    return 1;
1120
}   # addInstallshieldFiles
1121
 
1122
 
1123
 
1124
#------------------------------------------------------------------------------
1125
sub removeBuildTypeFromItemName
1126
#
1127
#    Description:
1128
#        This sub-routine is used to remove the buildtype from the item name.
1129
#        i.e. debug files will be tagged with *D.* 
1130
#             prod  file will be tagged with *P.*
1131
#
1132
#    INPUT:
1133
#        item name
1134
#
1135
#    RETURN:
1136
#        new item name.
1137
#
1138
#------------------------------------------------------------------------------
1139
{
1140
    my ($file) = @_;
1141
 
1142
    my ($nfile) = $file;
1143
    $nfile =~ s/D\.|P\./\./;
1144
    return "$nfile";
1145
}
1146
 
1147
 
1148
 
1149
#------------------------------------------------------------------------------
1150
sub installAllDpkgArchivePkgFiles
1151
#
1152
# Description:
1153
#       This sub-routine is used to install all infofiles files from the
1154
#       dpkg_archive into the defined install area.
1155
#
1156
#       It assumes based on the build type where the src files will be located.
1157
#
1158
#       If it has any problems it will log an error and stop processing.
1159
#
1160
#       Source directory: $DpkgPkgDir       (interface/pkg)
1161
#       Target directory: $PkgBaseDir       (output/pkg/[debug|prod]
1162
#
1163
#------------------------------------------------------------------------------
1164
{
1165
    #
1166
    #   Use the (now) more general function installAllDpkgArchivePkgFiles2
1167
    #   with spacial parameters to mimic the original function
1168
    #
1169
    #   Copy all from the 'pkg' directory to the PkgBaseDir
1170
    #
1171
    installAllDpkgArchivePkgFiles2 ( "--Dstdir=$PkgBaseDir", '--Srcdir=pkg', @_ );
1172
    return 1;
1173
}
1174
 
1175
 
1176
#------------------------------------------------------------------------------
1177
sub installAllDpkgArchivePkgFiles2
1178
#
1179
# Description:
1180
#       This sub-routine is used to install all pkg files from the
1181
#       dpkg_archive into the defined install area.
1182
#
1183
#       Simlar to installAllDpkgArchivePkgFiles, but the target directory
1184
#       is specified by the user.
1185
#
1186
#       It assumes based on the build type where the src files will be located.
1187
#
1188
#       If it has any problems it will log an error and stop processing.
1189
#
1190
# Inputs          : targetTag       - Target directory      [Mandatory]
1191
#                   options         - Optional options
1192
#                                       --Srcdir=path       [default=pkg]
1193
#                                       --Dstdir=abs_path   [internal use]
1194
#                                       --NoRecurse
1195
#                                       --Recurse           [default]
1196
#                                       --Flatten
1197
#                                       --NoFlatten         [default]
1198
#                                       --FilterIn=xx
1199
#                                       --FilterInRE=xx     [default=.*]
1200
#                                       --FilterOut=xx
1201
#                                       --FilterOutRE=xx
1202
#
1203
# Notes:    --FilterIn=xxxx, --FilterOut=xxx
1204
#           xxx is a simple Shell style filter where:
1205
#               * means one or more charters        '*.EXE'
1206
#               ? means a single character          '*.?'
1207
#               [abc] means either a or b or c      'file.[ch]'
1208
#
1209
#           --FilterInRE=xxx, --FilterOutRE=xxx
1210
#           xxx is a Regular Expression. There are harder to use but very
1211
#           powerful. ie '.*\.EXE$'
1212
#
1213
#           The 'In' filters are applied before the 'Out' filters.
1214
#
1215
#           If no 'In' filters are specified then all files will be included.
1216
#
1217
#           The filter rules are applied to the path below the Srcdir, and, for
1218
#           the purposes of the filter the path starts with a '/'.
1219
#
1220
#------------------------------------------------------------------------------
1221
{
1222
    my $src_base_dir;
1223
    my $flatten = 0;
1224
    my $dstDir;
1552 dpurdie 1225
    my $search =  LocateFiles->new(recurse => 1);
1530 dpurdie 1226
 
1534 dpurdie 1227
    Information("Installing all Prepared pkg files...");
1530 dpurdie 1228
 
1229
    #
1230
    #   Process the arguments and extract parameters and options
1231
    #
1232
    foreach ( @_ )
1233
    {
1234
        if ( m/^--Srcdir=(.*)/ ) {
1534 dpurdie 1235
            Error("installAllDpkgArchivePkgFiles2: Multiple --Srcdir not allowed")
1530 dpurdie 1236
                if ( $src_base_dir );
1237
            $src_base_dir = "$InterfaceDir/$1";
1534 dpurdie 1238
            $src_base_dir =~ s~/\.$~~;
1239
            $src_base_dir =~ s~/$~~;
1530 dpurdie 1240
 
1241
        } elsif ( /^--Dstdir=(.*)/ ) {
1534 dpurdie 1242
            Error("installAllDpkgArchivePkgFiles2: Multiple target directories not allowed")
1530 dpurdie 1243
                if ( $dstDir );
1244
            $dstDir = $1;
1245
 
1246
        } elsif ( m/^--NoRecurse/ ) {
1552 dpurdie 1247
            $search->recurse(0);
1530 dpurdie 1248
 
1249
        } elsif ( m/^--Recurse/ ) {
1552 dpurdie 1250
            $search->recurse(1);
1530 dpurdie 1251
 
1252
        } elsif ( /^--FilterOut=(.*)/ ) {
1552 dpurdie 1253
            $search->filter_out( $1 );
1530 dpurdie 1254
 
1255
        } elsif ( /^--FilterOutRE=(.*)/ ) {
1552 dpurdie 1256
            $search->filter_out_re( $1 );
1530 dpurdie 1257
 
1258
        } elsif ( /^--FilterIn=(.*)/ ) {
1552 dpurdie 1259
            $search->filter_in( $1 );
1530 dpurdie 1260
 
1261
        } elsif ( /^--FilterInRE=(.*)/ ) {
1552 dpurdie 1262
            $search->filter_in_re( $1 );
1530 dpurdie 1263
 
1264
        } elsif ( /^--Flatten/ ) {
1265
            $flatten = 1;
1266
 
1267
        } elsif ( /^--NoFlatten/ ) {
1268
            $flatten = 0;
1269
 
1270
        } elsif ( m/^--/ ) {
1534 dpurdie 1271
            Error("installAllDpkgArchivePkgFiles2: Unknown option: $_")
1530 dpurdie 1272
 
1273
        } else {
1534 dpurdie 1274
            Error("installAllDpkgArchivePkgFiles2: Multiple target directories not allowed")
1530 dpurdie 1275
                if ( $dstDir );
1276
 
1277
            #   Convert the symbolic target directory name into a real path
1278
 
1279
            $dstDir = getTargetDstDirValue($_, "A");
1280
        }
1281
    }
1282
 
1283
    #
1284
    #   Ensure that we have a valid source directory
1285
    #   Data taken from the 'pkg' directory unless otherwise specified by the user
1286
    #
1287
    $src_base_dir = $DpkgPkgDir unless $src_base_dir;
1534 dpurdie 1288
    Error("installAllDpkgArchivePkgFiles2: Package directory not found: $src_base_dir")
1530 dpurdie 1289
        unless ( -d $src_base_dir );
1290
 
1291
    #
1292
    #   Ensure that the user has specified a target directory
1293
    #
1534 dpurdie 1294
    Error("installAllDpkgArchivePkgFiles2: No target directories specified")
1530 dpurdie 1295
        unless ( $dstDir );
1296
 
1297
    #
1298
    #   Build up a list of files to copy
1299
    #   Creating a list allows:
1300
    #       Simplified coding
1301
    #       Flattening and testing of the flattening
1302
    #
1552 dpurdie 1303
    my @elements = $search->search( $src_base_dir);
1556 lkelly 1304
    Warning("installAllDpkgArchivePkgFiles2: No files found") unless ( @elements );
1530 dpurdie 1305
 
1306
    #
1307
    #   Perform the file copy
1308
    #   This copy will NOT create empty directories, but it will create needed
1309
    #   directories on the fly.
1310
    #
1311
    foreach  my $sfile ( @elements )
1312
    {
1313
 
1314
        #
1315
        #   Split into directory and file as we may need to make the directory
1316
        #   since the copy operation will not
1317
        #
1318
        my $dir;                                # Target directory
1319
        my $tfile;                              # Target path
1534 dpurdie 1320
       (my $fname = $sfile )=~ s~^.*/+~~;       # Filename(only)
1530 dpurdie 1321
 
1322
        unless ( $flatten )
1323
        {
1324
            $sfile =~ m~^(.*/)~;
1325
            $dir = "$dstDir/$1";
1326
            $tfile = $sfile;
1327
        }
1328
        else
1329
        {
1330
            $dir = $dstDir;
1331
            $tfile = $fname;
1332
        }
1333
 
1334
        #
1335
        #   Ensure the target directory is present
1336
        #
1534 dpurdie 1337
        make_directory ( $dir, 0775 );
1530 dpurdie 1338
 
1339
        #
1340
        #   Copy the file
1341
        #   Ensure that the target file does not already exist
1342
        #   This is most likely to occur when flattening the directory structure
1343
        #
1344
        my $m_sfile = "$src_base_dir$sfile";
1345
        my $m_tfile = "$dstDir/$tfile";
1346
 
1347
        if ( -f $m_tfile  )
1348
        {
1534 dpurdie 1349
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: File already exists");
1530 dpurdie 1350
        }
1351
 
1352
        if( File::Copy::copy("$m_sfile", "$m_tfile") )
1353
        {
1534 dpurdie 1354
            Verbose("Copied [$fname] to [$m_tfile] ...");
1530 dpurdie 1355
        }
1356
        else
1357
        {
1534 dpurdie 1358
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: $!");
1530 dpurdie 1359
        }
1360
    }
1361
 
1362
    return 1;
1363
}
1364
 
1365
#------------------------------------------------------------------------------
1540 dpurdie 1366
sub installDpkgArchivePkgRaw
1367
#
1368
# Description:
1369
#       This sub-routine is used to install all pkg files from the named package
1370
#       in dpkg_archive into the defined install area.
1371
#
1372
#       If it has any problems it will log an error and stop processing.
1373
#
1374
# Inputs          : targetTag       - Target directory      [Mandatory]
1375
#                   package         - Source Package        [Mandatory]
1376
#                   options         - Optional options
1377
#                                       --NoRecurse
1378
#                                       --Recurse           [default]
1379
#                                       --Flatten
1380
#                                       --NoFlatten         [default]
1381
#                                       --FilterIn=xx
1382
#                                       --FilterInRE=xx     [default=.*]
1383
#                                       --FilterOut=xx
1384
#                                       --FilterOutRE=xx
1385
#                                       --Warn              [ default]
1386
#                                       --NoWarn
1387
#
1388
# Notes:    --FilterIn=xxxx, --FilterOut=xxx
1389
#           xxx is a simple Shell style filter where:
1390
#               * means one or more charters        '*.EXE'
1391
#               ? means a single character          '*.?'
1392
#               [abc] means either a or b or c      'file.[ch]'
1393
#
1394
#           --FilterInRE=xxx, --FilterOutRE=xxx
1395
#           xxx is a Regular Expression. There are harder to use but very
1396
#           powerful. ie '.*\.EXE$'
1397
#
1398
#           The 'In' filters are applied before the 'Out' filters.
1399
#
1400
#           If no 'In' filters are specified then all files will be included.
1401
#
1402
#           The filter rules are applied to the path below the Srcdir, and, for
1403
#           the purposes of the filter the path starts with a '/'.
1404
#
1405
#
1406
#       --NoWarn
1407
#           Supresses the warning message generated if no files are transferred
1408
#
1409
#------------------------------------------------------------------------------
1410
{
1411
    my $flatten = 0;
1412
    my $dstDir;
1413
    my @args;
1414
    my $src_base_dir;
1415
    my $warning = 1;
1552 dpurdie 1416
    my $search =  LocateFiles->new(recurse => 1);
1540 dpurdie 1417
 
1418
    #
1419
    #   Process the arguments and extract parameters and options
1420
    #
1421
    foreach ( @_ )
1422
    {
1423
        if ( m/^--NoRecurse/ ) {
1552 dpurdie 1424
            $search->recurse(0);
1540 dpurdie 1425
 
1426
        } elsif ( m/^--Recurse/ ) {
1552 dpurdie 1427
            $search->recurse(1);
1540 dpurdie 1428
 
1429
        } elsif ( /^--FilterOut=(.*)/ ) {
1552 dpurdie 1430
            $search->filter_out( $1 );
1540 dpurdie 1431
 
1432
        } elsif ( /^--FilterOutRE=(.*)/ ) {
1552 dpurdie 1433
            $search->filter_out_re( $1 );
1540 dpurdie 1434
 
1435
        } elsif ( /^--FilterIn=(.*)/ ) {
1552 dpurdie 1436
            $search->filter_in( $1 );
1540 dpurdie 1437
 
1438
        } elsif ( /^--FilterInRE=(.*)/ ) {
1552 dpurdie 1439
            $search->filter_in_re( $1 );
1540 dpurdie 1440
 
1441
        } elsif ( /^--Flatten/ ) {
1442
            $flatten = 1;
1443
 
1444
        } elsif ( /^--NoFlatten/ ) {
1445
            $flatten = 0;
1446
 
1447
        } elsif ( /^--NoWarn/ ) {
1448
            $warning = 0;
1449
 
1450
        } elsif ( /^--Warn/ ) {
1451
            $warning = 1;
1452
 
1453
        } elsif ( m/^--/ ) {
1454
            Error("installDpkgArchivePkgRaw: Unknown option: $_")
1455
 
1456
        } else {
1457
            push @args, $_;
1458
 
1459
        }
1460
    }
1461
 
1462
    #
1463
    #   Have removed all the options
1464
    #   Must have two parameters left
1465
    #
1466
    if ( $#args != 1 )
1467
    {
1468
        Error("Incorrect number of params passed to installDpkgArchivePkgRaw() function.",
1469
              "Check deploy config.");
1470
    }
1471
 
1472
    my ( $dstDirTag, $pkgName ) = @args;
1473
 
1474
    #
1475
    #   Ensure that the user has specified a target directory
1476
    #   Convert the symbolic target directory to a real path
1477
    #
1478
    Error("installDpkgArchivePkgRaw: No target directories specified")
1479
        unless ( $dstDirTag );
1480
    $dstDir = getTargetDstDirValue($dstDirTag, "A");
1481
 
1482
    #
1483
    #   Convert the package name into a real path name to the package as
1484
    #   held in dpkg_archive. Do not use the copy in the 'interface' directory
1485
    #
1546 dpurdie 1486
    $src_base_dir = LocatePackageBase ( "installDpkgArchivePkgRaw", $pkgName );
1540 dpurdie 1487
 
1488
    #
1489
    #   Build up a list of files to copy
1490
    #   Creating a list allows:
1491
    #       Simplified coding
1492
    #       Flattening and testing of the flattening
1493
    #
1552 dpurdie 1494
    my @elements = $search->search( $src_base_dir );
1540 dpurdie 1495
    Information("Installing Raw Pkg files: $pkgName") if @elements;
1496
 
1497
    #
1498
    #   Perform the file copy
1499
    #   This copy will NOT create empty directories, but it will create needed
1500
    #   directories on the fly.
1501
    #
1502
    foreach  my $sfile ( @elements )
1503
    {
1504
 
1505
        #
1506
        #   Split into directory and file as we may need to make the directory
1507
        #   since the copy operation will not
1508
        #
1509
        my $dir;                                # Target directory
1510
        my $tfile;                              # Target path
1511
       (my $fname = $sfile )=~ s~^.*/+~~;       # Filename(only)
1512
 
1513
        unless ( $flatten )
1514
        {
1515
            $sfile =~ m~^(.*/)~;
1516
            $dir = "$dstDir/$1";
1517
            $tfile = $sfile;
1518
        }
1519
        else
1520
        {
1521
            $dir = $dstDir;
1522
            $tfile = $fname;
1523
        }
1524
 
1525
        #
1526
        #   Ensure the target directory is present
1527
        #
1528
        make_directory ( $dir, 0775 );
1529
 
1530
        #
1531
        #   Copy the file
1532
        #   Ensure that the target file does not already exist
1533
        #   This is most likely to occur when flattening the directory structure
1534
        #
1535
        my $m_sfile = "$src_base_dir$sfile";
1536
        my $m_tfile = "$dstDir/$tfile";
1537
 
1538
        if ( -f $m_tfile  )
1539
        {
1540
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: File already exists");
1541
        }
1542
 
1543
        if( File::Copy::copy("$m_sfile", "$m_tfile") )
1544
        {
1545
            Verbose("Copied [$fname] to [$m_tfile] ...");
1546
        }
1547
        else
1548
        {
1549
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: $!");
1550
        }
1551
    }
1552
 
1553
    #
1554
    #   Return the number of files transferred
1555
    #
1556
    my $nfiles = $#elements + 1;
1557
    Warning("Installing Raw Pkg files: $pkgName - No files transferred") if ( $warning && ! $nfiles ) ;
1558
 
1559
    return $nfiles;
1560
}
1561
 
1562
 
1563
#------------------------------------------------------------------------------
1530 dpurdie 1564
sub installAllDpkgArchiveDevcdFiles
1565
#
1566
# Description:
1567
#       This sub-routine is used to install all devcd files from the
1568
#       dpkg_archive into the defined install area.
1569
#
1570
#       It assumes based on the build type where the src files will be located.
1571
#
1572
#       If it has any problems it will log an error and stop processing.
1573
#
1574
#       Source directory: $DpkgDevcdDir       (interface/devcd)
1575
#       Target directory: Symbolic Directory
1576
#
1577
# Inputs: None
1578
#
1579
#------------------------------------------------------------------------------
1580
{
1581
    # correct number of parameters?
1582
    if ( ($#_+1) != 1 )
1583
    {
1534 dpurdie 1584
        Error("Incorrect number of params passed to " .
1585
              "installAllDpkgArchiveDevcdFiles() function. ",
1586
              "Check deploy config.");
1530 dpurdie 1587
    }
1588
 
1534 dpurdie 1589
    Information("Installing all Prepared Day 0 devcd files...");
1530 dpurdie 1590
 
1591
 
1592
    my ($targetTag) = @_;
1593
 
1594
    # lets check to see if the target tag exists
1595
    # if does not the process with log an error.
1596
    #
1597
    my ($targetValue) = getTargetDstDirValue($targetTag, "R");
1598
 
1599
 
1600
    # ok we have a valid dst value we now need to get a hold of all the 
1601
    # lib scripts files.
1602
    #
1603
    if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" )
1604
    {
1605
        $TmpGlobalVariable = $targetValue; 
1606
        File::Find::find( \&pkgFindDevcd, "$DpkgDevcdDir");
1607
    }
1608
    else
1609
    {
1610
        my ($i);
1611
        my(@FindRes) = `find $DpkgDevcdDir -follow`;
1612
        my ($m_sfile);
1613
        my ($tmp_DstDir) = "$PkgBaseDir/$targetValue";
1614
        my ($tmp_SrcDir) = "$DpkgDevcdDir";
1615
        foreach $i (@FindRes)
1616
        {
1617
 
1618
            chomp($i);
1619
            my($base)= File::Basename::basename($i);
1620
 
1621
            if ( $base eq "devcd" )
1622
            {
1623
                next;
1624
            }
1625
 
1626
            my ($tmp_dItem) = $i;
1627
            $tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;
1628
 
1534 dpurdie 1629
            if ( -d $i )
1530 dpurdie 1630
            {
1534 dpurdie 1631
                make_directory ( $tmp_dItem, 0775 );
1530 dpurdie 1632
            }
1633
            else
1634
            {
1534 dpurdie 1635
                if(File::Copy::copy( $i , $tmp_dItem ))
1530 dpurdie 1636
                {
1534 dpurdie 1637
                    Verbose("Copied [$base] to [$tmp_dItem] ...");
1530 dpurdie 1638
                }
1639
                else
1640
                {
1534 dpurdie 1641
                    Error("Failed to copy pkg file [$tmp_dItem] to [$i]: $!");
1530 dpurdie 1642
                }
1643
            }
1644
        }
1645
    }
1646
 
1647
    return 1;
1648
}
1649
 
1650
 
1651
#------------------------------------------------------------------------------
1652
sub pkgFindDevcd
1653
#
1654
#    Description:
1655
#        This subroutine is used to locate all associated devcd files in 
1656
#        a pre-defined dpkg_archive.
1657
#
1658
#   Trick: Will not copy a file/directory called 'devcd'
1659
#          Not too sure why. May be an attempt to prevent empty devcd directories
1660
#          If you know better, then correct this comment.
1661
#------------------------------------------------------------------------------
1662
{
1663
    my($item)= "$File::Find::name";
1664
    my($base)= File::Basename::basename($item);
1665
 
1666
    if ( $base eq "devcd" )
1667
    {
1668
        return 1;
1669
    }
1670
 
1671
    my ($tmp_dItem) = $item;
1672
    my ($tmp_DstDir) = "$PkgBaseDir/$TmpGlobalVariable";
1673
    my ($tmp_SrcDir) = "$DpkgDevcdDir";
1674
    $tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;
1675
 
1676
    # we need to determine what type of item we are dealing with file we are dealing with
1677
    if ( -d "$item")
1678
    {
1534 dpurdie 1679
        make_directory( $tmp_dItem, 0775 );
1530 dpurdie 1680
    }
1681
    else
1682
    {
1683
        if(File::Copy::copy("$item", "$tmp_dItem"))
1684
        {
1534 dpurdie 1685
            Verbose("Copied [$base] to [$tmp_dItem] ...");
1530 dpurdie 1686
        }
1687
        else
1688
        {
1534 dpurdie 1689
            Error("Failed to copy pkg file [$tmp_dItem] to [$item]: $!"); 
1530 dpurdie 1690
        }
1691
    }
1692
}
1693
 
1694
#------------------------------------------------------------------------------
1695
sub installAllDpkgArchiveFiles
1696
#
1697
# Description:
1698
#       This sub-routine is used to install all files from the
1699
#       dpkg_archive into the defined install area.
1700
#
1701
#       It assumes based on the build type where the src files will be located.
1702
#
1703
#       If it has any problems it will log an error and stop processing.
1704
#
1705
# Inputs:   $targetType         - Internal tag to specify source file
1706
#           $targetTag          - Users tag for destination
1707
#
1708
#
1709
#------------------------------------------------------------------------------
1710
{
1711
    # correct number of parameters?
1712
    if ( ($#_+1) != 2 )
1713
    {
1534 dpurdie 1714
        Error("Incorrect number of params passed to " .
1715
              "installAllDpkgArchiveFiles() function. ",
1716
              "Check deploy config.");
1530 dpurdie 1717
    }
1718
 
1719
    my ($targetType, $targetTag) = @_;
1720
 
1721
    # lets check to see if the target tag exists
1722
    # if does not the process with log an error.
1723
    #
1724
    my $targetValue;
1725
    if ( $targetTag eq "--NoTag" )
1726
    {
1570 gchristi 1727
        $targetValue = ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir;
1530 dpurdie 1728
    }
1729
    else
1730
    {
1731
       $targetValue = getTargetDstDirValue($targetTag, "A");
1732
    }
1733
 
1734
    # ok we have a valid dst value we now need to get a hold of all the 
1735
    # lib scripts files.
1736
    #
1737
    local *DIR;
1738
    my $src_dir;
1739
 
1740
    if    ( "$targetType" eq "jar" )        { $src_dir = $DpkgJarDir; }
1741
    elsif ( "$targetType" eq "sar" )        { $src_dir = $DpkgSarDir; }
1742
    elsif ( "$targetType" eq "include" )    { $src_dir = $DpkgIncludeDir; }
1743
    elsif ( "$targetType" eq "war" )        { $src_dir = $DpkgWarDir; }
1744
    elsif ( "$targetType" eq "infofiles" )  { $src_dir = $DpkgInfoFilesDir; }
1745
    elsif ( "$targetType" eq "sql" )        { $src_dir = $DpkgSqlDir; }
1746
    elsif ( "$targetType" eq "etc" )        { $src_dir = $DpkgEtcDir; }
1747
    elsif ( "$targetType" eq "scripts" )    { $src_dir = $DpkgScriptsDir; }
1748
    elsif ( "$targetType" eq "rox" )        { $src_dir = $DpkgRoxDir; }
1749
    elsif ( "$targetType" eq "rpt" )        { $src_dir = $DpkgRptDir; }
1750
    elsif ( "$targetType" eq "doc" )        { $src_dir = $DpkgDocDir; }
1751
    elsif ( "$targetType" eq "jsp" )        { $src_dir = $DpkgJspDir; }
1752
#    elsif ( "$targetType" eq "achtml" )     { $src_dir = $DpkgAcHtmlDir; }
1753
    else  {
1534 dpurdie 1754
        Error("installAllDpkgArchiveFiles() passed unknown target type [$targetType].");
1530 dpurdie 1755
    }
1756
 
1757
    opendir(DIR, $src_dir) or
1534 dpurdie 1758
            Error("Can't opendir $src_dir: $!");
1530 dpurdie 1759
 
1760
 
1761
    # lets process what we have found
1762
    #
1763
    my ($file);
1764
    while (defined($file = readdir(DIR))) 
1765
    {
1766
        if ( $file !~ /^.$/  && 
1767
             $file !~ /^..$/ ) 
1768
        {
1769
            my ($m_fLoc) = "$src_dir/$file";
1770
 
1771
            if(File::Copy::copy("$m_fLoc", "$targetValue"))
1772
            {
1534 dpurdie 1773
                Verbose("Copied [$targetType] item [$file] to [$targetValue] ...");
1530 dpurdie 1774
            }
1775
            else
1776
            {
1534 dpurdie 1777
                Error("Failed to copy [$targetType] item [$m_fLoc]: $!"); 
1530 dpurdie 1778
            }
1779
        }
1780
    }
1781
 
1782
    closedir(DIR);
1783
    return 1;
1784
}
1785
 
1786
 
1787
#------------------------------------------------------------------------------
1788
sub installAllDpkgArchiveAcHtmlFiles
1789
#
1790
# Description:
1791
#       This sub-routine is used to install all achtml files from the
1792
#       dpkg_archive into the defined install area.
1793
#
1794
#       It assumes based on the build type where the src files will be located.
1795
#
1796
#       If it has any problems it will log an error and stop processing.
1797
#
1798
#
1799
# Ugly trick:
1800
#       This function tags a $$targetType argument which is used in constructing
1801
#       the source directory path. ie: InterfaceDir/achtml/$targetType
1802
#
1803
#       Could provide as an option to installAllDpkgArchiveFiles and re-use that
1804
#       function
1805
#
1806
#------------------------------------------------------------------------------
1807
{
1808
    # correct number of parameters?
1809
    if ( ($#_+1) != 2 )
1810
    {
1534 dpurdie 1811
        Error("Incorrect number of params passed to " .
1812
              "installAllDpkgArchiveAcHtmlFiles() function. ",
1813
              "Check deploy config.");
1530 dpurdie 1814
    }
1815
    my ($targetType, $targetTag) = @_;
1816
 
1817
    # lets check to see if the target tag exists
1818
    # if does not the process with log an error.
1819
    #
1820
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
1821
 
1822
    # lets check to see if the source type dir actually exists
1823
    #
1824
    my($m_sDirLoc)  = "$DpkgAcHtmlDir/$targetType";
1825
    if( ! -d "$m_sDirLoc" )
1826
    {
1534 dpurdie 1827
        Error("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");
1530 dpurdie 1828
    }
1829
 
1830
    # know everything exists so lets do the biz.
1831
    #
1832
    # now we need to copy all the files.
1833
    #
1834
    local *DIR;
1835
    opendir(DIR, $m_sDirLoc) or 
1534 dpurdie 1836
        Error("Can't opendir $m_sDirLoc: $!");
1530 dpurdie 1837
 
1838
    my ($m_fLoc) = "";
1839
    my ($file) = "";
1840
    while (defined($file = readdir(DIR)))
1841
    {
1842
        if ( $file !~ /^.$/  &&
1843
             $file !~ /^..$/ )
1844
        {
1845
            $m_fLoc = "$m_sDirLoc/$file";
1846
            if(File::Copy::copy("$m_fLoc", "$targetValue"))
1847
            {
1534 dpurdie 1848
                Verbose("Copied AcHtml [$targetType] item [$file] to [$targetValue] ...");
1530 dpurdie 1849
            }
1850
            else
1851
            {
1534 dpurdie 1852
                Error("Failed to copy AcHtml [$targetType] item [$m_fLoc]: $!");
1530 dpurdie 1853
            }
1854
        }
1855
    }
1856
 
1857
    closedir(DIR);
1858
    return 1;
1859
}
1860
 
1861
 
1862
#------------------------------------------------------------------------------
1863
sub installAllDpkgArchiveInfoFilesFiles
1864
#
1865
# Description:
1866
#       This sub-routine is used to install all infofiles files from the
1867
#       dpkg_archive into the defined install area.
1868
#
1869
#       It assumes based on the build type where the src files will be located.
1870
#
1871
#       If it has any problems it will log an error and stop processing.
1872
#
1873
#------------------------------------------------------------------------------
1874
{
1875
    # correct number of parameters?
1876
    if ( ($#_+1) != 1 )
1877
    {
1534 dpurdie 1878
        Error("Incorrect number of params passed to " .
1879
              "installAllDpkgArchiveInfoFilesFiles() function. ",
1880
              "Check deploy config.");
1530 dpurdie 1881
    }
1882
 
1883
    my ($targetTag) = @_;
1884
 
1885
    # lets check to see if the target tag exists
1886
    # if does not the process with log an error.
1887
    #
1888
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
1889
 
1890
 
1891
    # for now lets call the generic funtion to move all items
1892
    # in the associated dpkg_archive dir.
1893
    #
1894
    installAllDpkgArchiveFiles("infofiles", $targetTag);
1895
 
1896
    return 1;
1897
}
1898
 
1899
 
1900
 
1901
#------------------------------------------------------------------------------
1902
sub installAllDpkgArchiveSqlFiles
1903
#
1904
# Description:
1905
#       This sub-routine is used to install all sql files from the
1906
#       dpkg_archive into the defined install area.
1907
#
1908
#       It assumes based on the build type where the src files will be located.
1909
#
1910
#       If it has any problems it will log an error and stop processing.
1911
#
1912
#------------------------------------------------------------------------------
1913
{
1914
    # correct number of parameters?
1915
    if ( ($#_+1) != 1 )
1916
    {
1534 dpurdie 1917
        Error("Incorrect number of params passed to " .
1918
              "installAllDpkgArchiveSqlFiles() function. ",
1919
              "Check deploy config.");
1530 dpurdie 1920
    }
1921
 
1922
    my ($targetTag) = @_;
1923
 
1924
    # lets check to see if the target tag exists
1925
    # if does not the process with log an error.
1926
    #
1927
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
1928
 
1929
 
1930
    # for now lets call the generic funtion to move all items
1931
    # in the associated dpkg_archive dir.
1932
    #
1933
    installAllDpkgArchiveFiles("sql", $targetTag);
1934
 
1935
    return 1;
1936
}
1937
 
1938
 
1939
#------------------------------------------------------------------------------
1940
sub installAllDpkgArchiveWarFiles
1941
#
1942
# Description:
1943
#       This sub-routine is used to install all war files from the
1944
#       dpkg_archive into the defined install area.
1945
#
1946
#       It assumes based on the build type where the src files will be located.
1947
#
1948
#       If it has any problems it will log an error and stop processing.
1949
#
1950
#------------------------------------------------------------------------------
1951
{
1952
    # correct number of parameters?
1953
    if ( ($#_+1) != 1 )
1954
    {
1534 dpurdie 1955
        Error("Incorrect number of params passed to " .
1956
              "installAllDpkgArchiveWarFiles() function. " ,
1957
              "Check deploy config.");
1530 dpurdie 1958
    }
1959
 
1960
    my ($targetTag) = @_;
1961
 
1962
    # lets check to see if the target tag exists
1963
    # if does not the process with log an error.
1964
    #
1965
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
1966
 
1967
 
1968
    # for now lets call the generic funtion to move all items
1969
    # in the associated dpkg_archive dir.
1970
    #
1971
    installAllDpkgArchiveFiles("war", $targetTag);
1972
 
1973
    return 1;
1974
}
1975
 
1976
 
1977
#------------------------------------------------------------------------------
1978
sub installAllDpkgArchiveJarFiles
1979
#
1980
# Description:
1981
#       This sub-routine is used to install all jar files from the
1982
#       dpkg_archive into the defined install area.
1983
#
1984
#       It assumes based on the build type where the src files will be located.
1985
#
1986
#       If it has any problems it will log an error and stop processing.
1987
#
1988
#------------------------------------------------------------------------------
1989
{
1990
    # correct number of parameters?
1991
    if ( ($#_+1) != 1 )
1992
    {
1534 dpurdie 1993
        Error("Incorrect number of params passed to " .
1994
              "installAllDpkgArchiveJarFiles() function. " ,
1995
              "Check deploy config.");
1530 dpurdie 1996
    }
1997
 
1998
    my ($targetTag) = @_;
1999
 
2000
    # lets check to see if the target tag exists
2001
    # if does not the process with log an error.
2002
    #
2003
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2004
 
2005
 
2006
    # for now lets call the generic funtion to move all items
2007
    # in the associated dpkg_archive dir.
2008
    #
2009
    installAllDpkgArchiveFiles("jar", $targetTag);
2010
 
2011
    return 1;
2012
}
2013
 
2014
 
2015
#------------------------------------------------------------------------------
2016
sub installAllDpkgArchiveEtcFiles
2017
#
2018
# Description:
2019
#       This sub-routine is used to install all etc files from the
2020
#       dpkg_archive into the defined install area.
2021
#
2022
#       It assumes based on the build type where the src files will be located.
2023
#
2024
#       If it has any problems it will log an error and stop processing.
2025
#
2026
#------------------------------------------------------------------------------
2027
{
2028
    # correct number of parameters?
2029
    if ( ($#_+1) != 1 )
2030
    {
1534 dpurdie 2031
        Error("Incorrect number of params passed to " .
2032
              "installAllDpkgArchiveEtcFiles() function. " ,
2033
              "Check deploy config.");
1530 dpurdie 2034
    }
2035
 
2036
    my ($targetTag) = @_;
2037
 
2038
    # lets check to see if the target tag exists
2039
    # if does not the process with log an error.
2040
    #
2041
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2042
 
2043
 
2044
    # for now lets call the generic funtion to move all items
2045
    # in the associated dpkg_archive dir.
2046
    #
2047
    installAllDpkgArchiveFiles("etc", $targetTag);
2048
 
2049
    return 1;
2050
}
2051
 
2052
 
2053
#------------------------------------------------------------------------------
2054
sub installAllDpkgArchiveScriptsFiles
2055
#
2056
# Description:
2057
#       This sub-routine is used to install all scripts files from the
2058
#       dpkg_archive into the defined install area.
2059
#
2060
#       It assumes based on the build type where the src files will be located.
2061
#
2062
#       If it has any problems it will log an error and stop processing.
2063
#
2064
#------------------------------------------------------------------------------
2065
{
2066
    # correct number of parameters?
2067
    if ( ($#_+1) != 1 )
2068
    {
1534 dpurdie 2069
        Error("Incorrect number of params passed to " .
2070
              "installAllDpkgArchiveScriptsFiles() function. " ,
2071
              "Check deploy config.");
1530 dpurdie 2072
    }
2073
 
2074
    my ($targetTag) = @_;
2075
 
2076
    # lets check to see if the target tag exists
2077
    # if does not the process with log an error.
2078
    #
2079
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2080
 
2081
 
2082
    # for now lets call the generic funtion to move all items
2083
    # in the associated dpkg_archive dir.
2084
    #
2085
    installAllDpkgArchiveFiles("scripts", $targetTag);
2086
 
2087
    return 1;
2088
}
2089
 
2090
 
2091
#------------------------------------------------------------------------------
2092
sub installAllDpkgArchiveIncludeFiles
2093
#
2094
# Description:
2095
#       This sub-routine is used to install all include files from the
2096
#       dpkg_archive into the defined install area.
2097
#
2098
#       It assumes based on the build type where the src files will be located.
2099
#
2100
#       If it has any problems it will log an error and stop processing.
2101
#
2102
#------------------------------------------------------------------------------
2103
{
2104
    # correct number of parameters?
2105
    if ( ($#_+1) != 1 )
2106
    {
1534 dpurdie 2107
        Error("Incorrect number of params passed to " .
2108
              "installAllDpkgArchiveIncludeFiles() function. " ,
2109
              "Check deploy config.");
1530 dpurdie 2110
    }
2111
 
2112
    my ($targetTag) = @_;
2113
 
2114
    # lets check to see if the target tag exists
2115
    # if does not the process with log an error.
2116
    #
2117
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2118
 
2119
 
2120
    # for now lets call the generic funtion to move all items
2121
    # in the associated dpkg_archive dir.
2122
    #
2123
    installAllDpkgArchiveFiles("include", $targetTag);
2124
 
2125
    return 1;
2126
}
2127
 
2128
 
2129
#------------------------------------------------------------------------------
2130
sub installAllDpkgArchiveDocFiles
2131
#
2132
# Description:
2133
#       This sub-routine is used to install all include files from the
2134
#       dpkg_archive into the defined install area.
2135
#
2136
#       It assumes based on the build type where the src files will be located.
2137
#
2138
#       If it has any problems it will log an error and stop processing.
2139
#
2140
#------------------------------------------------------------------------------
2141
{
2142
    # correct number of parameters?
2143
    if ( ($#_+1) != 1 )
2144
    {
1534 dpurdie 2145
        Error("Incorrect number of params passed to " .
2146
              "installAllDpkgArchiveIncludeFiles() function. " ,
2147
              "Check deploy config.");
1530 dpurdie 2148
    }
2149
 
2150
    my ($targetTag) = @_;
2151
 
2152
    # lets check to see if the target tag exists
2153
    # if does not the process with log an error.
2154
    #
2155
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2156
 
2157
 
2158
    # for now lets call the generic funtion to move all items
2159
    # in the associated dpkg_archive dir.
2160
    #
2161
    installAllDpkgArchiveFiles("doc", $targetTag);
2162
 
2163
    return 1;
2164
}
2165
 
2166
#------------------------------------------------------------------------------
2167
sub installAllDpkgArchiveJspFiles
2168
#
2169
# Description:
2170
#       This sub-routine is used to install all jsp associated files from the
2171
#       dpkg_archive into the defined install area.
2172
#
2173
#       It assumes based on the build type where the src files will be located.
2174
#
2175
#       If it has any problems it will log an error and stop processing.
2176
#
2177
#   Source directory: $DpkgJspDir
2178
#   Target directory: $TargetBaseDir
2179
#
2180
#------------------------------------------------------------------------------
2181
{
2182
    # correct number of parameters?
2183
    if ( ($#_+1) != 0 )
2184
    {
1534 dpurdie 2185
        Error("Incorrect number of params passed to " .
2186
              "installAllDpkgArchiveJspFiles() function. " ,
2187
              "Check deploy config.");
1530 dpurdie 2188
    }
2189
 
2190
    return installAllDpkgArchiveFiles ('jsp', '--NoTag');
2191
}
2192
 
2193
 
2194
#------------------------------------------------------------------------------
2195
sub installDpkgArchiveFile
2196
#
2197
# Description:
2198
#       This sub-routine is used to install a file of a particular type
2199
#       from the dpkg_archive into the supplied install dir. 
2200
#
2201
#       It assumes based on the build type where the file will be located.
2202
#
2203
#       If it fails to find the file it will report an error and terminates
2204
#       processing.
2205
#
2206
# Inputs:   $targetType         - Type of target ( provides source directory)
2207
#           $sfile              - Source file name, within source directory
2208
#           $targetTag          - Symbolic target dir
2209
#
2210
#
2211
# Note: This function will copy a single file
2212
#
2213
#------------------------------------------------------------------------------
2214
{
2215
    # correct number of parameters?
2216
    if ( ($#_+1) != 3 )
2217
    {
1534 dpurdie 2218
        Error("Incorrect number of params passed to " .
2219
              "installDpkgArchiveFile() function. " ,
2220
              "Check deploy config.");
1530 dpurdie 2221
    }
2222
 
2223
    my ($targetType, $sfile, $targetTag) = @_;
2224
 
2225
    # lets check to see if the target tag exists
2226
    # if does not the process with log an error.
2227
    #
2228
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2229
 
2230
 
2231
    # lets define the absolute location of the file
2232
    #
2233
    my ($m_dstFileLocation) = "$targetValue/$sfile";
2234
    my ($m_srcFileLocation) = "";
2235
 
2236
    if    ( "$targetType" eq "jar" )        { $m_srcFileLocation = "$DpkgJarDir/$sfile"; }
2237
    elsif ( "$targetType" eq "sar" )        { $m_srcFileLocation = "$DpkgSarDir/$sfile"; }
2238
    elsif ( "$targetType" eq "include" )    { $m_srcFileLocation = "$DpkgIncludeDir/$sfile"; }
2239
    elsif ( "$targetType" eq "war" )        { $m_srcFileLocation = "$DpkgWarDir/$sfile"; }
2240
    elsif ( "$targetType" eq "infofiles" )  { $m_srcFileLocation = "$DpkgInfoFilesDir/$sfile"; }
2241
    elsif ( "$targetType" eq "sql" )        { $m_srcFileLocation = "$DpkgSqlDir/$sfile"; }
2242
    elsif ( "$targetType" eq "etc" )        { $m_srcFileLocation = "$DpkgEtcDir/$sfile"; }
2243
    elsif ( "$targetType" eq "scripts" )    { $m_srcFileLocation = "$DpkgScriptsDir/$sfile";  }
2244
    elsif ( "$targetType" eq "rox" )        { $m_srcFileLocation = "$DpkgRoxDir/$sfile";  }
2245
    elsif ( "$targetType" eq "dat" )        { $m_srcFileLocation = "$DpkgDatDir/$sfile";  }
2246
    elsif ( "$targetType" eq "thx" )        { $m_srcFileLocation = "$DpkgThxDir/$sfile";  }
2247
    elsif ( "$targetType" eq "mug" )        { $m_srcFileLocation = "$DpkgMugDir/$sfile";  }
2248
    elsif ( "$targetType" eq "rpt" )        { $m_srcFileLocation = "$DpkgRptDir/$sfile";  }
2249
    elsif ( "$targetType" eq "doc" )        { $m_srcFileLocation = "$DpkgDocDir/$sfile";  }
2250
    else  {
1534 dpurdie 2251
        Error("installDpkgArchiveFile() passed unknown target type [$targetType].");
1530 dpurdie 2252
    }
2253
 
2254
 
2255
    # we will check to see if the file exists.
2256
    #
2257
    if ( -f "$m_srcFileLocation" )
2258
    {
2259
        # now we need to copy the file. 
2260
        if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
2261
        {
1534 dpurdie 2262
            Verbose("Copied [$targetType] item [$sfile] to [$m_dstFileLocation] ...");
1530 dpurdie 2263
        }
2264
        else
2265
        {
1534 dpurdie 2266
            Error("Failed to copy [$targetType] item [$sfile]: $!"); 
1530 dpurdie 2267
        }
2268
    }
2269
    else
2270
    {
1534 dpurdie 2271
        Error("Dpkg_archive [$targetType] item [$sfile] does not exist.");
1530 dpurdie 2272
    }
2273
 
2274
    return 1;
2275
}
2276
 
2277
 
2278
#------------------------------------------------------------------------------
2279
sub installDpkgArchiveAcHtmlFile
2280
#
2281
# Description:
2282
#       This sub-routine is used to install a achtml file from the
2283
#       dpkg_archive into the supplied install dir. 
2284
#
2285
#       It assumes based on the build type where the file will be located.
2286
#
2287
#       If it fails to find the file it will report an error and terminates
2288
#       processing.
2289
#
2290
# Ugly trick:
2291
#       This function tags a $$targetType argument which is used in constructing
2292
#       the source directory path. ie: InterfaceDir/achtml/$targetType
2293
#
2294
#       Could provide as an option to installDpkgArchiveFile and re-use that
2295
#       function
2296
#------------------------------------------------------------------------------
2297
{
2298
    # correct number of parameters?
2299
    if ( ($#_+1) != 3 )
2300
    {
1534 dpurdie 2301
        Error("Incorrect number of params passed to " .
2302
              "installDpkgArchiveAcHtmlFile() function. " ,
2303
              "Check deploy config.");
1530 dpurdie 2304
    }
2305
    my ($targetType, $sfile, $targetTag) = @_;
2306
 
2307
    # lets check to see if the source type and file actually exist
2308
    #
2309
    my($m_sDirLoc)  = "$DpkgAcHtmlDir/$targetType";
2310
    if( ! -d "$m_sDirLoc" )
2311
    {
1534 dpurdie 2312
        Error("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");
1530 dpurdie 2313
    }
2314
 
2315
    # lets check to see if the file exists
2316
    #
2317
    my($m_sFileLoc) = "$DpkgAcHtmlDir/$targetType/$sfile";
2318
    if( ! -f "$m_sFileLoc" )
2319
    {
1534 dpurdie 2320
        Error("Failed to locate [$targetType] AcHtml file [$m_sFileLoc].");
1530 dpurdie 2321
    }
2322
 
2323
    # lets check to see if the target tag exists
2324
    # if does not the process with log an error.
2325
    #
2326
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2327
 
2328
    # know everything exists so lets do the biz.
2329
    #
2330
    # now we need to copy the file.
2331
    if(File::Copy::copy("$m_sFileLoc", "$targetValue"))
2332
    {
1534 dpurdie 2333
        Verbose("Copied [$targetType] AcHtml item [$sfile] to [$targetValue] ...");
1530 dpurdie 2334
    }
2335
    else
2336
    {
1534 dpurdie 2337
        Error("Failed to copy [$targetType] AcHtml item [$sfile]: $!");
1530 dpurdie 2338
    }
2339
 
2340
    return 1;
2341
}
2342
 
2343
 
2344
#------------------------------------------------------------------------------
2345
sub installDpkgArchiveRptFile
2346
#
2347
# Description:
2348
#       This sub-routine is used to install a rpt file from the
2349
#       dpkg_archive into the supplied install dir. 
2350
#
2351
#       It assumes based on the build type where the file will be located.
2352
#
2353
#       If it fails to find the file it will report an error and terminates
2354
#       processing.
2355
#
2356
#------------------------------------------------------------------------------
2357
{
2358
    # correct number of parameters?
2359
    if ( ($#_+1) != 2 )
2360
    {
1534 dpurdie 2361
        Error("Incorrect number of params passed to " .
2362
              "installDpkgArchiveRptFile() function. " ,
2363
              "Check deploy config.");
1530 dpurdie 2364
    }
2365
 
2366
    my ($sfile, $targetTag) = @_;
2367
 
2368
    # lets check to see if the target tag exists
2369
    # if does not the process with log an error.
2370
    #
2371
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2372
 
2373
 
2374
    # for now lets call the generic funtion to move all items
2375
    # in the associated dpkg_archive dir.
2376
    #
2377
    installDpkgArchiveFile("rpt", $sfile, $targetTag);
2378
 
2379
    return 1;
2380
}
2381
 
2382
 
2383
#------------------------------------------------------------------------------
2384
sub installDpkgArchiveRoxFile
2385
#
2386
# Description:
2387
#       This sub-routine is used to install a rox file from the
2388
#       dpkg_archive into the supplied install dir. 
2389
#
2390
#       It assumes based on the build type where the file will be located.
2391
#
2392
#       If it fails to find the file it will report an error and terminates
2393
#       processing.
2394
#
2395
#------------------------------------------------------------------------------
2396
{
2397
    # correct number of parameters?
2398
    if ( ($#_+1) != 2 )
2399
    {
1534 dpurdie 2400
        Error("Incorrect number of params passed to " .
2401
              "installDpkgArchiveRoxFile() function. " ,
2402
              "Check deploy config.");
1530 dpurdie 2403
    }
2404
 
2405
    my ($sfile, $targetTag) = @_;
2406
 
2407
    # lets check to see if the target tag exists
2408
    # if does not the process with log an error.
2409
    #
2410
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2411
 
2412
 
2413
    # for now lets call the generic funtion to move all items
2414
    # in the associated dpkg_archive dir.
2415
    #
2416
    installDpkgArchiveFile("rox", $sfile, $targetTag);
2417
 
2418
    return 1;
2419
}
2420
 
2421
 
2422
#------------------------------------------------------------------------------
2423
sub installDpkgArchiveDatFile
2424
#
2425
# Description:
2426
#       This sub-routine is used to install a dat file from the
2427
#       dpkg_archive into the supplied install dir. 
2428
#
2429
#       It assumes based on the build type where the file will be located.
2430
#
2431
#       If it fails to find the file it will report an error and terminates
2432
#       processing.
2433
#
2434
#------------------------------------------------------------------------------
2435
{
2436
    # correct number of parameters?
2437
    if ( ($#_+1) != 2 )
2438
    {
1534 dpurdie 2439
        Error("Incorrect number of params passed to " .
2440
              "installDpkgArchiveDatFile() function. " ,
2441
              "Check deploy config.");
1530 dpurdie 2442
    }
2443
 
2444
    my ($sfile, $targetTag) = @_;
2445
 
2446
    # lets check to see if the target tag exists
2447
    # if does not the process with log an error.
2448
    #
2449
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2450
 
2451
 
2452
    # for now lets call the generic funtion to move all items
2453
    # in the associated dpkg_archive dir.
2454
    #
2455
    installDpkgArchiveFile("dat", $sfile, $targetTag);
2456
 
2457
    return 1;
2458
}
2459
 
2460
 
2461
#------------------------------------------------------------------------------
2462
sub installDpkgArchiveThxFile
2463
#
2464
# Description:
2465
#       This sub-routine is used to install a thx file from the
2466
#       dpkg_archive into the supplied install dir. 
2467
#
2468
#       It assumes based on the build type where the file will be located.
2469
#
2470
#       If it fails to find the file it will report an error and terminates
2471
#       processing.
2472
#
2473
#------------------------------------------------------------------------------
2474
{
2475
    # correct number of parameters?
2476
    if ( ($#_+1) != 2 )
2477
    {
1534 dpurdie 2478
        Error("Incorrect number of params passed to " .
2479
              "installDpkgArchiveThxFile() function. " ,
2480
              "Check deploy config.");
1530 dpurdie 2481
    }
2482
 
2483
    my ($sfile, $targetTag) = @_;
2484
 
2485
    # lets check to see if the target tag exists
2486
    # if does not the process with log an error.
2487
    #
2488
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2489
 
2490
 
2491
    # for now lets call the generic funtion to move all items
2492
    # in the associated dpkg_archive dir.
2493
    #
2494
    installDpkgArchiveFile("thx", $sfile, $targetTag);
2495
 
2496
    return 1;
2497
}
2498
 
2499
 
2500
#------------------------------------------------------------------------------
2501
sub installDpkgArchiveMugFile
2502
#
2503
# Description:
2504
#       This sub-routine is used to install a mug file from the
2505
#       dpkg_archive into the supplied install dir. 
2506
#
2507
#       It assumes based on the build type where the file will be located.
2508
#
2509
#       If it fails to find the file it will report an error and terminates
2510
#       processing.
2511
#
2512
#------------------------------------------------------------------------------
2513
{
2514
    # correct number of parameters?
2515
    if ( ($#_+1) != 2 )
2516
    {
1534 dpurdie 2517
        Error("Incorrect number of params passed to " .
2518
              "installDpkgArchiveMugFile() function. " ,
2519
              "Check deploy config.");
1530 dpurdie 2520
    }
2521
 
2522
    my ($sfile, $targetTag) = @_;
2523
 
2524
    # lets check to see if the target tag exists
2525
    # if does not the process with log an error.
2526
    #
2527
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2528
 
2529
 
2530
    # for now lets call the generic funtion to move all items
2531
    # in the associated dpkg_archive dir.
2532
    #
2533
    installDpkgArchiveFile("mug", $sfile, $targetTag);
2534
 
2535
    return 1;
2536
}
2537
 
2538
 
2539
#------------------------------------------------------------------------------
2540
sub installDpkgArchiveInfoFilesFile
2541
#
2542
# Description:
2543
#       This sub-routine is used to install a infofiles file from the
2544
#       dpkg_archive into the supplied install dir. 
2545
#
2546
#       It assumes based on the build type where the file will be located.
2547
#
2548
#       If it fails to find the file it will report an error and terminates
2549
#       processing.
2550
#
2551
#------------------------------------------------------------------------------
2552
{
2553
    # correct number of parameters?
2554
    if ( ($#_+1) != 2 )
2555
    {
1534 dpurdie 2556
        Error("Incorrect number of params passed to " .
2557
              "installDpkgArchiveInfoFilesFile() function. " ,
2558
              "Check deploy config.");
1530 dpurdie 2559
    }
2560
 
2561
    my ($sfile, $targetTag) = @_;
2562
 
2563
    # lets check to see if the target tag exists
2564
    # if does not the process with log an error.
2565
    #
2566
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2567
 
2568
 
2569
    # for now lets call the generic funtion to move all items
2570
    # in the associated dpkg_archive dir.
2571
    #
2572
    installDpkgArchiveFile("infofiles", $sfile, $targetTag);
2573
 
2574
    return 1;
2575
}
2576
 
2577
 
2578
#------------------------------------------------------------------------------
2579
sub installDpkgArchiveSqlFile
2580
#
2581
# Description:
2582
#       This sub-routine is used to install a sql file from the
2583
#       dpkg_archive into the supplied install dir. 
2584
#
2585
#       It assumes based on the build type where the file will be located.
2586
#
2587
#       If it fails to find the file it will report an error and terminates
2588
#       processing.
2589
#
2590
#------------------------------------------------------------------------------
2591
{
2592
    # correct number of parameters?
2593
    if ( ($#_+1) != 2 )
2594
    {
1534 dpurdie 2595
        Error("Incorrect number of params passed to " .
2596
              "installDpkgArchiveSqlFile() function. " ,
2597
              "Check deploy config.");
1530 dpurdie 2598
    }
2599
 
2600
    my ($sfile, $targetTag) = @_;
2601
 
2602
    # lets check to see if the target tag exists
2603
    # if does not the process with log an error.
2604
    #
2605
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2606
 
2607
 
2608
    # for now lets call the generic funtion to move all items
2609
    # in the associated dpkg_archive dir.
2610
    #
2611
    installDpkgArchiveFile("sql", $sfile, $targetTag);
2612
 
2613
    return 1;
2614
}
2615
 
2616
 
2617
#------------------------------------------------------------------------------
2618
sub installDpkgArchiveWarFile
2619
#
2620
# Description:
2621
#       This sub-routine is used to install a war file from the
2622
#       dpkg_archive into the supplied install dir. 
2623
#
2624
#       It assumes based on the build type where the file will be located.
2625
#
2626
#       If it fails to find the file it will report an error and terminates
2627
#       processing.
2628
#
2629
#------------------------------------------------------------------------------
2630
{
2631
    # correct number of parameters?
2632
    if ( ($#_+1) != 2 )
2633
    {
1534 dpurdie 2634
        Error("Incorrect number of params passed to " .
2635
              "installDpkgArchiveWarFile() function. " ,
2636
              "Check deploy config.");
1530 dpurdie 2637
    }
2638
 
2639
    my ($sfile, $targetTag) = @_;
2640
 
2641
    # lets check to see if the target tag exists
2642
    # if does not the process with log an error.
2643
    #
2644
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2645
 
2646
 
2647
    # for now lets call the generic funtion to move all items
2648
    # in the associated dpkg_archive dir.
2649
    #
2650
    installDpkgArchiveFile("war", $sfile, $targetTag);
2651
 
2652
    return 1;
2653
}
2654
 
2655
 
2656
 
2657
#------------------------------------------------------------------------------
2658
sub installDpkgArchiveJarFile
2659
#
2660
# Description:
2661
#       This sub-routine is used to install a jar file from the
2662
#       dpkg_archive into the supplied install dir. 
2663
#
2664
#       It assumes based on the build type where the file will be located.
2665
#
2666
#       If it fails to find the file it will report an error and terminates
2667
#       processing.
2668
#
2669
#------------------------------------------------------------------------------
2670
{
2671
    # correct number of parameters?
2672
    if ( ($#_+1) != 2 )
2673
    {
1534 dpurdie 2674
        Error("Incorrect number of params passed to " .
2675
              "installDpkgArchiveJarFile() function. " ,
2676
              "Check deploy config.");
1530 dpurdie 2677
    }
2678
 
2679
    my ($sfile, $targetTag) = @_;
2680
 
2681
    # lets check to see if the target tag exists
2682
    # if does not the process with log an error.
2683
    #
2684
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2685
 
2686
 
2687
    # for now lets call the generic funtion to move all items
2688
    # in the associated dpkg_archive dir.
2689
    #
2690
    installDpkgArchiveFile("jar", $sfile, $targetTag);
2691
 
2692
    return 1;
2693
}
2694
 
2695
 
2696
 
2697
#------------------------------------------------------------------------------
2698
sub installDpkgArchiveSarFile
2699
#
2700
# Description:
2701
#       This sub-routine is used to install a sar file from the
2702
#       dpkg_archive into the supplied install dir. 
2703
#
2704
#       It assumes based on the build type where the file will be located.
2705
#
2706
#       If it fails to find the file it will report an error and terminates
2707
#       processing.
2708
#
2709
#------------------------------------------------------------------------------
2710
{
2711
    # correct number of parameters?
2712
    if ( ($#_+1) != 2 )
2713
    {
1534 dpurdie 2714
        Error("Incorrect number of params passed to " .
2715
              "installDpkgArchiveSarFile() function. " ,
2716
              "Check deploy config.");
1530 dpurdie 2717
    }
2718
 
2719
    my ($sfile, $targetTag) = @_;
2720
 
2721
    # lets check to see if the target tag exists
2722
    # if does not the process with log an error.
2723
    #
2724
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2725
 
2726
 
2727
    # for now lets call the generic funtion to move all items
2728
    # in the associated dpkg_archive dir.
2729
    #
2730
    installDpkgArchiveFile("sar", $sfile, $targetTag);
2731
 
2732
    return 1;
2733
}
2734
 
2735
 
2736
 
2737
 
2738
 
2739
#------------------------------------------------------------------------------
2740
sub installDpkgArchiveEtcFile
2741
#
2742
# Description:
2743
#       This sub-routine is used to install an etc file from the
2744
#       dpkg_archive into the supplied install dir. 
2745
#
2746
#       It assumes based on the build type where the file will be located.
2747
#
2748
#       If it fails to find the file it will report an error and terminates
2749
#       processing.
2750
#
2751
#------------------------------------------------------------------------------
2752
{
2753
    # correct number of parameters?
2754
    if ( ($#_+1) != 2 )
2755
    {
1534 dpurdie 2756
        Error("Incorrect number of params passed to " .
2757
              "installDpkgArchiveEtcFile() function. " ,
2758
              "Check deploy config.");
1530 dpurdie 2759
    }
2760
 
2761
    my ($sfile, $targetTag) = @_;
2762
 
2763
    # lets check to see if the target tag exists
2764
    # if does not the process with log an error.
2765
    #
2766
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2767
 
2768
 
2769
    # for now lets call the generic funtion to move all items
2770
    # in the associated dpkg_archive dir.
2771
    #
2772
    installDpkgArchiveFile("etc", $sfile, $targetTag);
2773
 
2774
    return 1;
2775
}
2776
 
2777
 
2778
#------------------------------------------------------------------------------
2779
sub installDpkgArchiveScriptsFile
2780
#
2781
# Description:
2782
#       This sub-routine is used to install a scripts file from the
2783
#       dpkg_archive into the supplied install dir. 
2784
#
2785
#       It assumes based on the build type where the file will be located.
2786
#
2787
#       If it fails to find the file it will report an error and terminates
2788
#       processing.
2789
#
2790
#------------------------------------------------------------------------------
2791
{
2792
    # correct number of parameters?
2793
    if ( ($#_+1) != 2 )
2794
    {
1534 dpurdie 2795
        Error("Incorrect number of params passed to " .
2796
              "installDpkgArchiveScriptsFile() function. " ,
2797
              "Check deploy config.");
1530 dpurdie 2798
    }
2799
 
2800
   my ($sfile, $targetTag) = @_;
2801
 
2802
    # lets check to see if the target tag exists
2803
    # if does not the process with log an error.
2804
    #
2805
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2806
 
2807
 
2808
    # for now lets call the generic funtion to move all items
2809
    # in the associated dpkg_archive dir.
2810
    #
2811
    installDpkgArchiveFile("scripts", $sfile, $targetTag);
2812
 
2813
    return 1;
2814
}
2815
 
2816
 
2817
 
2818
#------------------------------------------------------------------------------
2819
sub installDpkgArchiveIncludeFile
2820
#
2821
# Description:
2822
#       This sub-routine is used to install a include file from the
2823
#       dpkg_archive into the supplied install dir. 
2824
#
2825
#       It assumes based on the build type where the file will be located.
2826
#
2827
#       If it fails to find the file it will report an error and terminates
2828
#       processing.
2829
#
2830
#------------------------------------------------------------------------------
2831
{
2832
    # correct number of parameters?
2833
    if ( ($#_+1) != 2 )
2834
    {
1534 dpurdie 2835
        Error("Incorrect number of params passed to " .
2836
              "installDpkgArchiveIncludeFile() function. " ,
2837
              "Check deploy config.");
1530 dpurdie 2838
    }
2839
 
2840
   my ($sfile, $targetTag) = @_;
2841
 
2842
    # lets check to see if the target tag exists
2843
    # if does not the process with log an error.
2844
    #
2845
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2846
 
2847
 
2848
    # for now lets call the generic funtion to move all items
2849
    # in the associated dpkg_archive dir.
2850
    #
2851
    installDpkgArchiveFile("include", $sfile, $targetTag);
2852
 
2853
    return 1;
2854
}
2855
 
2856
 
2857
 
2858
#------------------------------------------------------------------------------
2859
sub installDpkgArchiveDocFile
2860
#
2861
# Description:
2862
#       This sub-routine is used to install a include file from the
2863
#       dpkg_archive into the supplied install dir. 
2864
#
2865
#       It assumes based on the build type where the file will be located.
2866
#
2867
#       If it fails to find the file it will report an error and terminates
2868
#       processing.
2869
#
2870
#------------------------------------------------------------------------------
2871
{
2872
    # correct number of parameters?
2873
    if ( ($#_+1) != 2 )
2874
    {
1534 dpurdie 2875
        Error("Incorrect number of params passed to " .
2876
              "installDpkgArchiveDocFile() function. " ,
2877
              "Check deploy config.");
1530 dpurdie 2878
    }
2879
 
2880
   my ($sfile, $targetTag) = @_;
2881
 
2882
    # lets check to see if the target tag exists
2883
    # if does not the process with log an error.
2884
    #
2885
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2886
 
2887
 
2888
    # for now lets call the generic funtion to move all items
2889
    # in the associated dpkg_archive dir.
2890
    #
2891
    installDpkgArchiveFile("doc", $sfile, $targetTag);
2892
 
2893
    return 1;
2894
}
2895
 
2896
 
2897
#------------------------------------------------------------------------------
1556 lkelly 2898
sub copyDpkgArchiveBinFile
2899
#
2900
# Description:
2901
#       This sub-routine is used to find a binary file from the
2902
#       dpkg_archive and copy it into the supplied install dir. 
2903
#
2904
#       If it fails to find the file it will report an error and terminates
2905
#       processing.
2906
#
2907
# Inputs          :     @srcDirList         - array of subdirectories to search
2908
#                                             within the $DpkgBinDir
2909
#                       $srcFilename        - file to find then copy
2910
#                       $destDir            - destination directory
2911
#                       $rename             - Optional Rename
2912
#
2913
#
2914
# Returns         :     Nothing of use
2915
#                       Will not return if the file is not found
2916
#
2917
#------------------------------------------------------------------------------
2918
{
2919
    my ($srcDirList, $srcFilename, $destDir, $rename ) = @_;
2920
 
2921
    if ( "$MachType" eq "win32" )
2922
    {
2923
        # if the item does not have an .exe extention
2924
        # we shall add one for convience.
2925
        #
2926
        $srcFilename .= '.exe'
2927
            if ( $srcFilename !~ m~\.(exe)|(dll)$~i );
2928
 
2929
        $rename .= '.exe'
2930
            if ( $rename && $rename !~ m~\.(exe)|(dll)$~i );
2931
    }
2932
 
2933
    foreach my $i (@$srcDirList)
2934
    {
2935
        my $m_DpkgDir = "$DpkgBinDir/$i";
2936
        if ( ! -d $m_DpkgDir )
2937
        {
2938
            Debug("Directory [$m_DpkgDir] not found.");
2939
            next;
2940
        }
2941
 
2942
        # Define the absolute location of the file
2943
        #
2944
        my $m_srcFileLocation = "$m_DpkgDir/$srcFilename";
2945
        my $m_dstFileLocation = "$destDir/" . ( $rename ? $rename : $srcFilename );
2946
 
2947
        # we will check to see if the file exists.
2948
        #
2949
        if ( -f $m_srcFileLocation )
2950
        {
2951
            # now we need to copy the file.
2952
            if(File::Copy::copy($m_srcFileLocation, $m_dstFileLocation))
2953
            {
2954
                Verbose("Copied Bin [$srcFilename] to [$m_dstFileLocation] ...");
2955
 
2956
                # no need to go further, we have found the file.
2957
                #
2958
                return 1;
2959
            }
2960
            else
2961
            {
2962
                Error("Failed to copy binary [$srcFilename]: $!");
2963
            }
2964
        }
2965
        # else we have not found the file yet!
2966
    }
2967
 
2968
    # if we do not find the file at all we need to inform the user.
2969
    #
2970
    Error("Dpkg_archive bin file [$srcFilename]",
2971
          "File does not exist or is not in correct directory structure");
2972
}
2973
 
2974
#------------------------------------------------------------------------------
1530 dpurdie 2975
sub installDpkgArchiveBinFile
2976
#
2977
# Description:
2978
#       This sub-routine is used to install a binary file from the
2979
#       dpkg_archive into the supplied install dir. 
2980
#
2981
#       It assumes based on the build type where the file will be located.
2982
#
2983
#       If it fails to find the file it will report an error and terminates
2984
#       processing.
2985
#
2986
# Inputs          :     $sfile              - Name of source file
2987
#                                             or a reference to a list of files
2988
#                       $targetTag          - Symbolic name of target
2989
#                       Options             - Optional options
2990
#
2991
# Options:
1546 dpurdie 2992
#                   --SelectFrom=xxxx       - Limits file source selection
1530 dpurdie 2993
#                                             By default all LIB sources are searched.
2994
#                                             The selector should be a Platform, Product
2995
#                                             ,Target or MachineType
2996
#
1556 lkelly 2997
#                   --Rename=xxxx           - Rename the file during the copy operation
2998
#                                             Not valid if $sfile is a ref to a list
1530 dpurdie 2999
#
1556 lkelly 3000
#                   --InstallProdAndDebug   - install both production and debug
3001
#                                             versions of any binary files 
3002
#                                             in bin/P and bin/D sub-dirs, 
3003
#                                             and create a links/copy of the 
3004
#                                             file for the $BuildType
3005
#                                             in the actual bin directory.
3006
#                                             (only tested for sparc)
3007
#
1530 dpurdie 3008
# Returns         :     Nothing of use
3009
#                       Will not return if the file is not found
3010
#
3011
#------------------------------------------------------------------------------
3012
{
3013
    my @args;
3014
    my $select = '_ALL_';
1556 lkelly 3015
    my $rename = "";
3016
    my $installProdAndDebug;
1530 dpurdie 3017
 
3018
    #
3019
    #   Process parameters and extract options
3020
    #
3021
    foreach  ( @_ )
3022
    {
3023
        if ( m/^--SelectFrom=(.*)/ ) {
3024
            $select = $1;
1534 dpurdie 3025
            Error("installDpkgArchiveBinFile: Selector not known: $_")
1530 dpurdie 3026
                unless ( defined $DpkgLibDirList{$select} );
1556 lkelly 3027
        } elsif ( m/^--InstallProdAndDebug/ ) {
3028
            if ( "$MachType" eq "sparc" )
3029
            {
3030
                $installProdAndDebug = 1;
3031
            }
3032
            else
3033
            {
3034
                Error("--InstallProdAndDebug option only supported for sparc.");
3035
            }
1530 dpurdie 3036
 
1556 lkelly 3037
        } elsif ( m/^--Rename=(.+)/ ) {
3038
            $rename = $1;
3039
 
1530 dpurdie 3040
        } elsif ( m/^--/ ) {
1534 dpurdie 3041
            Warning ("installDpkgArchiveBinFile: Unknown option ignored: $_")
1530 dpurdie 3042
 
3043
        } else {
3044
            push @args, $_;
3045
        }
3046
    }
3047
 
3048
 
3049
    # correct number of parameters?
3050
    my ($fref, $targetTag) = @_;
3051
    if ( $#args != 1 )
3052
    {
1534 dpurdie 3053
        Error("Incorrect number of params passed to " .
3054
              "installDpkgArchiveBinFile() function. " ,
3055
              "Check deploy config.");
1530 dpurdie 3056
    }
3057
 
3058
    # lets check to see if the target tag exists
3059
    # if does not the process with log an error.
3060
    #
3061
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
3062
 
3063
    #
3064
    #   Process the file name
3065
    #   This will either be a scalar name, or a reference to an array of names
3066
    #   If the user has provided an array of names then expand the list
3067
    #
3068
    #   Convert $fref into an reference to a list
3069
    #
3070
    my @one_file;
3071
    unless ( ref ( $fref ) eq 'ARRAY' )
3072
    {
3073
        push @one_file, $fref;
3074
        $fref = \@one_file;
3075
    }
1556 lkelly 3076
    else
3077
    {
3078
        Error ("installDpkgArchiveBinFile. --Rename option cannot be used with a list of files")
3079
            if $rename;
3080
    }
1530 dpurdie 3081
 
3082
    foreach my $sfile ( @$fref )
3083
    {
1556 lkelly 3084
        if ( $installProdAndDebug )
1530 dpurdie 3085
        {
1556 lkelly 3086
            # This option allows you to install both prod and debug binaries.
3087
            # 1) creates a bin/P and bin/D subdirectory of the bin directory, 
3088
            # 2) copies the binaries into them, then 
3089
            # 3) links/copies from bin/$BuildType to bin directory.
3090
 
3091
            # if the bin/P bin/D dirs don't exist, create them.
3092
            if (! -d "$targetValue/$BuildType" )
1530 dpurdie 3093
            {
1556 lkelly 3094
                make_directory( "$targetValue/$BuildType", 0777, "Create BinDir/$BuildType dir");
1530 dpurdie 3095
            }
1556 lkelly 3096
            if (! -d "$targetValue/$AlternateBuildType" )
1530 dpurdie 3097
            {
1556 lkelly 3098
                make_directory( "$targetValue/$AlternateBuildType", 0777, "Create BinDir/$AlternateBuildType dir");
1530 dpurdie 3099
            }
1556 lkelly 3100
 
3101
            # copy in the production and debug binaries. Note the separate search paths.
3102
            copyDpkgArchiveBinFile(\@{$DpkgBinDirList{$select}}, $sfile, "$targetValue/$BuildType", $rename);
3103
            copyDpkgArchiveBinFile(\@{$DpkgBinDirListAlternate{$select}}, $sfile, "$targetValue/$AlternateBuildType", "$rename");
1530 dpurdie 3104
 
1556 lkelly 3105
            # create link (or copy) from bin to bin/$BuildType dir 
3106
            if ( $MachType eq "sparc" )
1530 dpurdie 3107
            {
1556 lkelly 3108
                # create symbolic link in the bin directory
3109
                if ( ! -f "$targetValue/$sfile" )
1530 dpurdie 3110
                {
1556 lkelly 3111
                    my $cmd = "cd $targetValue; ln -s $BuildType/$sfile $sfile ";
3112
                    my $retVal = system($cmd);
3113
                    if ( $retVal != 0 )
3114
                    {
3115
                        Error("Failed to create generic link [$targetValue/$sfile] to [$targetValue/$BuildType/$sfile]: $retVal");
3116
                    }
3117
                    else
3118
                    {
3119
                        Verbose("Created generic link [$targetValue/$sfile] to [$targetValue/$BuildType/$sfile] ...");
3120
                    }
1530 dpurdie 3121
                }
1556 lkelly 3122
            }
3123
            else
3124
            {
3125
                # create a copy in the bin directory
3126
                if(File::Copy::copy("$targetValue/$BuildType/$sfile" , "$targetValue" ))
3127
                {
3128
                    Verbose("Copied Bin [$targetValue/$BuildType/$sfile] to [$targetValue] ...");
3129
                }
1530 dpurdie 3130
                else
3131
                {
1556 lkelly 3132
                    Error("Failed to copy binary [$targetValue/$BuildType/$sfile] to [$targetValue]: $!");
1530 dpurdie 3133
                }
1556 lkelly 3134
 
1530 dpurdie 3135
            }
3136
        }
1556 lkelly 3137
        else
1530 dpurdie 3138
        {
1556 lkelly 3139
            copyDpkgArchiveBinFile(\@{$DpkgBinDirList{$select}}, $sfile, $targetValue, $rename );
1530 dpurdie 3140
        }
3141
    }
3142
    return 1;
3143
}
3144
 
3145
 
3146
#------------------------------------------------------------------------------
3147
sub installDpkgArchiveLibFile
3148
#
3149
# Description:
1556 lkelly 3150
#       This sub-routine is used to install a library file from the
1530 dpurdie 3151
#       dpkg_archive into the supplied install location dir.
3152
#
3153
#       It assumes based on the build type where the file will be located.
3154
#
3155
#       If it fails to find the file it will report an error and terminates
3156
#       processing.
3157
#
3158
#       Added optional 3rd parameter & if set to NoLinks then no generic named
3159
#       libs will be created
3160
#
1534 dpurdie 3161
# Inputs          :     $sfile              - Name of source file OR
3162
#                                             A --Filter specification ( below)
3163
#                                             A reference to a list of files OR
1530 dpurdie 3164
#                       $targetTag          - Symbolic name of target
3165
#                       $links              - Optional. 'nolinks' will supress generic named libs
3166
#                       Options             - Optional options
3167
#
3168
# Options:
1534 dpurdie 3169
#                   --NoLink                - same as 3rd arg == nolinks
1530 dpurdie 3170
#                   --Link                  - Default
1546 dpurdie 3171
#                   --SelectFrom=xxxx       - Limits file source selection
1530 dpurdie 3172
#                                             By default all LIB sources are searched.
3173
#                                             The selector should be a Platform, Product
3174
#                                             ,Target or MachineType
1556 lkelly 3175
#                   --InstallProdAndDebug   - install both production and debug
3176
#                                             versions of any libraries
3177
#                                             (only tested for sparc)
1530 dpurdie 3178
#
1534 dpurdie 3179
# SourceFile options:
3180
#                   Source files may be a filter rule which will expand to
3181
#                   one or more files.
3182
#                       --FilterIn=xx
3183
#                       --FilterInRE=xx
3184
#                       --FilterOut=xx
3185
#                       --FilterOutRE=xx
1530 dpurdie 3186
#
1534 dpurdie 3187
#                     Notes:    --FilterIn=xxxx, --FilterOut=xxx
3188
#                               xxx is a simple Shell style filter where:
3189
#                                   * means one or more charters        '*.EXE'
3190
#                                   ? means a single character          '*.?'
3191
#                                   [abc] means either a or b or c      'file.[ch]'
3192
#
3193
#                               --FilterInRE=xxx, --FilterOutRE=xxx
3194
#                               xxx is a Regular Expression. There are harder to use but very
3195
#                               powerful. ie '.*\.EXE$'
3196
#
3197
#                               The 'In' filters are applied before the 'Out' filters.
3198
#
3199
#                               Multiple options may be joined with a comma.
3200
#
1530 dpurdie 3201
# Returns         :     Nothing of use
3202
#                       Will not return if the file is not found
3203
#
3204
#------------------------------------------------------------------------------
3205
{
3206
    my @args;
3207
    my $links = 1;
3208
    my $select = '_ALL_';
1556 lkelly 3209
    my $installProdAndDebug;
1530 dpurdie 3210
 
3211
    #
3212
    #   Process parameters and extract options
3213
    #
3214
    foreach  ( @_ )
3215
    {
3216
        if ( m/^--NoLink/ ) {
3217
            $links = 0;
3218
 
3219
        } elsif ( m/^--Link/ ) {
3220
            $links = 1;
3221
 
3222
        } elsif ( m/^--SelectFrom=(.*)/ ) {
3223
            $select = $1;
1534 dpurdie 3224
            Error("installDpkgArchiveLibFile: Selector not known: $_")
1530 dpurdie 3225
                unless ( defined $DpkgLibDirList{$select} );
3226
 
1534 dpurdie 3227
        } elsif ( m/^--Filter.*=/ ) {
3228
            push @args, $_;
1556 lkelly 3229
        } elsif ( m/^--InstallProdAndDebug/ ) {
3230
            # not sure if the filename conventions allow the installation
3231
            # of both prod/debug files on windows, so limit this to sparc/unix.
3232
            if ( "$MachType" ne "sparc" ){
3233
                Error("Can only use the InstallProdAndDebug option for sparc.");
3234
            }
1534 dpurdie 3235
 
1556 lkelly 3236
            $installProdAndDebug = 1;
1530 dpurdie 3237
        } elsif ( m/^--/ ) {
1534 dpurdie 3238
            Warning ("installDpkgArchiveLibFile: Unknown option ignored: $_")
1530 dpurdie 3239
 
3240
        } else {
3241
            push @args, $_;
3242
        }
3243
    }
3244
 
3245
    #
3246
    #   Handle the optional 3rd argument
3247
    #
3248
    if ( $args[2] )
3249
    {
3250
        $links = $args[2] !~ m/nolink/i;
3251
        delete $args[2];
3252
    }
3253
 
3254
    # correct number of parameters?
3255
    my ($fref, $targetTag) = @_;
3256
    if ( $#args != 1 )
3257
    {
1534 dpurdie 3258
        Error("Incorrect number of params passed to " .
3259
              "installDpkgArchiveLibFile() function. " ,
3260
              "Check deploy config.");
1530 dpurdie 3261
    }
3262
 
3263
    #
3264
    # Check to see if the target tag exists
3265
    # If does not the process with log an error.
3266
    #
3267
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
3268
 
3269
    #
3270
    #   Process the file name
3271
    #   This will either be a scalar name, or a reference to an array of names
3272
    #   If the user has provided an array of names then expand the list
3273
    #
3274
    #   Convert $fref into an reference to a list
3275
    #
3276
    my @one_file;
3277
    unless ( ref ( $fref ) eq 'ARRAY' )
3278
    {
3279
        push @one_file, $fref;
3280
        $fref = \@one_file;
3281
    }
3282
 
1534 dpurdie 3283
    #
3284
    #   If the source file contains a pattern, then expand the pattern
3285
    #   This may result in multiple files.
3286
    #   Note: Allow for a single entry of the form
3287
    #           --Filterin=xxx,---FilterOut=yyy
3288
    #
1552 dpurdie 3289
    my $search =  LocateFiles->new(recurse => 0);
1534 dpurdie 3290
    my @flist;
3291
    foreach my $element ( @$fref )
1530 dpurdie 3292
    {
1534 dpurdie 3293
        foreach  ( split /,/ , $element )
3294
        {
3295
            if ( /^--FilterOut=(.*)/ ) {
1552 dpurdie 3296
                $search->filter_out( $1 );
1530 dpurdie 3297
 
1534 dpurdie 3298
            } elsif ( /^--FilterOutRE=(.*)/ ) {
1552 dpurdie 3299
                $search->filter_out_re( $1 );
1530 dpurdie 3300
 
1534 dpurdie 3301
            } elsif ( /^--FilterIn=(.*)/ ) {
1552 dpurdie 3302
                $search->filter_in( $1 );
1534 dpurdie 3303
 
3304
            } elsif ( /^--FilterInRE=(.*)/ ) {
1552 dpurdie 3305
                $search->filter_in_re( $1 );
1534 dpurdie 3306
 
3307
            } elsif ( m/^--/ ) {
3308
                Warning( "installDpkgArchiveLibFile: Unknown Filter option ignored: $_");
3309
 
3310
            } else {
3311
                push @flist, $_;
3312
            }
3313
        }
3314
    }
3315
 
3316
    #
3317
    #   If any patterns have been found, then expand them
3318
    #
1552 dpurdie 3319
    if ( $search->has_filter() )
1534 dpurdie 3320
    {
3321
        foreach my $i (@{$DpkgLibDirList{$select}})
3322
        {
1552 dpurdie 3323
            my @elements = $search->search( "$DpkgLibDir/$i" );
1534 dpurdie 3324
 
3325
            #
3326
            #   Clean off any leading / from each filename then add to a list
3327
            #   Remove any duplicates that were found
3328
            #
3329
            map { $_ =~ s~^/~~ } @elements;
3330
            UniquePush \@flist, @elements;
3331
        }
3332
    }
3333
 
3334
 
3335
    #
3336
    #   Process each file
3337
    #
3338
    foreach my $sfile ( @flist )
3339
    {
3340
 
1530 dpurdie 3341
        # we exclude .dll files if this is a sparc build
3342
        #
3343
        if ( "$MachType" eq "sparc"  &&
3344
             $sfile =~ m/\.dll/
3345
           )
3346
        {
1534 dpurdie 3347
            Verbose("Excluding item [$sfile] from build, as we do not deliver dlls for this machine type [$MachType].");
1530 dpurdie 3348
            return 1;
3349
        }
3350
 
3351
        # we exclude .so files if this is a win32 build
3352
        #
3353
        if ( "$MachType" eq "win32"  &&
3354
             $sfile =~ m/\.so/
3355
           )
3356
        {
1534 dpurdie 3357
            Verbose("Excluding item [$sfile] from build, as we do not deliver sosss for this machine type [$MachType].");
1530 dpurdie 3358
            return 1;
3359
        }
3360
 
3361
        my ($libName) = $sfile;
3362
        if ( "$MachType" eq "sparc" )
3363
        {
3364
            $libName =~ s/\.so.*$//;
3365
        }
3366
 
3367
        # lets define the absolute location of the file
3368
        my ($m_srcFileLocation) = "";
3369
        my ($m_dstFileLocation) = "";
3370
        my ($m_DpkgLibDir) = "";
3371
 
3372
        my ($i);
3373
        my ($j);
3374
        my ($count);
3375
        my ($foundFileFlag) = "false";
3376
        my ($ExcludedFlag) = "false";
3377
 
3378
        #
3379
        #   Search all the 'lib' locations, or a specified subset
3380
        #
1556 lkelly 3381
        my (@libDirList) = @{$DpkgLibDirList{$select}};
3382
        if ($installProdAndDebug)
1530 dpurdie 3383
        {
1556 lkelly 3384
            # we want to be able to search both prod and debug dirs. 
3385
            # we can just add them together here because the lib filenames
3386
            # are different (i.e. xxxD.so vs xxxP.so) and a P or D library 
3387
            # will only exist in one dir. i.e. P.so in prod dirs, D.so in debug dirs.
3388
            push @libDirList, @{$DpkgLibDirListAlternate{$select}};
3389
        }
1530 dpurdie 3390
 
1556 lkelly 3391
        foreach $i (@libDirList)
3392
        {
3393
 
1530 dpurdie 3394
            $m_DpkgLibDir = "$DpkgLibDir" . "/$i";
3395
            if ( ! -d "$m_DpkgLibDir" )
3396
            {
1534 dpurdie 3397
                Debug("Directory [$m_DpkgLibDir] not found.");
1530 dpurdie 3398
                next;
3399
            }
3400
 
1534 dpurdie 3401
 
1530 dpurdie 3402
            $m_srcFileLocation = "$m_DpkgLibDir/$sfile";
3403
            $m_dstFileLocation = "$targetValue/$sfile";
3404
 
3405
 
3406
            # we only want debug items in a debug build
1556 lkelly 3407
            # unless we are told to installProdAndDebug
3408
            if ( ( !$installProdAndDebug) && (excludeItemFromBuild($sfile)) )
1530 dpurdie 3409
            {
1534 dpurdie 3410
                Verbose("Excluding item [$sfile] from build as not compatible with build type [$BuildType].");
1530 dpurdie 3411
                $ExcludedFlag = "true";
3412
            }
3413
            else
3414
            {
3415
                # we need to ensure that only a single version/entry of the lib exists in the lib list
3416
                #
3417
                $count = 1;
3418
                foreach $j (@LibCheckList)
3419
                {
3420
                    if ( $j =~ m/^$libName$/ )
3421
                    {
3422
                        $count++;
3423
                    }
3424
 
3425
                    if ( $count > 1 )
3426
                    {
1534 dpurdie 3427
                        Error("Detected multiple references of lib [$libName] in lib list, check item [$sfile].");
1530 dpurdie 3428
                    }
3429
                }
3430
 
3431
                # we will check to see if the file exists.
3432
                #
3433
                if ( -f "$m_srcFileLocation" )
3434
                {
3435
                    # now we need to copy the file.
3436
 
3437
                    # we also want to create a generically named copy
1534 dpurdie 3438
                    # of the library. ie:
3439
                    #       libraryP.nn.nn.nn.dll -> library.dll, libraryP.dll
3440
                    #       libraryP.so.nn.nn.nn  -> library.so, libraryP.so
1530 dpurdie 3441
                    #
3442
                    my ($gName)    = $sfile;
3443
                    my ($nVerName) = $sfile;
3444
                    $gName = removeBuildTypeFromItemName($sfile);
3445
                    $gName = removeVersionNumberFromItemName($gName);
3446
                    $nVerName = removeVersionNumberFromItemName($sfile);
3447
 
3448
                    if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
3449
                    {
1534 dpurdie 3450
                        Verbose("Copied Lib [$sfile] to [$m_dstFileLocation] ...");
1530 dpurdie 3451
                        $foundFileFlag = "true";
3452
 
3453
                        if ( $links && ( "x$PkgPatchID" eq "x" || "$MachType" eq "win32") )
3454
                        {
3455
                            # normal build or if we are building win32 we want generic names
3456
 
3457
                            # we want to create a copy of our target using
1556 lkelly 3458
                            # the generic name (no version number)
1530 dpurdie 3459
                            if ( $sfile ne $nVerName )
3460
                            {
3461
                                createGenericCopy("$sfile", "$m_srcFileLocation", "$nVerName", "$targetValue");
3462
                            }
1556 lkelly 3463
                            # and another copy with no build type or version number.
1530 dpurdie 3464
                            if ( $sfile ne $gName )
3465
                            {
1556 lkelly 3466
                                # because this link doesn't have a P/D 
3467
                                # differentiator, we can only have one, so 
3468
                                # do this for the $BuildType file, but not any
3469
                                # $AlternateBuildType files
3470
                                if ( (!$installProdAndDebug) || ( $sfile =~ /$BuildType\./ ) )
3471
                                {
3472
                                    createGenericCopy("$sfile", "$m_srcFileLocation", "$gName",    "$targetValue");
3473
                                }
1530 dpurdie 3474
                            }
3475
                        }
3476
 
3477
 
3478
                        # lets add this lib to our check list for next time.
3479
                        #
3480
                        push @LibCheckList, $libName;
3481
 
3482
                        # no need to go further, implies we found the file!
3483
                        #
3484
                        last;
3485
                    }
3486
                    else
3487
                    {
3488
                        # here found the file but we had some trouble
3489
                        #
1534 dpurdie 3490
                        Error("Failed to copy lib [$m_srcFileLocation]: $!");
1530 dpurdie 3491
                    }
3492
 
3493
                }
3494
                # else have not found the file yet!
3495
            }
3496
        }
3497
 
3498
        # if we do not find the file at all we need to inform
3499
        # the user.
3500
        #
3501
        if ( "$foundFileFlag" eq "false" && $ExcludedFlag eq "false" )
3502
        {
1534 dpurdie 3503
            Error("Dpkg_archive lib file [$sfile] does not exist or is not in correct directory structure.");
1530 dpurdie 3504
        }
3505
    }
3506
 
3507
    return 1;
3508
}
3509
 
3510
 
3511
#------------------------------------------------------------------------------
3512
sub installPkgAddConfigFile
3513
#
3514
# Description:
3515
#       This sub-routine is used to install a package config file from a supplied
3516
#       source location to a predefined destination location that is based on
3517
#       the build type.
3518
#
3519
#       The sub routine also updates to the prototype file with an appropriate
3520
#       entry for the associated file.
1546 dpurdie 3521
# Inputs:
3522
#       sDirTag                 - Source directory tag
1554 dpurdie 3523
#                                 Or --Package=name,subdir
3524
#                                 Or --Interface=subdir
1546 dpurdie 3525
#       sfile                   - Source File Name [Mandatory]
3526
#       tfile                   - Not sure. Used in the prototype file.
3527
#                                 Suggest using the same name as sfile
1530 dpurdie 3528
#
3529
#       If it has any problems it will log an error and stop processing.
3530
#
3531
#------------------------------------------------------------------------------
3532
{
3533
    # correct number of parameters?
3534
    if ( ($#_+1) != 3 )
3535
    {
1534 dpurdie 3536
        Error("Incorrect number of params passed to " .
3537
              "installPkgAddConfigFile() function. " ,
3538
              "Check deploy config.");
1530 dpurdie 3539
    }
3540
 
3541
    # lets just check to see if we can execute this function on
3542
    # this machine.
3543
    #
3544
    if ( "$MachType" ne "sparc" )
3545
    {
1534 dpurdie 3546
        Verbose("installPkgAddConfigFile() not supported on this machine type.");
1530 dpurdie 3547
        return 1;
3548
    }
3549
 
3550
 
3551
    my ($sDirTag, $sfile, $tfile) = @_;
3552
 
3553
 
3554
    # we must have a filename.
3555
    #
1546 dpurdie 3556
    unless ( $sfile )
1530 dpurdie 3557
    {
1534 dpurdie 3558
        Error("Source filename not supplied. Check deploy config.");
1530 dpurdie 3559
    }
3560
 
3561
    # lets check to see if the local src dir tag exists
3562
    # if does not the process with log an error.
3563
    #
3564
    my ($sDirValue) = getLocalDirValue("$sDirTag", "A");
3565
 
3566
 
3567
    # lets check to see if the source file exists
3568
    #
3569
    if ( ! -f "$sDirValue/$sfile" )
3570
    {
1534 dpurdie 3571
        Error("Failed to find local source file [$sDirValue/$sfile].");
1530 dpurdie 3572
    }
3573
 
3574
    if ( ! -f "$ProtoTypeFile" )
3575
    {
1534 dpurdie 3576
        Error("Prototype file [$ProtoTypeFile] does not exist.",
3577
              "Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function.",
3578
              "Check deploy config.");
1530 dpurdie 3579
    }
3580
 
3581
 
3582
    # lets determine which prototype file we are going to
3583
    # use
3584
    my ($dFileName);
3585
    $dFileName     = "$PkgBaseDir/$sfile";
3586
 
3587
    # lets copy the file
3588
    #
3589
    if(File::Copy::copy("$sDirValue/$sfile", "$dFileName"))
3590
    {
1534 dpurdie 3591
        Verbose("Copied [$sfile] to [$dFileName] ...");
1530 dpurdie 3592
    }
3593
    else
3594
    {
1534 dpurdie 3595
        Error("Failed to copy local source file [$sDirValue/$sfile]: $!"); 
1530 dpurdie 3596
    }
3597
 
3598
 
3599
    # now we need to update the prototype file
3600
    #
3601
    local *FILE;
3602
    open ( FILE, ">> $ProtoTypeFile") or
1534 dpurdie 3603
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 3604
    printf FILE ("i $tfile=$sfile\n");
3605
    close (FILE);
3606
 
3607
 
3608
    return 1;
3609
}
3610
 
3611
 
3612
#------------------------------------------------------------------------------
3613
sub installPkgAddSystemClassFile
3614
#
3615
# Description:
3616
#       This sub-routine is used to install a package system class file from a supplied
3617
#       source location to a predefined destination location the class type is also 
3618
#       supplied and must be sed, awk, build or preserve
3619
#
3620
#       The sub routine also updates to the prototype file with an appropriate
3621
#       entry for the associated file.
3622
#
3623
#       If it has any problems it will log an error and stop processing.
3624
#
1554 dpurdie 3625
# Inputs:
3626
#       sDirTag                 - Source directory tag
3627
#                                 Or --Package=name,subdir
3628
#                                 Or --Interface=subdir
3629
#       sfile                   - Source File Name [Mandatory]
3630
#       tfile                   - Not sure. Used in the prototype file.
3631
#                                 Suggest using the same name as sfile
3632
#       class                   - Class Name
1530 dpurdie 3633
#------------------------------------------------------------------------------
3634
{
3635
    # correct number of parameters?
3636
    if ( ($#_+1) != 4 )
3637
    {
1534 dpurdie 3638
        Error("Incorrect number of params passed to " .
3639
              "installPkgAddConfigFile() function. " ,
3640
              "Check deploy config.");
1530 dpurdie 3641
    }
3642
 
3643
    # lets just check to see if we can execute this function on
3644
    # this machine.
3645
    #
3646
    if ( "$MachType" ne "sparc" )
3647
    {
1534 dpurdie 3648
        Verbose("installPkgAddConfigFile() not supported on this machine type.");
1530 dpurdie 3649
        return 1;
3650
    }
3651
 
3652
 
3653
    my ($sDirTag, $sfile, $tfile, $class) = @_;
3654
 
3655
    if ( $class ne "sed" && $class ne "build" && $class ne "awk" && $class ne "preserve" )
3656
    {
1534 dpurdie 3657
        Error("Class Name for System Class File can only be one of sed, build, awk or preserve");
1530 dpurdie 3658
    }
3659
 
3660
    # we must have a filename.
3661
    #
3662
    if ( "x$sfile" eq "x" )
3663
    {
1534 dpurdie 3664
        Error("Source filename not supplied. Check deploy config.");
1530 dpurdie 3665
    }
3666
 
3667
 
3668
    # lets check to see if the local src dir tag exists
3669
    # if does not the process with log an error.
3670
    #
3671
    my ($sDirValue) = getLocalDirValue("$sDirTag", "A");
3672
 
3673
 
3674
    # lets check to see if the source file exists
3675
    #
3676
    if ( ! -f "$sDirValue/$sfile" )
3677
    {
1534 dpurdie 3678
        Error("Failed to find local source file [$sDirValue/$sfile].");
1530 dpurdie 3679
    }
3680
 
3681
    if ( ! -f "$ProtoTypeFile" )
3682
    {
1534 dpurdie 3683
        Error("Prototype file [$ProtoTypeFile] does not exist.",
3684
              "Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function.",
3685
              "Check deploy config.");
1530 dpurdie 3686
    }
3687
 
3688
 
3689
    # lets determine which prototype file we are going to
3690
    # use
3691
    my ($dFileName);
3692
    $dFileName     = "$PkgBaseDir/$sfile";
3693
 
3694
    # lets copy the file
3695
    #
3696
    if(File::Copy::copy("$sDirValue/$sfile", "$dFileName"))
3697
    {
1534 dpurdie 3698
        Verbose("Copied [$sfile] to [$dFileName] ...");
1530 dpurdie 3699
    }
3700
    else
3701
    {
1534 dpurdie 3702
        Error("Failed to copy local source file [$sDirValue/$sfile]: $!"); 
1530 dpurdie 3703
    }
3704
 
3705
 
3706
    # now we need to update the prototype file
3707
    #
3708
    local *FILE;
3709
    open ( FILE, ">> $ProtoTypeFile") or
1534 dpurdie 3710
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 3711
    printf FILE ("e $class $tfile=$sfile ? ? ?\n");
3712
    close (FILE);
3713
 
3714
 
3715
    return 1;
3716
}
3717
 
3718
 
3719
 
3720
#------------------------------------------------------------------------------
3721
sub updatePrototypeFileAddItem
3722
#
3723
# Description:
3724
#       This sub-routine is used to update the prototype file with an
3725
#       extra package add item. Here we pre-pend the ERGAFC_BASEDIR to the
3726
#       destination item.
3727
#
3728
#       The only item type we support at this stage are "s" and "f" types.
3729
#
3730
#       You also need to supply the source tag, destination tag, user id, group id 
3731
#       and permissions associated to this item.
3732
#
3733
#       If it has any problems it will log an error and stop processing.
3734
#
3735
#------------------------------------------------------------------------------
3736
{
3737
    # correct number of parameters?
3738
    if ( ($#_+1) != 6 )
3739
    {
1534 dpurdie 3740
        Error("Incorrect number of params passed to " .
3741
              "updatePrototypeFileAddItem() function. " ,
3742
              "Check deploy config.");
1530 dpurdie 3743
    }
3744
 
3745
 
3746
    # lets just check to see if we can execute this function on
3747
    # this machine.
3748
    #
3749
    if ( "$MachType" ne "sparc" )
3750
    {
1534 dpurdie 3751
        Verbose("updatePrototypeFileAddItem() not supported on this machine type.");
1530 dpurdie 3752
        return 1;
3753
    }
3754
 
3755
    my ($sTag, $dTag, $perms, $uid, $gid, $type) = @_;
3756
 
3757
    # lets determine which prototype file we are going to
3758
    # use
3759
    my ($protoTypeFile);
3760
    $protoTypeFile = "$ProtoTypeFile";
3761
 
3762
 
3763
    # lets check the valid types
3764
    $type = uc($type);
3765
    if ( "$type" !~ /S/ )
3766
    {
1534 dpurdie 3767
        Error("Invalid type field supplied in updatePrototypeFileAddItem(). Check deploy config.");
1530 dpurdie 3768
    }
3769
 
3770
    # now we need to update the prototype file
3771
    #
3772
    local *FILE;
3773
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 3774
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3775
 
3776
    my($m_Str)=""; 
3777
    if ( "$type" eq "S" )
3778
    {
3779
        $m_Str = "s none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";
1534 dpurdie 3780
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3781
    }
3782
    else
3783
    {
3784
        $m_Str = "f none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";
1534 dpurdie 3785
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3786
    }
3787
    printf FILE ("$m_Str\n");
3788
    close (FILE);
3789
 
3790
    return 1;
3791
}
3792
 
3793
 
3794
#------------------------------------------------------------------------------
3795
sub updatePrototypeFileAddItem2
3796
#
3797
# Description:
3798
#       This sub-routine is used to update the prototype file with an
3799
#       extra package add item. Here we do not pre-append the 
3800
#       ERGAFC_BASEDIR to the destination item.
3801
#
3802
#       The only item type we support at this stage are "s", "i" and "e" types.
3803
#
3804
#       You also need to supply the source tag, destination tag, user id, group id 
3805
#       and permissions associated to this item.
3806
#
3807
#       If it has any problems it will log an error and stop processing.
3808
#
3809
#------------------------------------------------------------------------------
3810
{
3811
    # correct number of parameters?
3812
    if ( ($#_+1) != 6 && ($#_+1) != 7 )
3813
    {
1534 dpurdie 3814
        Error("Incorrect number of params passed to " .
3815
              "updatePrototypeFileAddItem2() function. " ,
3816
              "Check deploy config.");
1530 dpurdie 3817
    }
3818
 
3819
 
3820
    # lets just check to see if we can execute this function on
3821
    # this machine.
3822
    #
3823
    if ( "$MachType" ne "sparc" )
3824
    {
1534 dpurdie 3825
        Verbose("updatePrototypeFileAddItem2() not supported on this machine type.");
1530 dpurdie 3826
        return 1;
3827
    }
3828
 
3829
    # class must be last as it is optional
3830
    my ($sTag, $dTag, $perms, $uid, $gid, $type, $class) = @_;
3831
 
3832
    $class = "none" if ( ($#_+1) == 6 );
3833
 
3834
    # lets determine which prototype file we are going to
3835
    # use
3836
    my ($protoTypeFile);
3837
    $protoTypeFile = "$ProtoTypeFile";
3838
 
3839
    # lets check the valid types
3840
    $type = uc($type);
3841
    if ( "$type" !~ /S/ && "$type" !~ /I/ && "$type" !~ /E/ )
3842
    {
1534 dpurdie 3843
        Error("Invalid type field supplied in updatePrototypeFileAddItem2(). Check deploy config.");
1530 dpurdie 3844
    }
3845
 
3846
    # now we need to update the prototype file
3847
    #
3848
    local *FILE;
3849
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 3850
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3851
 
3852
    my($m_Str)="";
3853
    if ( "$type" eq "S" )
3854
    {
3855
        $m_Str = "s $class $sTag=$dTag $perms $uid $gid";
1534 dpurdie 3856
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3857
    }
3858
    elsif ( "$type" eq "E" )
3859
    {
3860
        $m_Str = "e $class $sTag=$dTag $perms $uid $gid";
1534 dpurdie 3861
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3862
    }
3863
    else
3864
    {
3865
        $m_Str = "i $sTag=$dTag";
1534 dpurdie 3866
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3867
    }
3868
    printf FILE ("$m_Str\n");
3869
    close (FILE);
3870
 
3871
    return 1;
3872
}
3873
 
3874
 
3875
#------------------------------------------------------------------------------
3876
sub addPath2Prototype
3877
#
3878
# Description:
3879
#       This sub-routine is used to add directory entries to the prototype file
3880
#   to make sure the supplied path exists in the prototype file
3881
#
3882
#------------------------------------------------------------------------------
3883
{
3884
    # lets just check to see if we can execute this function on
3885
    # this machine.
3886
    #
3887
    if ( "$MachType" ne "sparc" )
3888
    {
1534 dpurdie 3889
        Verbose("addPath2Prototype() not supported on this machine type.");
1530 dpurdie 3890
        return 1;
3891
    }
3892
 
3893
    # class must be last as it is optional
3894
    my ($path, $perms, $uid, $gid, $class) = @_;
3895
 
3896
    # set defaults if not supplied
3897
    $perms  = "?"       if ( ($#_+1) < 2 );
3898
    $uid    = "?"       if ( ($#_+1) < 3 );
3899
    $gid    = "?"       if ( ($#_+1) < 4 );
3900
    $class  = "none"    if ( ($#_+1) < 5 );
3901
 
1534 dpurdie 3902
    Information("addPathToPrototype adding path [$path $perms $uid $gid $class]");
1530 dpurdie 3903
 
3904
    # lets determine which prototype file we are going to
3905
    # use
3906
    my ($protoTypeFile);
3907
    $protoTypeFile = "$ProtoTypeFile";
3908
 
3909
    # now we need to update the prototype file
3910
    #
3911
    local *FILE;
1534 dpurdie 3912
    open ( FILE, "+<$protoTypeFile") or Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3913
 
3914
    # set up has of all paths to be added
3915
    my ( %pathDirs );
3916
    my ( $workPath );
3917
    my ( $i );
3918
 
3919
    $workPath = "/" if ( $path =~ s|^/|| );
3920
    foreach $i ( split("/" , $path) )
3921
    {
3922
        $workPath .= $i;
3923
        $pathDirs{$workPath} = 1;
3924
        $workPath .= "/";
3925
    }
3926
 
3927
    while ( <FILE> )
3928
    {
3929
        # lets get all the current dir entries and check for duplicates
3930
        #        class   path    mode    owner   group
3931
        if ( /^d ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)/ )
3932
        {
3933
            # if this dir entry is defined in our paths to add we need to remove the entry
3934
            if ( defined($pathDirs{$2}) )
3935
            {
1534 dpurdie 3936
                Warning("addPath2Prototype: Path [$2] already exists in prototype file");
1530 dpurdie 3937
                delete($pathDirs{$2});
3938
            }
3939
        }
3940
    }
3941
 
3942
    my $protoLine;
3943
    # now we write the remaining dirs in the hash 
3944
    foreach $i ( sort keys(%pathDirs) )
3945
    {
3946
        $protoLine = sprintf("d %s %s %s %s %s", $class, $i, $perms, $uid, $gid);
1534 dpurdie 3947
        Verbose("addPath2Prototype: Adding Dir entry [$protoLine]");
1530 dpurdie 3948
        printf FILE "$protoLine\n"; 
3949
    }
3950
 
3951
    close FILE;
3952
    return 1;
3953
}
3954
 
3955
 
3956
#------------------------------------------------------------------------------
3957
sub createAfcRcScriptLink
3958
#
3959
#    Description:
3960
#        This sub-routine is used to create links into /afc/rc.d for start & stop 
3961
#         scripts.
3962
#
3963
#    INPUT:
3964
#        Start prefix number (2 digit number)
3965
#        Stop prefix Number (2 digit Number)
3966
#        Full path to script to create link to.
3967
#
3968
#------------------------------------------------------------------------------
3969
{
3970
    # correct number of parameters?
3971
    if ( ($#_+1) != 3 )
3972
    {
1534 dpurdie 3973
        Error("Incorrect number of params passed to " .
3974
              "createAfcRcScriptLink() function. " ,
3975
              "Check deploy config.");
1530 dpurdie 3976
    }
3977
 
3978
 
3979
    # lets just check to see if we can execute this function on
3980
    # this machine.
3981
    #
3982
    if ( "$MachType" ne "sparc" )
3983
    {
1534 dpurdie 3984
        Verbose("createAfcRcScriptLink() not supported on this machine type.");
1530 dpurdie 3985
        return 1;
3986
    }
3987
 
3988
    my ($startPrefix, $stopPrefix, $scriptPath) = @_;
3989
 
3990
    if ( $startPrefix ne "" )
3991
    {
3992
        updatePrototypeFileAddItem2(sprintf("/afc/rc.d/S%02d%s", $startPrefix, $PkgName), 
3993
                                    $scriptPath, "0755", "root", "other", "S");
3994
    }
3995
    if ( $stopPrefix ne "" )
3996
    {
3997
        updatePrototypeFileAddItem2(sprintf("/afc/rc.d/K%02d%s", $stopPrefix, $PkgName), 
3998
                                    $scriptPath, "0755", "root", "other", "S");        
3999
    }
4000
}
4001
 
4002
 
4003
#------------------------------------------------------------------------------
4004
sub createAfcRcScriptLink2
4005
#
4006
#    Description:
4007
#        This sub-routine is used to create links into the afc rc.d for start & stop 
4008
#        scripts.  It differs from the original in that you pass a TargetDirType
4009
#        parameter and the filename instead of a full path.  It then creates a relative
4010
#        link from $BASEDIR/rc.d to TargetBaseDir
4011
#
4012
#    INPUT:
4013
#        Start prefix number (2 digit number)
4014
#        Stop prefix Number (2 digit Number)
4015
#        Full path to script to create link to.
4016
#
4017
#------------------------------------------------------------------------------
4018
{
4019
    # correct number of parameters?
4020
    if ( ($#_+1) != 4 )
4021
    {
1534 dpurdie 4022
        Error("Incorrect number of params passed to " .
4023
              "createAfcRcScriptLink() function. " ,
4024
              "Check deploy config.");
1530 dpurdie 4025
    }
4026
 
4027
 
4028
    # lets just check to see if we can execute this function on
4029
    # this machine.
4030
    #
4031
    if ( "$MachType" ne "sparc" )
4032
    {
1534 dpurdie 4033
        Verbose("createAfcRcScriptLink() not supported on this machine type.");
1530 dpurdie 4034
        return 1;
4035
    }
4036
 
4037
    my ($startPrefix, $stopPrefix, $targetTag, $scriptPath) = @_;
4038
 
4039
    # lets check to see if the target tag exists if does not the process with log an error.
4040
    my ($targetValue) = getTargetDstDirValue($targetTag, "R");
4041
 
4042
    if ( $startPrefix ne "" )
4043
    {
4044
        updatePrototypeFileAddItem2(sprintf("rc.d/S%02d%s", $startPrefix, $PkgName), 
4045
                                    "../$targetValue/$scriptPath", "0755", "root", "other", "S");
4046
    }
4047
    if ( $stopPrefix ne "" )
4048
    {
4049
        updatePrototypeFileAddItem2(sprintf("rc.d/K%02d%s", $stopPrefix, $PkgName), 
4050
                                    "../$targetValue/$scriptPath", "0755", "root", "other", "S");        
4051
    }
4052
}
4053
 
4054
 
4055
#------------------------------------------------------------------------------
4056
sub createGenericCopy
4057
#
4058
#    Description:
4059
#        This sub-routine is used to create a generic copy of a specific item.
4060
#
4061
#        On sparc this will be a link, but on win32 it will be a file based on the
4062
#        buildType.
4063
#
4064
#    INPUT:
1556 lkelly 4065
#        sName = src item name without path
4066
#        sLoc = src item name including path
4067
#        gName = generic item name
4068
#        tDir = target dir
1530 dpurdie 4069
#
4070
#    RETURN:
4071
#         1
4072
#
4073
#------------------------------------------------------------------------------
4074
{
4075
    my ($sName, $sLoc, $gName, $tDir) = @_;
4076
 
4077
    my ($cmd);
4078
    my ($retVal);
4079
    if ( "$MachType" eq "sparc" )
4080
    {
4081
        # I want to cd into the tDir and then create the link.
4082
        # only if an item of the same name does not already exist
4083
        #
4084
        if ( ! -f "$tDir/$gName" )
4085
        {
4086
            $cmd = "cd $tDir; ln -s $sName $gName";
4087
            $retVal = system("$cmd");
4088
            if ( $retVal != 0 )
4089
            {
1534 dpurdie 4090
                Error("Failed to create generic link [$gName] to [$tDir/$sName]: $retVal");
1530 dpurdie 4091
            }
4092
            else
4093
            {
1534 dpurdie 4094
                Verbose("Created generic link [$gName] to [$tDir/$sName] ...");
1530 dpurdie 4095
            }
4096
        }
4097
    }
4098
    else
4099
    {
4100
 
4101
        # we only create a generic copy of the an item that matches
4102
        # our build type.  (i.e. if we are building a debug package then
4103
        # only the debug items shall be considered.
4104
        #
4105
        if ( "$BuildType" eq "D" )
4106
        {
4107
            if ( $sName !~ /D\./ )
4108
            {
4109
                # this item is not a debug one.
4110
                return 1;
4111
            }
4112
        }
4113
        else
4114
        {
4115
            # this is prod build
4116
            if ( $sName !~ /P\./ )
4117
            {
4118
                # this item is not a prod one.
4119
                return 1;
4120
            }
4121
        }
4122
 
4123
 
4124
        # we have a match, lets create the copy.
4125
        #
4126
        if(File::Copy::copy("$sLoc", "$tDir/$gName"))
4127
        {
1534 dpurdie 4128
            Verbose("Created generic lib copy [$tDir/$gName]...");
1530 dpurdie 4129
        }
4130
        else
4131
        {
1534 dpurdie 4132
            Error("Failed to create generic lib copy [$gName] from [$sLoc]: $!");
1530 dpurdie 4133
        }
4134
    }
4135
 
4136
    return 1;
4137
}
4138
 
4139
 
4140
 
4141
#------------------------------------------------------------------------------
4142
sub removeVersionNumberFromItemName
4143
#
4144
#    Description:
4145
#        This sub-routine is used to remove the version number from the item name.
4146
#        i.e.  myFile.so.1.2.3 ==> myFile.so
4147
#
4148
#    INPUT:
4149
#        item name
4150
#
4151
#    RETURN:
4152
#        new item name.
4153
#
4154
#------------------------------------------------------------------------------
4155
{
4156
    my ($file) = @_;
4157
 
4158
    my ($nfile) = $file;
4159
 
4160
    if ( "$MachType" eq "sparc" )
4161
    {
4162
        $nfile =~ s/\.so.*$/\.so/;
4163
    }
4164
    else
4165
    {
4166
        $nfile =~ s/\.[0-9]+\.[0-9]+.*dll$/\.dll/;
4167
    }
4168
    return "$nfile";
4169
}
4170
 
4171
 
4172
#------------------------------------------------------------------------------
4173
sub excludeItemFromBuild
4174
#
4175
#    Description:
4176
#        This sub-routine is used to determine is a item is to be included in
4177
#        a build based on the current build type and the extension 
4178
#        it SHOULD HAVE!.
4179
#
4180
#        i.e. debug files will be tagged with *D.* 
4181
#             prod  file will be tagged with *P.*
4182
#
4183
#        if the item does not have a *D.* or a *P.* we included it by default.
4184
#
4185
#        INPUT:
4186
#              filename
4187
#
4188
#        RETURN: 
4189
#              1  - exclude 
4190
#              0  - include 
4191
#
4192
#------------------------------------------------------------------------------
4193
{
4194
    my ($file) = @_;
4195
 
4196
    # we only want to deliver
4197
    if ( "$MachType" eq "win32" )
4198
    {
4199
        # we have to include it by default.
4200
        return 0;
4201
    }
4202
 
4203
 
4204
    #######################################################
4205
    #######################################################
4206
    #######################################################
4207
    # Third party packages do not adhere to the *D.* *P.*
4208
    # conventions of debug and production builds.
4209
    #
4210
    # Hopefully we won't have to many of these, only found 
4211
    # one so far.
4212
    # 
4213
    #######################################################
4214
    #######################################################
4215
    #######################################################
4216
    if ( $file =~ /libTAO_BiDirGIOP\.so/ )
4217
    {
4218
        return 0;
4219
    } 
4220
 
4221
    if ( $file !~ /D\./ &&
4222
         $file !~ /P\./
4223
       )
4224
    {
4225
        # we have to include it by default. 
4226
        return 0;
4227
    }
4228
 
4229
 
4230
    # we only want to deliver 
4231
    if ( "$BuildType" eq "D" )
4232
    { 
4233
        if ( $file !~ /D\./ )
4234
        {
4235
            # we do not want this file for this build type.
4236
            return 1;
4237
        }
4238
        else
4239
        {
4240
            return 0;
4241
        }
4242
    }
4243
    else
4244
    {
4245
        if ( $file !~ /P\./ )
4246
        {
4247
            # we do not want this file for this build type.
4248
            return 1;
4249
        }
4250
        else
4251
        {
4252
            return 0;
4253
        }
4254
    }
4255
 
4256
    return 1;
4257
}
4258
 
4259
 
4260
#------------------------------------------------------------------------------
4261
sub installAllDpkgArchiveBinFiles
4262
#
4263
# Description:
4264
#       This sub-routine is used to install all bin files from the
4265
#       dpkg_archive into the defined install area.
4266
#
4267
#       It assumes based on the build type where the src files will be located.
4268
#
4269
#       If it has any problems it will log an error and stop processing.
4270
#
4271
#------------------------------------------------------------------------------
4272
{
4273
    # correct number of parameters?
4274
    if ( ($#_+1) != 1 )
4275
    {
1534 dpurdie 4276
        Error("Incorrect number of params passed to " .
4277
              "installAllDpkgArchiveBinFiles() function. " ,
4278
              "Check deploy config.");
1530 dpurdie 4279
    }
4280
 
4281
    my ($targetTag) = @_;
4282
 
4283
    # lets check to see if the target tag exists
4284
    # if does not the process with log an error.
4285
    #
4286
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
4287
 
4288
 
4289
    # ok we have a valid dst value we now need to get a hold of all the 
4290
    # lib files for this buildtype
4291
    #
4292
    my ($i);
4293
    my ($m_DpkgBinDir);
4294
    foreach $i (@{$DpkgBinDirList{'_ALL_'}})
4295
    {
1534 dpurdie 4296
        $m_DpkgBinDir = "$DpkgBinDir/$i";
4297
        if ( ! -d $m_DpkgBinDir )
1530 dpurdie 4298
        {
1534 dpurdie 4299
            Verbose("Directory [$m_DpkgBinDir] not found.");
1530 dpurdie 4300
            next;
4301
        }
4302
 
4303
        local *DIR;
4304
        opendir(DIR, $m_DpkgBinDir) or 
1534 dpurdie 4305
            Error("can't opendir $m_DpkgBinDir : $!");
1530 dpurdie 4306
 
4307
        my ($file);
4308
        while (defined($file = readdir(DIR))) 
4309
        {
4310
            if ( $file !~ /^\.$/  &&     # we do not want the . and .. entries.
4311
                 $file !~ /^\.\.$/ &&
4312
                 $file !~ /\.pdb$/ )
4313
            {
4314
                my ($m_fLoc) = "$m_DpkgBinDir/$file"; 
4315
                if(File::Copy::copy("$m_fLoc", "$targetValue"))
4316
                {
1534 dpurdie 4317
                    Verbose("Copied [$file] to [$targetValue] ...");
1530 dpurdie 4318
                }
4319
                else
4320
                {
1534 dpurdie 4321
                    Error("Failed to copy bin [$m_fLoc]: $!"); 
1530 dpurdie 4322
                }
4323
            }
4324
        }
4325
        closedir(DIR);
4326
    }
4327
 
4328
    return 1;
4329
}
4330
 
4331
 
4332
#------------------------------------------------------------------------------
4333
sub rmDirectory
4334
#
4335
# Description:
4336
#       This sub-routine is used to remove an entire directory tree.
4337
#
4338
#       It recurses from a starting point removing each item and if it
4339
#       finds a dir it recurses into that dir cleaning it as well.
4340
#
4341
#------------------------------------------------------------------------------
4342
{
4343
    # correct number of parameters?
4344
    if ( ($#_+1) != 1  )
4345
    {
1534 dpurdie 4346
        Error("Incorrect number of params passed to rmDirectory() function.");
1530 dpurdie 4347
    }
4348
 
4349
    my ($startingPoint) = @_;
1548 dpurdie 4350
    return 0 unless ( -d $startingPoint );
1534 dpurdie 4351
    Verbose("Recursively removing Directory tree [$startingPoint]");
1530 dpurdie 4352
 
4353
    #
1542 dpurdie 4354
    #   Use the rmtree function
4355
    #   It works better than glob when given a filepath with spaces
4356
    #
4357
    rmtree($startingPoint, IsVerbose(1), 1);
4358
    Error("Failed to remove dir [$startingPoint] : $!") if (-d $startingPoint);
4359
 
1530 dpurdie 4360
    return 1;
4361
}
4362
 
4363
#------------------------------------------------------------------------------
4364
sub CreateTargetDirStructure
4365
#
4366
# Description:
4367
#       This sub-routine create the target stucture based on what the user has
4368
#       previously defined in the %TargetDstDirStructure hash array
4369
#
4370
#       It will also clean the contents of this location prior to creation.
4371
#
4372
#       In this function we also check to see if all the LocalSrcDirStructure
4373
#       directories exist. We warn if they do not.
4374
#
4375
#------------------------------------------------------------------------------
4376
{
1534 dpurdie 4377
    Information("Cleaning any previous target file items...");
1530 dpurdie 4378
 
4379
    my ($i);
1570 gchristi 4380
    my $dirRoot;
1554 dpurdie 4381
    #   Clean out PkgBaseDir
4382
    #   This is the directory in which the final package image will be assembled
4383
    #   Recreate the directory. Ensure that it does not have setgid on the directory
4384
    #   as this will affect all the subdirectories that are created and will
4385
    #   propergate into the target package.
1530 dpurdie 4386
    #
1554 dpurdie 4387
    rmDirectory( $PkgBaseDir );
4388
    make_directory( $PkgDir, 0777, "Create target base dir");
1530 dpurdie 4389
 
4390
    # lets create.
4391
    #
1534 dpurdie 4392
    Information ("Creating target directory structure...");
1570 gchristi 4393
 
4394
    $dirRoot = ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir;
4395
    make_directory( $dirRoot, 0777, "Create target dir");
4396
 
1530 dpurdie 4397
    foreach $i ( sort {$a cmp $b} values %TargetDstDirStructure )
4398
    {
1570 gchristi 4399
        make_directory("$dirRoot/$i", 0777);
1530 dpurdie 4400
    }
4401
 
4402
 
4403
    # lets determine if we have a InstallShield config dir
4404
    #
4405
    if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" )
4406
    {
4407
 
4408
        # if this is a patch build i expect to find a "p" in the front of the
4409
        # file names. we use this as a simple visual differentiation.
4410
        #
4411
        my ($m_ishieldDir);    
4412
        my ($m_ishieldProjFile);
4413
        if ( "x$PkgPatchNum" ne "x" )
4414
        {
4415
            # patch build.
4416
            $m_ishieldDir      = "$RootDir/" . "p$PkgName";
4417
            $m_ishieldProjFile = "$RootDir/" . "p$PkgName" . ".ism";
4418
        }
4419
        else
4420
        {
4421
            # normal build.
4422
            $m_ishieldDir      = "$RootDir/" . "$PkgName";
4423
            $m_ishieldProjFile = "$RootDir/" . "$PkgName" . ".ism";
4424
        }
4425
 
4426
        # here i can set the location of my IShield project dir
4427
        # so i can use it later if required.
4428
        $PKG_ISHIELD_DIR = $m_ishieldDir;
4429
 
4430
 
4431
        # we check for an ism file based on the pkg name
4432
        # if we find one we need to deal with the dir and
4433
        # the isheildlib files.
4434
        #
4435
        if ( -f "$m_ishieldProjFile" )
4436
        {
4437
            if ( ! -d "$m_ishieldDir" )
4438
            {
1534 dpurdie 4439
                Error ("Local InstallShield config dir [$m_ishieldDir] does not exist.",
4440
                       "Please create before continuing.");
1530 dpurdie 4441
            }
4442
            else
4443
            {
4444
                # we populate the ishield config dir with the ishieldlib files
4445
                #
4446
                my ($i);
1534 dpurdie 4447
                Verbose("Installing Standard ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");
1530 dpurdie 4448
                foreach $i ( @PKG_ISHIELD_FILES )
4449
                {
4450
                    # first we remove the file (as previously it install read-only).
4451
                    unlink("$m_ishieldDir/$i");
4452
                    if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") )
4453
                    {
1534 dpurdie 4454
                        Verbose("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");
1530 dpurdie 4455
                    }
4456
                    else
4457
                    {
1534 dpurdie 4458
                        Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");
1530 dpurdie 4459
                    }
4460
                }
4461
 
4462
 
4463
                # we also want to deliver the patch rule files
4464
                # if this build is a patch build.
4465
                #
4466
                if ( "x$PkgPatchNum" ne "x" )
4467
                {
1534 dpurdie 4468
                    Verbose("Installing Patch ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");
1530 dpurdie 4469
                    foreach $i ( @PATCH_ISHIELD_FILES )
4470
                    {
4471
                        # first we remove the file (as previously it install read-only).
4472
                        unlink("$m_ishieldDir/$i");
4473
                        if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") )
4474
                        {
1534 dpurdie 4475
                            Verbose("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");
1530 dpurdie 4476
                        }
4477
                        else
4478
                        {
1534 dpurdie 4479
                            Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");
1530 dpurdie 4480
                        }
4481
                    }
4482
                }
4483
 
4484
 
4485
                # we also want to deliver the islib imgages to be
4486
                # used by this project, we assume the image has a project
4487
                # acronym prefix, and if not found we just WARN the user
4488
                #
4489
                # we assume our source dir is the interface/etc dir and our
4490
                # dst dir is the PkgBaseDir
4491
                #
4492
                my ($m_islibImgFile) = "";
1534 dpurdie 4493
                Verbose("Installing ishield image files from [$DpkgEtcDir] to [$m_ishieldDir]");
1530 dpurdie 4494
                foreach $i ( @PKG_ISHIELD_IMG_FILES )
4495
                {
4496
                    $m_islibImgFile = "$DpkgEtcDir/$ProjectAcronym" . "_" . $i;
4497
                    if ( -f "$m_islibImgFile" )
4498
                    {
4499
                        if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") )
4500
                        {
1534 dpurdie 4501
                            Verbose("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");
1530 dpurdie 4502
                        }
4503
                        else
4504
                        {
1534 dpurdie 4505
                            Error("Failed to copy info file [$m_islibImgFile] to " .
1530 dpurdie 4506
                                     "[$PkgBaseDir] : $!");
4507
                        }
4508
                    }
4509
                    else
4510
                    {
4511
                        # we shall check for the MASS items, if the exist we copy them
4512
                        # over. Here we assume the 'mas' acronymn is correct.
4513
                        #
4514
                        $m_islibImgFile = "$DpkgEtcDir/mas" . "_" . $i;
4515
                        if ( -f "$m_islibImgFile" )
4516
                        {
4517
                            if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") )
4518
                            {
1534 dpurdie 4519
                                Verbose("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");
1530 dpurdie 4520
                            }
4521
                            else
4522
                            {
1534 dpurdie 4523
                                Error("Failed to copy info file [$m_islibImgFile] to " .
1530 dpurdie 4524
                                         "[$PkgBaseDir] : $!");
4525
                            } 
4526
                        } 
4527
                        else
4528
                        {
1534 dpurdie 4529
                            Warning("Failed to locate ishieldlib image [xxx_$i], no image copied, " .
1530 dpurdie 4530
                                    "check depolylib config.");
4531
                        }
4532
                    }
4533
                }
4534
 
4535
            }
4536
        }
4537
        else
4538
        {
1534 dpurdie 4539
            Warning("Did not detect InstallShield project file [$m_ishieldProjFile]");
4540
            Warning("Not installing InstallShield library files.");
1530 dpurdie 4541
        }
4542
    }
4543
 
4544
    # done.
4545
    return 1;
4546
}
4547
 
4548
#------------------------------------------------------------------------------
4549
sub generateIShieldIncludeFile ()
4550
#
4551
# Description:
4552
#     This subroutine is used to generate a definition include file 
4553
#     that is used during IShield builds.
4554
#
4555
#     The output location of the file is the IShieldProjDir.
4556
#    
4557
#------------------------------------------------------------------------------
4558
{
4559
    my ($outFile) = "$PKG_ISHIELD_DIR/$PKG_ISHIELD_DEF_FILE";
4560
 
4561
    # this is only relavent for win32 builds.
4562
    if ( "$MachType" eq "sparc" )
4563
    {
4564
        return 1;
4565
    }
4566
 
4567
    # lets open the file.
4568
    #
4569
    local *FILE;
4570
    open ( FILE, "> $outFile") or
1534 dpurdie 4571
        Error("Failed to open file [$outFile].");
1530 dpurdie 4572
 
4573
    # lets populate the pkgdef file.
4574
 
4575
    printf FILE ("// This is an automatically generated include file.\n");
4576
    printf FILE ("// Please do not modify, and please do not check into ClearCase.\n");
4577
    printf FILE ("//\n");
4578
    printf FILE ("#define PKG_NAME         \"$PkgName\"\n");
4579
    printf FILE ("#define PKG_NAMELONG     \"$PkgNameLong\"\n");
4580
    printf FILE ("#define PKG_VERSION      \"$PkgVersion\"\n");
4581
    printf FILE ("#define PKG_BUILDNUM     \"$PkgBuildNum\"\n");
4582
    printf FILE ("#define PKG_PROJACRONYM  \"$ProjectAcronym\"\n");
4583
    printf FILE ("#define PKG_DESC         \"$PkgDesc\"\n");
4584
 
4585
    # if this build is a patch build.
4586
    #
4587
    if ( "x$PkgPatchNum" ne "x" )
4588
    {
4589
        printf FILE ("#define PATCH_NAME       \"$PkgPatchName\"\n");
4590
        printf FILE ("#define PATCH_NUM        \"$PkgPatchNum\"\n");
4591
        printf FILE ("#define PATCH_ID         \"$PkgPatchID\"\n");
4592
    }
4593
    else
4594
    {
4595
        printf FILE ("#define PATCH_NAME       \"\"\n");
4596
        printf FILE ("#define PATCH_NUM        \"\"\n");
4597
        printf FILE ("#define PATCH_ID         \"\"\n");
4598
    }
4599
 
4600
    # lets close the file
4601
    close FILE;
4602
 
4603
    # done.
4604
    return 1;
4605
}
4606
 
4607
 
4608
#------------------------------------------------------------------------------
4609
sub ValidateLocalSrcDirStructure
4610
#
4611
# Description:
4612
#       This sub-routine is used to check the existence the local dir 
4613
#       configuration items, these are stored in 
4614
#       %LocalSrcDirStructure.
4615
#
4616
#------------------------------------------------------------------------------
4617
{
4618
    # lets check the configured local direcotry structure
4619
    #
4620
    my ($i);
4621
    foreach $i ( values %LocalSrcDirStructure )
4622
    {
4623
        my ($m_Dir) = "$SrcDir/$i";
4624
        if ( ! -d "$m_Dir" )
4625
        {
1534 dpurdie 4626
            Warning ("Local src dir [$m_Dir] does not exist.");
1530 dpurdie 4627
        }
4628
    }
4629
 
4630
    return 1;
4631
}
4632
 
4633
 
4634
#------------------------------------------------------------------------------
4635
sub getLocalDirValue
4636
#
4637
# Description:
4638
#       This sub-routine is used to return the local dir value from
4639
#       %LocalSrcDirStructure based on providing the 
4640
#       associated key.
4641
#
1546 dpurdie 4642
#
4643
# Input:
4644
#       m_key               - A symbolic directory name to be found in the
4645
#                             LocalSrcDirStructure
4646
#
4647
#                             A Package Name of the form
4648
#                             --Package=PackageName,subdir
4649
#
4650
#                             A directory within the interface directory
4651
#                             --Interface=subdir
4652
#
4653
#                             This form is only valid for an ABS address
4654
#
4655
#       m_type              - "A"   Absolute address
4656
#                             else  Relative address
4657
#
1530 dpurdie 4658
#       If the value does not exist then it will return an error
4659
#       and terminate processing.
4660
#
4661
#------------------------------------------------------------------------------
4662
{
4663
    # correct number of parameters?
4664
    if ( ($#_+1) != 2 ) 
4665
    {
1534 dpurdie 4666
        Error("Incorrect number of params passed to " .
1530 dpurdie 4667
                  "getLocalDirValue() function.");
4668
    }
4669
 
4670
    my ($m_key, $m_type) = @_;
1546 dpurdie 4671
 
4672
    #
4673
    #   Determine the type of lookup
4674
    #
4675
    if ( $m_key =~ m~^--Interface=(.*)~ )
1530 dpurdie 4676
    {
1546 dpurdie 4677
        Error("Locating Interface directory must be used in conjunction with an Absolute path")
4678
            unless ( $m_type eq 'A' );
4679
 
4680
        my $SubDir = $1;
4681
        my $Dir = "$InterfaceDir/$SubDir";
4682
        Error ("Interface subdirectory not found: $SubDir" )
4683
            unless ( -d $Dir );
4684
        return $Dir;
4685
    }
4686
 
4687
    if ( $m_key =~ m~^--Package=(.*)~ )
4688
    {
4689
        Error("Locating local source directory must be used in conjunction with an Absolute path")
4690
            unless ( $m_type eq 'A' );
4691
 
4692
        #
4693
        #   Locate directory within a package
4694
        #
4695
        my ($PkgName, $PkgSubDir) = split /[\/,]/, $1, 2;
4696
        Error ("--Package requres a package name and a subdirectory") unless ( $PkgName && $PkgSubDir );
4697
        my $PkgDir = LocatePackageBase( "getLocalDirValue", $PkgName, $PkgSubDir );
4698
        return $PkgDir;
4699
    }
4700
 
4701
    #
4702
    #   Locate the directory within the LocalSrcDirStructure
4703
    #   This is a symbolic reference to a local directory
4704
    #
4705
    if (exists  $LocalSrcDirStructure{$m_key} )
4706
    {
1530 dpurdie 4707
        if ( "$m_type" eq "A" )
4708
        {
1546 dpurdie 4709
            return "$SrcDir/$LocalSrcDirStructure{$m_key}";
1530 dpurdie 4710
        }
4711
        else
4712
        {
4713
            return "$LocalSrcDirStructure{$m_key}";
4714
        }
4715
    }
4716
    else
4717
    {
1534 dpurdie 4718
        Error("Local src tag [$m_key] does not exist in " .
4719
             "LocalSrcDirStructure. " ,
4720
             "Check deploy configuration.");
1530 dpurdie 4721
    }
4722
 
4723
    return 1;
4724
}
4725
 
4726
 
4727
#------------------------------------------------------------------------------
4728
sub getTargetDstDirValue
4729
#
4730
# Description:
4731
#       This sub-routine is used to return the target dest dir value from
4732
#       %TargetDstDirStructure based on providing the 
4733
#       associated key.
4734
#
4735
#       If the value does not exist then it will return an error
4736
#       and terminate processing.
4737
#
1532 dpurdie 4738
# Inputs:   $m_key          Symbolic name for target directory
4739
#           $m_type         Type : A    - Absolute
4740
#                                  R    - Relative
4741
#
1530 dpurdie 4742
#------------------------------------------------------------------------------
4743
{
4744
    # correct number of parameters?
4745
    if ( ($#_+1) != 2 ) 
4746
    {
1534 dpurdie 4747
        Error("Incorrect number of params passed to " .
1530 dpurdie 4748
                  "getTargetDstDirValue() function.");
4749
    }
4750
 
4751
    my ($m_key, $m_type) = @_;
1570 gchristi 4752
    my $tdir = ($TargetBaseDir ne ".") ? "$TargetBaseDir/" : "";
1532 dpurdie 4753
 
4754
    #
4755
    #   Look up the users tag conversion hash
4756
    #
4757
    if ( exists $TargetDstDirStructure{$m_key} )
1530 dpurdie 4758
    {
1570 gchristi 4759
        $tdir .= $TargetDstDirStructure{$m_key};
1530 dpurdie 4760
    }
4761
    else
4762
    {
1534 dpurdie 4763
        Error("Target destination dir tag [$m_key] does not exist in " .
4764
             "TargetDstDirStructure. " ,
4765
             "Check deploy configuration.");
1530 dpurdie 4766
    }
4767
 
1532 dpurdie 4768
 
4769
    #
4770
    #   If an absolute path is required than add the PkgBaseDir
4771
    #   otherwise the user must be requesting a relative path.
4772
    #
4773
    if ( "$m_type" eq "A" ) {
4774
        $tdir = "$PkgBaseDir/$tdir";
4775
    } elsif ( "$m_type" eq "R" )  {
4776
    } else {
1534 dpurdie 4777
        Error("getTargetDstDirValue: Bad call. Unknown type: $m_type");
1532 dpurdie 4778
    }
4779
 
4780
    return $tdir;
1530 dpurdie 4781
}
4782
 
4783
 
4784
#------------------------------------------------------------------------------
4785
sub createPatch
4786
#
4787
# Description:
4788
#       This sub-routine is used to create a solaris patch.
4789
#
4790
#------------------------------------------------------------------------------
4791
{
4792
    # correct number of parameters?
4793
    if ( ($#_+1) != 0 )
4794
    {
1534 dpurdie 4795
        Error("Incorrect number of params passed to " .
4796
              "createPatch() function.",
4797
              "Check deploy config.");
1530 dpurdie 4798
    }
4799
 
4800
    # lets just check to see if we can execute this function on
4801
    # this machine.
4802
    #
4803
    if ( "$MachType" ne "sparc" )
4804
    {
1534 dpurdie 4805
        Verbose("createPatch() not supported on this machine type.");
1530 dpurdie 4806
        return 1;
4807
    }
4808
 
4809
    # lets just check to see if we can execute this function on
4810
    # for  this build.
4811
    #
4812
    if ( "x$PkgPatchNum" eq "x" )
4813
    {
1534 dpurdie 4814
        Warning("createPatch() can only be called during a PATCH build.");
1530 dpurdie 4815
        return 1;
4816
    }
4817
 
4818
    # we need to create the patch directory that contains
4819
    #
1534 dpurdie 4820
    Information("Creating patch ...");
1530 dpurdie 4821
 
4822
    my ( $m_pkgmkCmd );
4823
    my ( $m_pkgtransCmd );
4824
    $m_pkgmkCmd = "pkgmk -o " .
4825
                  "-f $PkgBaseDir/prototype " .
4826
                  "-d $PkgBaseDir";
4827
 
4828
    # lets execute the package commands.
4829
    my ($retVal);
4830
    $retVal = system("$m_pkgmkCmd");
4831
    if ( $retVal != 0 )
4832
    {
1534 dpurdie 4833
        Error("Failed to complete command [$m_pkgmkCmd].");
1530 dpurdie 4834
    }
4835
 
4836
    # we need to generate a README file to help during installation
4837
    #
4838
    generatePatchREADME();
4839
 
4840
 
4841
    my ($m_Cmd)    = ""; 
4842
    my ($m_tmpDir) = "$PkgPatchTmpDir/$PkgPatchID";
4843
 
1534 dpurdie 4844
    Information("Creating staging area of patch...");
1530 dpurdie 4845
    $m_Cmd = "cd $PkgBaseDir && mkdir -p $m_tmpDir;";
4846
    system($m_Cmd);
4847
 
1534 dpurdie 4848
    Information("Copying patch contents to staging area of patch...");
1530 dpurdie 4849
    $m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";
4850
    system($m_Cmd);
4851
 
4852
    # we need to copy the patch install utility files from
4853
    # their resting place.
4854
    #
4855
    my ($i);
4856
    foreach $i ( @PATCH_UTIL_FILES )
4857
    {
4858
        if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgPatchTmpDir") )
4859
        {
1534 dpurdie 4860
            Verbose("Copied [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] ...");
1530 dpurdie 4861
            system("chmod 0755 $PkgPatchTmpDir/$i");
4862
        }
4863
        else
4864
        {
1534 dpurdie 4865
            Error("Failed to copy info file [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] : $!");
1530 dpurdie 4866
        }
4867
    }
4868
 
4869
    # Lets put the readme in place
4870
    #
4871
    if( File::Copy::copy("$PkgPatchReadme", "$PkgPatchTmpDir") )
4872
    {
1534 dpurdie 4873
        Verbose("Copied [$PkgPatchReadme] to [$PkgPatchTmpDir] ...");
1530 dpurdie 4874
    }
4875
    else
4876
    {
1534 dpurdie 4877
        Error("Failed to copy info file [$PkgPatchReadme] to [$PkgPatchTmpDir] : $!");
1530 dpurdie 4878
    }
4879
 
1534 dpurdie 4880
    Information("Copying patch contents to staging area of patch...");
1530 dpurdie 4881
    $m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";
4882
    system($m_Cmd);
4883
 
4884
    my ($m_oFile) = "$PkgPatchID-$ProjectAcronym\.tgz";
1534 dpurdie 4885
    Information("Creating a gzip'd compressed tar (.tgz) output file [$m_oFile]...");
1530 dpurdie 4886
    my ($base) = File::Basename::basename($PkgPatchTmpDir);
4887
    $m_Cmd = "cd $PkgBaseDir && tar cvf - $base | gzip > $m_oFile";
4888
    system($m_Cmd);
4889
 
4890
    return 1;
4891
}
4892
 
4893
 
4894
 
4895
#------------------------------------------------------------------------------
4896
sub generatePatchREADME
4897
#
4898
#   This function is used to generate a README text file to help the user
4899
#   duing the patch installation.
4900
#
4901
#------------------------------------------------------------------------------
4902
{
4903
    local *FILE;
4904
    open ( FILE, "> $PkgPatchReadme") or
1534 dpurdie 4905
        Error("Failed to open file [$PkgPatchReadme].");
1530 dpurdie 4906
 
4907
    printf FILE ("This is a patch for $PkgName $PkgVersion\n");
4908
    printf FILE ("---------------------------------------------------------------\n");
4909
    printf FILE ("\n");
4910
    printf FILE ("Installing patch (as the 'root' user) :\n");
4911
    printf FILE ("---------------------------------------------------------------\n");
4912
    printf FILE ("./installpatch $PkgPatchID\n");
4913
    printf FILE ("\n");
4914
    printf FILE ("Backing Out patch:\n");
4915
    printf FILE ("---------------------------------------------------------------\n");
4916
    printf FILE ("./backoutpatch $PkgPatchID\n");
4917
    printf FILE ("\n");
4918
 
4919
    printf FILE ("Patch contents of $PkgPatchID\n");
4920
    printf FILE ("---------------------------------------------------------------\n");
4921
    close FILE;
4922
 
4923
    # now we need to get the contents of the patch we are creating.
4924
    #
1570 gchristi 4925
    File::Find::find(\&getPatchContents, ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir );
1530 dpurdie 4926
 
4927
    return 1;
4928
}
4929
 
4930
 
4931
#------------------------------------------------------------------------------
4932
sub getPatchContents
4933
#
4934
#   This sub-routine adds an entry into the readme file for each
4935
#   item in the patch delivery tree.
4936
#
4937
#------------------------------------------------------------------------------
4938
{
4939
    my($file)= "$File::Find::name";
4940
    my($base)= File::Basename::basename($file);
4941
 
4942
    # we get the absolute path from the find, but we only require
4943
    # a relative path from the starting dir.
4944
    # so our start dir.
4945
 
4946
    my ($m_sfile) = $file;
4947
    $file =~ s/$PkgBaseDir//;
4948
 
4949
    open ( FILE, ">> $PkgPatchReadme") or
1534 dpurdie 4950
         Error("Failed to open file [$deplylib::PkgPatchReadme].");
1530 dpurdie 4951
 
4952
    # lets populate the prototype file.
4953
    printf FILE ("* $file\n");
4954
 
4955
    close (FILE);
4956
}
4957
 
4958
 
4959
#------------------------------------------------------------------------------
4960
sub createPackage
4961
#
4962
# Description:
1532 dpurdie 4963
#       This sub-routine is used to create a package.
4964
#       The type of package is machine specific. The subroutine will invoke a
4965
#       machine specfic function to do the real work.
1530 dpurdie 4966
#
4967
#------------------------------------------------------------------------------
4968
{
1534 dpurdie 4969
    Information("createPackage");
1530 dpurdie 4970
 
4971
    # lets just check to see if we can execute this function on
4972
    # this machine.
4973
    #
1532 dpurdie 4974
    my $createRoutine = 'createPackage_' . $MachType;
4975
    if ( exists &$createRoutine )
1530 dpurdie 4976
    {
1532 dpurdie 4977
        # lets just check to see if we can execute this function on
4978
        # for  this build.
4979
        #
4980
        if ( $PkgPatchNum )
4981
        {
1534 dpurdie 4982
            Warning("createPackage() can only be called during a RELEASE build.");
1532 dpurdie 4983
            return 1;
4984
        }
4985
 
4986
        #
4987
        #   Ensure the Release directory is present
4988
        #
1534 dpurdie 4989
        make_directory( $ReleaseDir, 0777 );
1532 dpurdie 4990
 
4991
        # Ensure that the package descriptor is transferred
4992
        #
4993
        my ($m_copydesc) = "cp $SrcDir/descpkg $ReleaseDir";
4994
        system($m_copydesc);
4995
 
4996
        # Invoke the machine specific package builder by name
4997
        # Need to relax strictness. Yes we do know what we are doing here
4998
        #
4999
        no strict "refs";
1534 dpurdie 5000
        &$createRoutine( @_ ) || Error("Unspecified error building package");
1532 dpurdie 5001
        use strict "refs";
1530 dpurdie 5002
    }
1532 dpurdie 5003
    else
1530 dpurdie 5004
    {
1534 dpurdie 5005
        Verbose("createPackage() not supported on this machine type: $MachType.");
1530 dpurdie 5006
    }
1532 dpurdie 5007
    return 1;
5008
}
1530 dpurdie 5009
 
5010
 
1532 dpurdie 5011
#------------------------------------------------------------------------------
5012
sub createPackage_sparc
5013
#
5014
# Description:
5015
#       This sub-routine is used to create a package.
5016
#       The type of package is machine specific. The subroutine will invoke a
5017
#       machine specfic function to do the real work.
5018
#
5019
#------------------------------------------------------------------------------
5020
{
1534 dpurdie 5021
    Verbose("createPackage_sparc");
1532 dpurdie 5022
 
1530 dpurdie 5023
    # we need to copy the package utility files from
5024
    # their resting place.
5025
    #
1532 dpurdie 5026
    foreach my $i ( @PKG_UTIL_FILES )
1530 dpurdie 5027
    {
5028
        if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$PkgBaseDir") )
5029
        {
1534 dpurdie 5030
            Verbose("Copied [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] ...");
1530 dpurdie 5031
            updatePrototypeFileAddItem2("$i", "$i", "", "", "", "I");
5032
            system("chmod 0755 $PkgBaseDir/$i");
5033
        }
5034
        else
5035
        {
1534 dpurdie 5036
            Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] : $!");
1530 dpurdie 5037
        }
5038
    }
5039
 
1556 lkelly 5040
    #
5041
    #   Scan the install 'image' looking for files and directories that have a 'space' in the name
5042
    #   These are not handled by the pkgmk utility, so it is best to create a nice error message now.
5043
    #
5044
    my $search = LocateFiles->new( recurse => 1, dirs_too => 1 );
5045
    $search->filter_in_re('\s');                                  
5046
    my @m_nfiles = $search->search($PkgBaseDir);                                  
5047
    if ( @m_nfiles )
5048
    {
5049
        Error ("Pathnames containing a space cannot be packaged under Solaris",
5050
               "The following paths contain a space",
5051
               @m_nfiles );
5052
    }
5053
 
1530 dpurdie 5054
    my ( $m_pkgmkCmd );
5055
    my ( $m_pkgtransCmd );
5056
    $m_pkgmkCmd = "pkgmk -o " .
5057
                  "-f $PkgBaseDir/prototype " .
1556 lkelly 5058
                  "-d $PkgBaseDir " .
5059
                  "-r $PkgBaseDir";
1530 dpurdie 5060
 
5061
    $m_pkgtransCmd = "pkgtrans -o " .
5062
                     "-s $PkgBaseDir " .
5063
                     "$PkgOutputFile " .
5064
                     "$PkgName";
5065
 
5066
    # lets execute the package commands.
5067
    my ($retVal);
5068
    $retVal = system("$m_pkgmkCmd");
5069
    if ( $retVal != 0 )
5070
    {
1534 dpurdie 5071
        Error("Failed to complete command [$m_pkgmkCmd].");
1530 dpurdie 5072
    }
5073
 
5074
    $retVal = system("$m_pkgtransCmd");
5075
    system("$m_pkgtransCmd");
5076
    if ( $retVal != 0 )
5077
    {
1534 dpurdie 5078
        Error("Failed to complete command [$m_pkgtransCmd].");
1530 dpurdie 5079
    }
5080
 
5081
    # lets compress the output to save some space.
5082
    #
1534 dpurdie 5083
    Information("Compressing $PkgOutputFile");
1532 dpurdie 5084
    my ($m_compressCmd) = "cd $PkgBaseDir; gzip $PkgOutputFile; mv ${PkgOutputFile}.gz $ReleaseDir";
1530 dpurdie 5085
    system($m_compressCmd);
5086
 
5087
    return 1;
5088
}
5089
 
1532 dpurdie 5090
#------------------------------------------------------------------------------
5091
sub createPackage_WinCE
5092
#
5093
# Description:
5094
#       This sub-routine is used to create a package.
5095
#       Really a win32 machine type, but for some reason, the MachType gets
5096
#       stuffed around. Don't know why.
5097
#
5098
#       Do have the option of creating a WinCE specific packager
5099
#
5100
#------------------------------------------------------------------------------
5101
{
1534 dpurdie 5102
    Verbose("createPackage_WinCE");
1532 dpurdie 5103
    createPackage_win32(@_);
5104
}
1530 dpurdie 5105
 
5106
#------------------------------------------------------------------------------
1532 dpurdie 5107
sub createPackage_win32
5108
#
5109
# Description:
5110
#       This sub-routine is used to create a package.
5111
#       Invoke the isbuild.pl utility to build the install shield project
5112
#
5113
#------------------------------------------------------------------------------
5114
{
1534 dpurdie 5115
    Verbose("createPackage_win32");
1538 dpurdie 5116
 
1532 dpurdie 5117
    #
1538 dpurdie 5118
    #   Process any options that may be present
5119
    #   Don't complain about args we don't understand. They may apply to other
5120
    #   platforms
5121
    #
5122
    my @user_options = ();
5123
    foreach my $arg ( @_ )
5124
    {
5125
        if ( $arg =~ m/^-nonameversion/ || $arg =~ m/^-nameversion/   ) {
5126
            push @user_options, $arg;
5127
 
5128
        } elsif ( $arg =~ m/^-nocode/ || $arg =~ m/^-code/   ) {
5129
            push @user_options, $arg;
5130
 
1564 dpurdie 5131
        } elsif ( $arg =~ m/^-nomultiprod/ || $arg =~ m/^-multiprod/   ) {
5132
            push @user_options, $arg;
5133
 
5134
        } elsif ( $arg =~ m/^-nomultirel/ || $arg =~ m/^-multirel/   ) {
5135
            push @user_options, $arg;
5136
 
1538 dpurdie 5137
        } else {
5138
            Message ( "createPackage_win32: Unknown option: $_");
5139
        }
5140
    }
5141
 
5142
    #
1532 dpurdie 5143
    #   Locate MergeModules in external packages
5144
    #   These will be used by the InstallShield compiler
5145
    #
5146
    my @mm_dirs;
5147
    my @mm_tld;
5148
    my $tdir;
5149
 
5150
    #
5151
    #   Check for Merge Modules in the local directory
5152
    #   This must be a flat directory structure. ie: all files in the
5153
    #   subdirectory called MergeModule.
5154
    #
5155
    $tdir = "$RootDir/MergeModules";
5156
    push @mm_dirs, $tdir if ( -d $tdir );
1534 dpurdie 5157
    Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5158
 
5159
    #
5160
    #   Check for Merge Modules in the Interface directory
5161
    #   This will be pulled in via a BuildPkgArchive
5162
    #
5163
    $tdir = "$InterfaceDir/MergeModules";
5164
    push @mm_tld, $tdir if ( -d $tdir );
1534 dpurdie 5165
    Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5166
 
5167
    #
5168
    #   Check in LinkPkgArchive locations too
5169
    for my $entry ( $BuildFileInfo->getBuildPkgRules() )
5170
    {
5171
        next unless ( $entry->{'TYPE'} eq 'link' );
5172
        $tdir = $entry->{'ROOT'} . '/MergeModules';
5173
        push @mm_tld, $tdir if ( -d $tdir );
1534 dpurdie 5174
        Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5175
    }
5176
 
5177
    #
5178
    #   Expand the merge module subdirectory tree into
5179
    #   suitable paths:
5180
    #       Modules/i386
5181
    #       Modules/i386/<language>
5182
    #       Objects
5183
    #       Merge Modules
5184
    #
5185
    foreach my $dir ( @mm_tld )
5186
    {
5187
        $tdir = $dir . '/Modules/i386';
5188
        if ( -d $tdir )
5189
        {
5190
            push @mm_dirs, $tdir;
5191
            foreach my $file ( glob( "$tdir/*" ))
5192
            {
5193
                next unless ( -d $file );
5194
                push @mm_dirs, $file;
5195
            }
5196
        }
5197
 
5198
        $tdir = $dir . '/Objects';
5199
        push @mm_dirs, $tdir if ( -d $tdir );
5200
 
5201
        $tdir = $dir . '/Merge Modules';
5202
        push @mm_dirs, $tdir if ( -d $tdir );
5203
    }
5204
 
5205
 
5206
    #
5207
    #   Locate the program
5208
    #   It will be in a location addressed by the @INC path
5209
    #
5210
    my $prog_found;
5211
    my $prog;
5212
    foreach my $dir ( @INC )
5213
    {
5214
        $prog = $dir . '/isbuild.pl';
5215
        next unless ( -f $prog );
5216
        $prog_found = 1;
5217
        last;
5218
    }
5219
 
1556 lkelly 5220
    #
5221
    #   Note: Use $RootDir for the ISBUILD workdir
5222
    #         Would like t use interface, but it makes
5223
    #         the pathname longer and some MergeModules can
5224
    #         be extracted. ISBUILD appears to have a path length limit of
5225
    #         about 204 character. We need all we can get.
5226
    #
5227
 
1534 dpurdie 5228
    Error("isbuild.pl not found") unless $prog_found;
5229
    Verbose("isbuild: $prog");
1532 dpurdie 5230
    my $rv = system ( $ENV{GBE_PERL}, $prog,
5231
                            "-project=../$PkgName.ism",
5232
                            "-version=$PkgVersionUser",
5233
                            "-out=$ReleaseDir",
1556 lkelly 5234
                            "-workdir=$RootDir",
1538 dpurdie 5235
                            @user_options,
1532 dpurdie 5236
                            map { "-mergemodule=$_" } @mm_dirs
5237
                             );
1534 dpurdie 5238
    Error ("InstallShield Builder Error" ) if ( $rv );
1532 dpurdie 5239
    return 1;
5240
}
5241
 
5242
#------------------------------------------------------------------------------
1530 dpurdie 5243
sub createPrototypeFile
5244
#
5245
# Description:
1532 dpurdie 5246
#       This sub-routine is used to create the required package prototype file
1530 dpurdie 5247
#       from a known directory struture using the search path method.
5248
#
5249
#------------------------------------------------------------------------------
5250
{
5251
    # correct number of parameters?
5252
    if ( ($#_+1) != 2 )
5253
    {
1534 dpurdie 5254
        Error("Incorrect number of params passed to " .
5255
              "createPrototypeFile() function",
5256
              "Check deploy config.");
1530 dpurdie 5257
    }
5258
 
5259
    # lets just check to see if we can execute this function on
5260
    # this machine.
5261
    #
5262
    if ( "$MachType" ne "sparc" )
5263
    {
1534 dpurdie 5264
        Verbose("createPrototypeFile() not supported on this machine type.");
1530 dpurdie 5265
        return 1;
5266
    }
5267
 
5268
    # lets take the passed in args.
5269
    my ($uid, $gid) = @_;
5270
 
5271
    # we need to locate the prototype file
1570 gchristi 5272
    if ( -f "$ProtoTypeFile" )
1530 dpurdie 5273
    {
1570 gchristi 5274
        unlink("$ProtoTypeFile");
5275
        Verbose("Removing prototype file [$ProtoTypeFile].");
1530 dpurdie 5276
    }
5277
 
5278
    # lets open the prototype file.
5279
    #    
5280
    local *FILE;
1570 gchristi 5281
    open ( FILE, "> $ProtoTypeFile") or
5282
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 5283
 
5284
    # lets populate the prototype file.
5285
    printf FILE ("i pkginfo\n");
1570 gchristi 5286
    printf FILE ("!search");
5287
    close(FILE);
1530 dpurdie 5288
 
5289
    # now we need to add entries for each directory we will 
5290
    # be installing 
1570 gchristi 5291
    File::Find::find( \&prototypeFind, ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir );
1530 dpurdie 5292
 
5293
    # lets populate the prototype file with a newline.
1570 gchristi 5294
    open ( FILE, ">> $ProtoTypeFile") or
5295
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 5296
    printf FILE ("\n");
5297
    close (FILE);
5298
 
5299
 
5300
    # lets put the pre-deinfed generic entries into the 
5301
    # prototype file
5302
    #
5303
    if ( "x$PkgPatchNum" ne "x" )
5304
    {
5305
        addPatchInfo2ProtoTypeFile();
5306
    }
5307
 
5308
 
5309
    # we need to expand and complete the creation of the 
5310
    # prototype file
1570 gchristi 5311
    # if Targetbasedir is "." the pkgproto will pick up the pkginfo and
1530 dpurdie 5312
    # prototype files so we need to remove them
5313
    my ($m_cmd) = "pkgproto " .
5314
                  "$TargetBaseDir " .
5315
                  "| egrep -v \"($ProtoTypeFileName|$PkgInfoFileName)\"" .
5316
                  "| cut -f1-4 -d' ' | sed " . '"s/\$/ ' . "$uid $gid" . '/g"' . 
1570 gchristi 5317
                  " >> $ProtoTypeFile";
1530 dpurdie 5318
 
1570 gchristi 5319
    my ($retVal) = system("cd $PkgBaseDir; $m_cmd");
1530 dpurdie 5320
    if ( $retVal != 0 )
5321
    {
1570 gchristi 5322
        Error("Failed to create prototype file [$ProtoTypeFile].");
1530 dpurdie 5323
    }
5324
 
1570 gchristi 5325
    Information("Created prototype file [$ProtoTypeFile].");
1530 dpurdie 5326
 
5327
    return 1;
5328
}
5329
 
5330
#------------------------------------------------------------------------------
5331
sub prototypeFind
5332
#
5333
#    Description:
5334
#        This subroutine is used to locate all associated package dirs.
5335
#        It also adds an entry into the prototype file for each dir.
5336
#
5337
#------------------------------------------------------------------------------
5338
{
1570 gchristi 5339
    my ($file)  = $File::Find::name;
1530 dpurdie 5340
 
1570 gchristi 5341
    # Our topdir will either be $PkgBaseDir or $PkgBaseDir/$TargetBaseDir (if there is a TargetBaseDir).
5342
    # if we have PKgBaseDir only we dont want to include this in the search path, 
5343
    # if TargetBaseDir is defined we include it in the search paths
5344
    if ( $file ne $PkgBaseDir && -d $file )
1530 dpurdie 5345
    {
1570 gchristi 5346
        # we get the absolute path from the find, but we only require a relative path from the starting dir.
5347
        # So remove PkgBaseDir from path and include all dirs below it including TargetBaseDir if there is one
5348
        $file =~ s|$PkgBaseDir/*||;    
5349
 
5350
        open ( FILE, ">> $ProtoTypeFile") or
5351
             Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 5352
 
1570 gchristi 5353
        # lets populate the prototype file.
5354
        printf FILE (" $file");
5355
        close (FILE);
1530 dpurdie 5356
    }
5357
}
5358
 
5359
 
5360
#------------------------------------------------------------------------------
5361
sub addPatchInfo2ProtoTypeFile
5362
#
5363
# Description:
5364
#       This sub-routine is used to add additonal genericinformation
5365
#       used by the patch.
5366
#
5367
#------------------------------------------------------------------------------
5368
{
1534 dpurdie 5369
    Information("Adding patch information files to patch build...");
1530 dpurdie 5370
 
5371
    # we need to determine whiich file we are dealing with
5372
    my ($protoTypeFile);
5373
    $protoTypeFile = "$ProtoTypeFile";
5374
 
5375
    # lets open the prototype file.
5376
    #
5377
    local *FILE;
5378
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 5379
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 5380
 
5381
 
5382
    # we need to copy the install informational files from
5383
    # their resting place.
5384
    my ($i);
5385
    foreach $i ( @PATCH_INFO_FILES )
5386
    {
5387
        if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgBaseDir") )
5388
        {
1534 dpurdie 5389
            Verbose("Copied [$PATCH_UTIL_DIR/$i] to [$PkgBaseDir] ...");
1530 dpurdie 5390
            printf FILE ("i $i\n"); 
5391
        }
5392
        else
5393
        {
1534 dpurdie 5394
            Error("Failed to copy info file [$PATCH_UTIL_DIR/$i]: $!");
1530 dpurdie 5395
        }
5396
    }
5397
    close FILE;
5398
 
5399
    return 1;
5400
}
5401
 
5402
 
5403
#------------------------------------------------------------------------------
5404
sub useReplaceClass
5405
#
5406
# Description:
5407
#       This sub-routine is used to add replace class to the classes list and
5408
#       include the i.replace file in the PKG_INFO_FILES List
5409
#
5410
#------------------------------------------------------------------------------
5411
{
5412
 
1534 dpurdie 5413
    Information("useReplaceClass: Adding replace class to installer");
1530 dpurdie 5414
 
5415
    $PkgInfoClasses = $PkgInfoClasses . " " . "replace";
5416
    push(@PKG_UTIL_FILES, "i.replace");
5417
}
5418
 
5419
 
5420
#------------------------------------------------------------------------------
5421
sub addPkgInfoClasses
5422
#
5423
# Description:
5424
#       This sub-routine is used to add new classes to the pkginfo CLASSES variable.
5425
#
5426
#------------------------------------------------------------------------------
5427
{
5428
    # correct number of parameters?
5429
    if ( ($#_+1) == 0 )
5430
    {
1534 dpurdie 5431
        Error("Incorrect number of params passed to " .
5432
              "createPkginfoFile() function",
5433
              "Check deploy config.");
1530 dpurdie 5434
    }
5435
 
1534 dpurdie 5436
    Information("addPkgInfoClasses() Adding classes \"" . join(" ", @_) . "\" to CLASSES List");
1530 dpurdie 5437
 
5438
    $PkgInfoClasses = $PkgInfoClasses . " " . join(" ", @_);
5439
}
5440
 
5441
 
5442
#------------------------------------------------------------------------------
5443
sub addPkgInfoField
5444
#
5445
# Description:
5446
#       This sub-routine is used to add new fields to already created pkginfo file
5447
#       Acccepts any number of fields of format A=B as one string parameter.
5448
#------------------------------------------------------------------------------
5449
{
5450
    # lets just check to see if we can execute this function on this machine.
5451
    if ( "$MachType" ne "sparc" )
5452
    {
1534 dpurdie 5453
        Verbose("addPkgInfoField() not supported on this machine type.");
1530 dpurdie 5454
        return 1;
5455
    }
5456
    # lets open the pkginfo file.   
5457
    local *FILE;
1534 dpurdie 5458
    open ( FILE, ">> $PkgInfoFile") or Error("Failed to open file [$PkgInfoFile].");
1530 dpurdie 5459
 
5460
    foreach my $i ( @_ )
5461
    {
5462
        print FILE "$i\n";
5463
    }
5464
    close FILE;
5465
    return 1;
5466
}
5467
 
5468
#------------------------------------------------------------------------------
5469
sub updatePrototypeFileItemClass
5470
#
5471
# Description:
5472
#       This subroutine is used to change the class of a file already in the prototype file
5473
#
5474
#------------------------------------------------------------------------------
5475
{
5476
    # correct number of parameters?
5477
    if ( ($#_+1) != 2 )
5478
    {
1534 dpurdie 5479
        Error("Incorrect number of params passed to " .
1530 dpurdie 5480
                  "updatePrototypeFileItemClass() function. Check deploy config.");
5481
    }
5482
 
5483
 
5484
    # lets just check to see if we can execute this function on
5485
    # this machine.
5486
    #
5487
    if ( "$MachType" ne "sparc" )
5488
    {
1534 dpurdie 5489
        Verbose("updatePrototypeFileItemClass() not supported on this machine type.");
1530 dpurdie 5490
        return 1;
5491
    }
5492
 
5493
 
5494
    # lets setup the passed values.
5495
    my ($m_item, $class) = @_;
5496
 
5497
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5498
 
5499
    # lets open the prototype file if it exists
5500
    #
5501
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5502
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5503
 
5504
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5505
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5506
 
5507
    while ( <PFILE> )
5508
    {
5509
        chomp;
5510
        # The path section will normally contain "path [mode]" or path=path
5511
        # The passed arg can be full path or can skip top level dirs
5512
        # eg prototype can have line with path ergbpeod/etc/afcbp.ini
5513
        # arg to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini
5514
        # therefore we need to match arg to the end of the path in line 
5515
        # so we append [= ] to arg
5516
        s/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1$class$2/ if ( /$m_item[ =]/ );
5517
        printf PFILETMP ("$_\n");
5518
    }
5519
    close PFILE;
5520
    close PFILETMP;
5521
 
5522
    # now we need to copy the file.
5523
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5524
    {
1534 dpurdie 5525
        Verbose("Updated file $m_item to class $class");
1530 dpurdie 5526
        unlink($tmpProtoTypeFile);
5527
    }
5528
    else
5529
    {
1534 dpurdie 5530
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5531
    }
5532
 
5533
    return 1;
5534
 
5535
}
5536
 
5537
 
5538
 
5539
#------------------------------------------------------------------------------
5540
sub setReplaceClassFiles
5541
#
5542
# Description:
5543
#       This subroutine is used to change the class of a file already in the prototype file
5544
#
5545
#------------------------------------------------------------------------------
5546
{
5547
    # lets just check to see if we can execute this function on
5548
    # this machine.
5549
    #
5550
    if ( "$MachType" ne "sparc" )
5551
    {
1534 dpurdie 5552
        Verbose("updatePrototypeFileItemClass() not supported on this machine type.");
1530 dpurdie 5553
        return 1;
5554
    }
5555
 
1534 dpurdie 5556
    Error("Must call useReplaceClass() before calling setReplaceClassFiles()") if ( $PkgInfoClasses !~ /replace/ );
1530 dpurdie 5557
 
5558
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5559
 
5560
    # lets open the prototype file if it exists
5561
    #
5562
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5563
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5564
 
5565
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5566
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5567
 
5568
    my $line;
5569
    while ( $line = <PFILE> )
5570
    {
5571
        chomp $line;
5572
        # The path section will normally contain "path [mode]" or path=path
5573
        # The passed args can be full path or can skip top level dirs
5574
        # eg prototype can have line with path ergbpeod/etc/afcbp.ini
5575
        # args to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini
5576
        # therefore we need to match each arg to the end of the path in line 
5577
        # so we append [= ] to end of each arg
5578
        $line =~ s/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1replace$2/ if ( scalar(grep { $line =~ /$_[ =]/ } @_) > 0 );
5579
        printf PFILETMP ("$line\n");
5580
    }
5581
    close PFILE;
5582
    close PFILETMP;
5583
 
5584
    # now we need to copy the file.
5585
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5586
    {
1534 dpurdie 5587
        Verbose("Updated prototype file entries to class replace");
1530 dpurdie 5588
        unlink($tmpProtoTypeFile);
5589
    }
5590
    else
5591
    {
1534 dpurdie 5592
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5593
    }
5594
 
5595
    return 1;
5596
 
5597
}
5598
 
5599
 
5600
#------------------------------------------------------------------------------
5601
sub createPkginfoFile
5602
#
5603
# Description:
5604
#       This sub-routine is used to create the required package info.
5605
#       Accepts any number of parameters, with each parameter taken as a literal
5606
#       Field=Value string and inserted into the PkgInfo File
5607
#------------------------------------------------------------------------------
5608
{
5609
    # lets check to see if our description has been set
5610
    if ( $PkgDesc eq "" )
5611
    {
1534 dpurdie 5612
        Error("Package description not set. " .
1530 dpurdie 5613
                 "Use setPkgDescription('my package description') function.");
5614
    }
5615
 
5616
    # lets check to see if our long name has been set
5617
    if ( $PkgNameLong eq "" )
5618
    {
1534 dpurdie 5619
        Error("Package name not set. Use setPkgName('my package long name') function.");
1530 dpurdie 5620
    }
5621
 
5622
 
5623
    # lets just check to see if we can execute this function on
5624
    # this machine.
5625
    #
5626
    if ( "$MachType" ne "sparc" )
5627
    {
5628
        generateIShieldIncludeFile();
5629
        return 1;
5630
    }
5631
 
5632
    # we need to determine whiich file we are dealing with
5633
    my ($pkginfoFile) = "$PkgInfoFile"; 
5634
 
5635
    # we need to locate the pkginfo file
5636
    if ( -f "$pkginfoFile" )
5637
    {
5638
        unlink("$pkginfoFile");
1534 dpurdie 5639
        Verbose("Removing pkginfo file [$pkginfoFile].");
1530 dpurdie 5640
    }
5641
 
5642
    # lets open the pkginfo file.
5643
    #    
5644
    local *FILE;
5645
    open ( FILE, "> $pkginfoFile") or
1534 dpurdie 5646
        Error("Failed to open file [$pkginfoFile].");
1530 dpurdie 5647
 
5648
    # lets populate the pkginfo file.
5649
    printf FILE ("PKG=$PkgName\n");
5650
 
5651
 
5652
    # here we deal with the new version number format
5653
    #
1568 dpurdie 5654
    Error ("Internal: MachArch is not defined") unless ( $MachArch );
1530 dpurdie 5655
    printf FILE ("NAME=$PkgNameLong\n");
5656
    printf FILE ("VERSION=$PkgVersion.$ProjectAcronym\n");
1568 dpurdie 5657
    printf FILE ("ARCH=$MachArch\n");
1570 gchristi 5658
    printf FILE ("SUNW_ISA=$MachISA\n") if ( $MachISA );
1530 dpurdie 5659
    printf FILE ("VENDOR=$VENDOR_DESC\n");
5660
    printf FILE ("DESC=$PkgDesc\n");
5661
    printf FILE ("CATEGORY=$CATEGORY_DESC\n");
5662
    printf FILE ("BASEDIR=$ERGAFC_BASEDIR\n");
1570 gchristi 5663
    printf FILE ("TARGETBASEDIR=$TargetBaseDir\n") unless ( $TargetBaseDir eq "." );
1530 dpurdie 5664
    printf FILE ("CLASSES=$PkgInfoClasses\n");
5665
 
5666
    foreach my $param ( @_ )
5667
    {
5668
        printf FILE "$param\n";
5669
    }
5670
 
5671
    if ( "x$PkgPatchNum" ne "x" )
5672
    {
5673
        my ($count)=1;
5674
        my ($pRev)="";
5675
        printf FILE ("MAXINST=$MAXINST\n");
5676
        printf FILE ("SUNW_PATCHID=$PkgPatchID\n");
5677
        printf FILE ("SUNW_REQUIRES=\n");
5678
        printf FILE ("SUNW_INCOMPAT=\n");
5679
 
5680
        $count=1;
5681
        $pRev="";
5682
        printf FILE ("SUNW_OBSOLETES=");
5683
        while ( $count < $PkgPatchNum )
5684
        {
5685
            $pRev = sprintf ("%02s", $count); 
5686
            printf FILE ("$PkgPatchName" . 
5687
                         "$PkgVersionStr" . 
5688
                         "-" . 
5689
                         "$pRev ");
5690
            $count++;
5691
        }
5692
        printf FILE ("\n");
5693
 
5694
        $count=1;
5695
        $pRev="";
5696
        printf FILE ("PATCH_OBSOLETES=");
5697
        while ( $count < $PkgPatchNum )
5698
        {
5699
            $pRev = sprintf ("%02s", $count); 
5700
            printf FILE ("$PkgPatchName" . 
5701
                         "$PkgVersionStr" . 
5702
                         "-" . 
5703
                         "$pRev ");
5704
            $count++;
5705
        }
5706
        printf FILE ("\n");
5707
    }
5708
 
5709
 
5710
    # now we will list the build dependencies so
5711
    # we can refer to them online
5712
    #
5713
    my ($i);
5714
    my ($m_Str);
5715
    # printf FILE ("\n");
5716
    my ($count) = 1;
5717
    foreach $i ( $BuildFileInfo->getDpkgArchiveList() )
5718
    {
5719
         my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
5720
 
5721
         printf FILE ( "$moduleInfo->{type}\_$count=$i $moduleInfo->{version}");
5722
 
5723
         # we shall print the project bit if we have one
5724
         if ( $moduleInfo->{proj} ne "" )
5725
         {
5726
             printf FILE ( "\.$moduleInfo->{proj}\n");
5727
         }
5728
         else
5729
         {
5730
             printf FILE ("\n");
5731
         }
5732
         $count++;
5733
    }
5734
    close FILE;
5735
 
5736
 
5737
    # lets close the pkginfo file.
5738
    close (FILE);
1534 dpurdie 5739
    Information("Created pkginfo file [$pkginfoFile].");
1530 dpurdie 5740
 
5741
    return 1;
5742
}
5743
 
5744
 
5745
#------------------------------------------------------------------------------
5746
sub updatePrototypeFileItemOwner
5747
#
5748
# Description:
5749
#       This sub-routine is used to change the ownership of a file item
5750
#       in the prototype file.
5751
#
5752
#------------------------------------------------------------------------------
5753
{
5754
    # correct number of parameters?
5755
    if ( ($#_+1) != 4 )
5756
    {
1534 dpurdie 5757
        Error("Incorrect number of params passed to " .
1530 dpurdie 5758
                  "updatePrototypeFileItemOwner() function. Check deploy config.");
5759
    }
5760
 
5761
 
5762
    # lets just check to see if we can execute this function on
5763
    # this machine.
5764
    #
5765
    if ( "$MachType" ne "sparc" )
5766
    {
1534 dpurdie 5767
        Verbose("chmod() not supported on this machine type.");
1530 dpurdie 5768
        return 1;
5769
    }
5770
 
5771
 
5772
    # lets setup the passed values.
5773
    my ($m_item, $m_ownPerms, $m_ownUser, $m_ownGroup) = @_;
5774
 
5775
 
5776
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5777
 
5778
 
5779
    # lets open the prototype file if it exists
5780
    #
5781
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5782
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5783
 
5784
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5785
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5786
 
5787
    my ($inLine);
5788
    while ( <PFILE> )
5789
    {
5790
        $inLine = $_;
5791
        chomp($inLine);
5792
        if ( "$inLine" =~ /^f / && "$inLine" =~ /$m_item/ )
5793
        {
5794
            my ($b1, $b2, $b3, $b4, $b5, $b6) = split (/ /, $inLine); 
5795
            printf PFILETMP ("$b1 $b2 $b3 $m_ownPerms $m_ownUser $m_ownGroup\n");
5796
        }
5797
        else
5798
        {
5799
            printf PFILETMP ("$inLine\n");
5800
        }
5801
    }
5802
    close PFILE;
5803
    close PFILETMP;
5804
 
5805
    # now we need to copy the file.
5806
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5807
    {
1534 dpurdie 5808
        Verbose("Copied [$tmpProtoTypeFile] to [$ProtoTypeFile] ...");
1530 dpurdie 5809
        unlink($tmpProtoTypeFile);
5810
    }
5811
    else
5812
    {
1534 dpurdie 5813
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5814
    }
5815
 
5816
    return 1;
5817
 
5818
}
5819
 
5820
 
5821
#------------------------------------------------------------------------------
1556 lkelly 5822
sub setPermissions
5823
#   Called to set permissions of files/dirs in a directory structure.
5824
#       With no options sets DirTag and all files/dirs in it to perms
5825
#   
5826
#   Parameters:  
5827
#               DirTag:  The directory tag to start setting permissions on
5828
#       
5829
#   Required Options:
5830
#       One or both of
5831
#               --FilePerms=    Sets the permissions of files to this permission.
5832
#                               If not supplied then no files have their permissions changed
5833
#               --DirPerms=     Sets the permissions of directories to this permission
5834
#                               If not supplied then no directories have their permissions changed
5835
#       OR
5836
#               --Perms=        Sets the permissions of both files and directories to this permissions
5837
#                               Equivalent to supplying both --FilePerms=X && --DirPerms=X
5838
#               
5839
#   Options:
5840
#               --Recurse       Recurse the directory tree.  Does a deptth first recurse so that all 
5841
#                               dir entries are processed before the dir itself
5842
#               --NoRecurse     Dont recurse, default
5843
#               --DirTagOnly    Only sets the permissions on the DirTag directory, 
5844
#                               all other options ignored
5845
#               --SkipDirTag    Does not set permissions on the DirTag Directory, 
5846
#                               obviously mutually exlusive with --DirTagOnly
5847
#               --FilterIn=     Apply permissions to files/directories that matches this value.
5848
#               --FilterInRE=   Perl RE's can be used (Not Shell wildcards) and this option
5849
#                               can be supplied mulitple times
5850
#               --FilterOut=    Dont apply permissions to any files/directories matching this value
5851
#               --FilterOutRE=  Perl RE's can be used (Not Shell wildcards) and this option
5852
#                               can be supplied mulitple times
5853
#               
5854
#                               FilterIn is applied before FilterOut.  If Recurse is specified 
5855
#                               the directory will be recursed regardless of these filters, however
5856
#                               the filter will be applied when it comes time to chmod the dir 
1530 dpurdie 5857
#
5858
#------------------------------------------------------------------------------
5859
{
1556 lkelly 5860
    my ( $dirTag, $filePerms, $dirPerms );
5861
    my ( $dirTagOnly, $skipDirTag ) = ( 0, 0 );
5862
 
5863
    my $search =  LocateFiles->new( recurse => 0, dirs_too =>1 );
5864
 
5865
    foreach ( @_ )
1530 dpurdie 5866
    {
1556 lkelly 5867
        if ( m/^--Perms=(.*)/ ) {
5868
            $filePerms = $1;
5869
            $dirPerms = $1;
1530 dpurdie 5870
 
1556 lkelly 5871
        } elsif ( m/^--FilePerms=(.*)/ )  {
5872
            $filePerms = $1;
1530 dpurdie 5873
 
1556 lkelly 5874
        } elsif ( m/^--DirPerms=(.*)/ )  {
5875
            $dirPerms = $1;
1530 dpurdie 5876
 
1556 lkelly 5877
        } elsif ( m/^--Recurse/ ) {
5878
            $search->recurse(1);
5879
        }
5880
        elsif ( m/^--NoRecurse/ ) {
5881
            $search->recurse(0);
1530 dpurdie 5882
 
1556 lkelly 5883
        }  elsif ( m/^--DirTagOnly/ ) {
5884
            $dirTagOnly = 1;
5885
 
5886
        } elsif ( m/^--SkipDirTag/ )  {
5887
            $skipDirTag = 1;
5888
 
5889
        }  elsif ( m/^--FilterInRE=(.*)/ ) {
5890
            $search->filter_in_re($1);
5891
 
5892
        } elsif ( m/^--FilterIn=(.*)/ ) {
5893
            $search->filter_in($1);
5894
 
5895
        }  elsif ( m/^--FilterOutRE=(.*)/ ) {
5896
            $search->filter_out_re($1);
5897
 
5898
        }  elsif ( m/^--FilterOut=(.*)/ ) {
5899
            $search->filter_out($1);
5900
 
5901
        } else  {
5902
            Error("SetPermissions DirTag already set") if ( $dirTag );
5903
            $dirTag = $_;
5904
        }
5905
    }
5906
 
5907
    Error("SetPermissions called with out DirTag parameter") if ( !defined($dirTag) );
5908
    Error("SetPermissions called with out any Permission options") if ( !defined($filePerms) && !defined($dirPerms) );
5909
    Error("SetPermissions: Options --DirTagOnly & --SkipDirTag are mutually exclusive" ) if ( $dirTagOnly && $skipDirTag );
5910
 
5911
    #
1530 dpurdie 5912
    # lets just check to see if the perms are in correct format.
5913
    #
1556 lkelly 5914
    if ( (defined($filePerms) && $filePerms !~ m/^\d{4}$/) || (defined($dirPerms) && $dirPerms !~ m/^\d{4}$/) )
1530 dpurdie 5915
    {
1556 lkelly 5916
        Error("setPermissions called with invalid permissions format");
1530 dpurdie 5917
    }
5918
 
1556 lkelly 5919
    #   Convert the symbolic target directory name into a real path
5920
    my ($topDir) = getTargetDstDirValue($dirTag, "A");
1530 dpurdie 5921
 
1556 lkelly 5922
    #
5923
    #   Only set perms on the root directory
5924
    #   This is a trivial operation
5925
    #
5926
    if ( $dirTagOnly )
1530 dpurdie 5927
    {
1556 lkelly 5928
        Error("SetPermissions:  --DirPerms or --Perms not supplied for setting perms with --DirTagOnly") 
5929
            if ( ! defined($dirPerms) );
5930
        Information("SetPermissions: Setting permissions on top level dir only [$topDir] to " . $dirPerms);
5931
        chmodFile($topDir, $dirPerms);
5932
        return;
1530 dpurdie 5933
    }
1556 lkelly 5934
 
5935
    Information("SetPermissions: Called with options " . join(", ", @_));
5936
 
5937
 
5938
    #
5939
    #   Create a list of files/dirs to process
5940
    #
5941
    my @elements = $search->search( $topDir );
5942
    Warning ("setPermissions: No files located") unless ( @elements );
5943
 
5944
    foreach my $dirEntry ( @elements )
1530 dpurdie 5945
    {
1556 lkelly 5946
        my $fullPath = "$topDir/$dirEntry";
5947
 
5948
        # A dir and we dont have dirperms, so skip
5949
        if ( -d $fullPath && !defined($dirPerms) )
5950
        {
5951
            Debug2("SetPermissions: Skipping dir $fullPath as we have no dir permissions");
5952
            next;
5953
        }
5954
 
5955
        # A file and we dont have fileperms, so skip
5956
        if ( -f $fullPath && !defined($filePerms) )
5957
        {
5958
            Debug2("SetPermissions: Skipping file $fullPath as we have no file permissions");
5959
            next;
5960
        }
5961
 
5962
        # a file or a dir and have the right permissions and we are not recursing
5963
        if ( -f $fullPath || -d $fullPath )
5964
        {
5965
            chmodFile($fullPath, ( -f $fullPath ) ? $filePerms : $dirPerms);
5966
        }
5967
        else
5968
        {
5969
            Warning("SetPermissions: Skipping $fullPath as its not a file or directory");
5970
        }
1530 dpurdie 5971
    }
5972
 
1556 lkelly 5973
 
1530 dpurdie 5974
    #
1556 lkelly 5975
    #   Process the topDir
5976
    #   May not be modified if --SkipDirTag has been requested
5977
    #
5978
    if ( !$skipDirTag && defined($dirPerms) )
1530 dpurdie 5979
    {
1556 lkelly 5980
        chmodFile($topDir, $dirPerms);
1530 dpurdie 5981
    }
5982
 
1556 lkelly 5983
}   # setPermissions
5984
 
5985
 
5986
#------------------------------------------------------------------------------
5987
sub chmod
5988
#
5989
# Description:
5990
#       This sub-routine is used to change the ownership of a file or
5991
#       directory structure.
5992
#
5993
#------------------------------------------------------------------------------
5994
{
5995
    # correct number of parameters?
5996
    Error("Incorrect number of params passed to chmod() function. Check deploy config.") if ( ($#_+1) != 3 );
5997
 
5998
    # lets setup the passed values.
5999
    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
6000
 
6001
    Warning("chmod has been deprecated by and now calls setPermissions, see deploylib.pm");
6002
 
6003
    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
6004
    setPermissions($m_sDirTag, "--NoRecurse", 
1558 lkelly 6005
                    ($m_sfile) ? "--FilePerms=$m_ownPerms" : "--DirPerms=$m_ownPerms",
6006
                    ($m_sfile) ? "--FilterIn=$m_sfile"     : "--DirTagOnly" );
1556 lkelly 6007
 
1530 dpurdie 6008
    return 1;
6009
}
6010
 
6011
 
6012
#------------------------------------------------------------------------------
6013
sub chmodRecursive
6014
#
6015
# Description:
6016
#       This sub-routine is used to change the permissions recursively in
6017
#       the target packgae.
6018
#
6019
#------------------------------------------------------------------------------
6020
{
6021
    # correct number of parameters?
1556 lkelly 6022
    Error("Incorrect number of params passed to chmodRecursive() function. Check deploy config.") if ( ($#_+1) != 2 );
1530 dpurdie 6023
 
6024
    # lets setup the passed values.
6025
    my ($m_sDirTag, $m_ownPerms) = @_;
6026
 
1556 lkelly 6027
    Warning("chmodRecursive has been deprecated by and now calls setPermissions, see deploylib.pm");
1530 dpurdie 6028
 
1556 lkelly 6029
    # call setPermissions, if no File then do DirTagOnly, otherwise set FilterIn=File
6030
    setPermissions($m_sDirTag, "--Recurse", "--Perms=$m_ownPerms");
1530 dpurdie 6031
 
6032
    return 1;
6033
}
6034
 
6035
 
6036
 
6037
 
6038
#------------------------------------------------------------------------------
6039
sub chmodDir
6040
#
6041
# Description:
6042
#       This sub-routine is used to change the permissions an entire directory tree.
6043
#
6044
#       It recurses from a starting point chmod'ing each item and if it
6045
#       finds a dir it recurses into that dir chmod'ing it as well.
6046
#
6047
#------------------------------------------------------------------------------
6048
{
6049
    # correct number of parameters?
1556 lkelly 6050
    Error("Incorrect number of params passed to chmodDir() function.") if ( ($#_+1) != 2 );
1530 dpurdie 6051
 
6052
    my ($startingPoint, $perms) = @_;
6053
 
1556 lkelly 6054
    Warning("chmodDir has been deprecated by setPermissions, see deploylib.pm");
6055
 
1534 dpurdie 6056
    Verbose("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");
1530 dpurdie 6057
 
6058
    local *DIR;
1556 lkelly 6059
    opendir(DIR, $startingPoint) or Error("can't opendir $startingPoint: $!");
1530 dpurdie 6060
 
6061
    my ($item);
6062
    while (defined($item = readdir(DIR)))
6063
    {
1556 lkelly 6064
        if ( "$item" !~ /^\.$/  && "$item" !~ /^\.\.$/ )
1530 dpurdie 6065
        {
6066
            if ( -d "$startingPoint/$item" )
6067
            {
6068
                chmodDir("$startingPoint/$item", $perms);
6069
            }
6070
            else
6071
            {
6072
                chmodFile("$startingPoint/$item", $perms);
6073
            }
6074
        }
6075
    }
1568 dpurdie 6076
    closedir (DIR);
1530 dpurdie 6077
 
6078
    # lets deal with starting dir
6079
    # 
6080
    chmodFile("$startingPoint", $perms);
6081
 
6082
    return 1;
6083
}
6084
 
6085
 
6086
 
6087
#------------------------------------------------------------------------------
6088
sub chmodFile
6089
#
1556 lkelly 6090
#    this function is used to chmod the perms of an item
1530 dpurdie 6091
#    it is passed the absolute path to the item and the associated 
6092
#    perms.
6093
#
6094
#------------------------------------------------------------------------------
6095
{
6096
    my ($item, $perms) = @_;
6097
 
6098
    my ($noItems) = CORE::chmod oct($perms), $item;
6099
    if ( $noItems == 0 )
6100
    {
1556 lkelly 6101
        Error("ERROR: Failed to chmod $item=$perms, retVal=[$noItems]");
1530 dpurdie 6102
    }
6103
    else
6104
    {
1556 lkelly 6105
        Debug("Successfully chmod $item=$perms");
1530 dpurdie 6106
    }
6107
 
6108
    return 1;
6109
}
6110
 
6111
 
6112
 
6113
#------------------------------------------------------------------------------
6114
sub createSymbolicLink
6115
#
6116
# Description:
6117
#       This sub-routine is used to copy a local deployment file into
6118
#       the target destination dir. 
6119
#
6120
#
6121
#------------------------------------------------------------------------------
6122
{
6123
    # correct number of parameters?
6124
    if ( ($#_+1) != 3 )
6125
    {
1534 dpurdie 6126
        Error("Incorrect number of params passed to " .
1530 dpurdie 6127
                  "createSymbolicLink() function. Check deploy config.");
6128
    }
6129
 
6130
 
6131
    # lets just check to see if we can execute this function on
6132
    # this machine.
6133
    #
6134
    if ( "$MachType" ne "sparc" )
6135
    {
1534 dpurdie 6136
        Verbose("createSymbolicLink() not supported on this machine type.");
1530 dpurdie 6137
        return 1;
6138
    }
6139
 
6140
 
6141
    # lets setup the passed values.
6142
    my ($m_sDirTag, $m_srcStr, $m_linkStr) = @_;
6143
 
6144
    # lets get the absolute src dir value
6145
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
6146
 
6147
 
6148
    # lets see if the source item exists
6149
    #
6150
    if ( ! -f "$m_sDirAbsoluteValue/$m_srcStr" )
6151
    {
1534 dpurdie 6152
        Error("Failed to locate item [$m_sDirAbsoluteValue/$m_srcStr], link not created.");
1530 dpurdie 6153
    }
6154
 
6155
 
6156
 
6157
    my ($cmd) = "cd $m_sDirAbsoluteValue; ln -s $m_srcStr $m_linkStr";
6158
    system("$cmd");
6159
    if ( $? != 0 )
6160
    {
1534 dpurdie 6161
        Error("Failed to complete command: [$cmd]");
1530 dpurdie 6162
    }
6163
    else
6164
    {
1534 dpurdie 6165
        Verbose("Executed command: [$cmd]");
1530 dpurdie 6166
    }
6167
 
6168
    return 1;
6169
}
6170
 
6171
 
6172
#------------------------------------------------------------------------------
6173
sub createPrototypeFile2
6174
#
6175
# Description:
6176
#       This sub-routine is used to create the required package prototype file
6177
#       fom a known directory struture using the a=b format.
6178
#
6179
#------------------------------------------------------------------------------
6180
{
1556 lkelly 6181
    my ($opt_keep_mask, $opt_keep_links, @args);
1550 dpurdie 6182
 
6183
    #
6184
    #   Process the arguments and extract parameters and options
6185
    #
6186
    foreach ( @_ )
6187
    {
6188
        if ( m/^--KeepMask/ ) {
6189
            $opt_keep_mask = 1;
6190
 
1556 lkelly 6191
        } elsif ( m/^--KeepLinks/ ) {
6192
            $opt_keep_links = 1;
6193
 
1550 dpurdie 6194
        } elsif ( m/^--/ ) {
6195
            Error("createPrototypeFile2: Unknown option: $_")
6196
 
6197
        } else {
6198
            push @args, $_;
6199
 
6200
        }
6201
    }
6202
 
1530 dpurdie 6203
    # correct number of parameters?
1550 dpurdie 6204
    if ( ($#args + 1) != 3 )
1530 dpurdie 6205
    {
1534 dpurdie 6206
        Error("Incorrect number of params passed to " .
1530 dpurdie 6207
                  "createPrototypeFile2() function. Check deploy config.");
6208
    }
6209
 
6210
    # lets just check to see if we can execute this function on
6211
    # this machine.
6212
    #
6213
    if ( "$MachType" ne "sparc" )
6214
    {
1534 dpurdie 6215
        Verbose("createPrototypeFile2() not supported on this machine type.");
1530 dpurdie 6216
        return 1;
6217
    }
6218
 
6219
    # lets take the passed in args.
1550 dpurdie 6220
    my ($uid, $gid, $mask) = @args;
1530 dpurdie 6221
 
6222
 
6223
    # we need to locate the prototype file
1570 gchristi 6224
    if ( -f "$ProtoTypeFile" )
1530 dpurdie 6225
    {
1570 gchristi 6226
        unlink("$ProtoTypeFile");
6227
        Verbose("Removing prototype file [$ProtoTypeFile].");
1530 dpurdie 6228
    }
6229
 
6230
    # lets open the prototype file.
6231
    #    
6232
    local *FILE;
1570 gchristi 6233
    open ( FILE, "> $ProtoTypeFile") or
6234
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 6235
    # lets populate the prototype file.
6236
    printf FILE ("!default $mask $uid $gid\n");
6237
    printf FILE ("i pkginfo\n");
6238
    close (FILE);
6239
 
6240
 
6241
    # lets put the pre-deinfed generic entries into the
6242
    # prototype file
6243
    #
6244
    if ( "x$PkgPatchNum" ne "x" )
6245
    {
6246
        addPatchInfo2ProtoTypeFile();
6247
    }
6248
 
6249
 
6250
    # lets set the associated uid, gid and mask
6251
    # for the bits in the prototype file.
6252
    #
6253
    $m_UID  = $uid;
6254
    $m_GID  = $gid;
6255
    $m_MASK = $mask;
1550 dpurdie 6256
    $m_KEEP_MASK = $opt_keep_mask;
1556 lkelly 6257
    $m_KEEP_LINKS = $opt_keep_links;
1530 dpurdie 6258
 
6259
 
6260
    # now we need to add entries for each directory we will 
6261
    # be installing 
1570 gchristi 6262
    File::Find::find( \&prototype2Find, ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir );
1530 dpurdie 6263
 
6264
 
6265
    # lets populate the prototype file with a newline.
1570 gchristi 6266
    open ( FILE, ">> $ProtoTypeFile") or
6267
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 6268
    printf FILE ("\n");
6269
    close (FILE);
6270
 
6271
 
1570 gchristi 6272
    Information("Created prototype file [$ProtoTypeFile].");
1530 dpurdie 6273
 
6274
    return 1;
6275
}
6276
 
1570 gchristi 6277
 
6278
#------------------------------------------------------------------------------
6279
sub prototype2Find
6280
#
6281
#    Description:
6282
#        This subroutine is used to locate all associated package dirs.
6283
#        It also adds an entry into the prototype file for each dir.
6284
#
6285
#------------------------------------------------------------------------------
6286
{
6287
    my $file = $File::Find::name;
6288
 
6289
    # Our topdir will either be $PkgBaseDir or $PkgBaseDir/$TargetBaseDir (if there is a TargetBaseDir).
6290
    # if we have PkgBaseDir only we dont want to include this in the prototype file, 
6291
    # if TargetBaseDir is defined we include it in the prototype
6292
    if ( $file ne $PkgBaseDir )
6293
    {
6294
        my ($sfile) = $file;
6295
 
6296
        # we get the absolute path from the find, but we only require a relative path from the starting dir.
6297
        # So remove PkgBaseDir from path and include all dirs below it including TargetBaseDir if there is one
6298
        $file =~ s|$PkgBaseDir/*||;    
6299
 
6300
        # if TargetBaseDir is "." then find will find the pkginfo & prototype files so we need to exclude them
6301
        if ( $file ne $ProtoTypeFileName && $file ne $PkgInfoFileName )
6302
        {
6303
            my $fmask = $m_MASK;
6304
            if ( $m_KEEP_MASK )
6305
            {
6306
                $fmask = sprintf "%lo", ( (stat($sfile))[2]) & 07777;
6307
            }
6308
 
6309
            open ( FILE, ">> $ProtoTypeFile") or
6310
                Error("Failed to open file [$ProtoTypeFile].");
6311
 
6312
            if ( $m_KEEP_LINKS && -l "$sfile" )
6313
            {
6314
                my $linkDest = readlink($sfile);
6315
                Warning("Link $sfile has an absolute path, may not be a problem but make sure its what you want") if ( $linkDest =~ /^\// );
6316
                printf FILE ("s none $file=$linkDest\n");
6317
            }
6318
            elsif ( -f $sfile )
6319
            {
6320
                printf FILE ("f none $file=$file $fmask $m_UID $m_GID\n");
6321
            }
6322
            elsif ( -d $sfile )
6323
            {
6324
                printf FILE ("d none $file $fmask $m_UID $m_GID\n");
6325
            }
6326
 
6327
            close (FILE);
6328
        }
6329
    }
6330
}
6331
 
1534 dpurdie 6332
#-------------------------------------------------------------------------------
6333
# Function        : createZip
6334
#
6335
# Description     : Create a ZIp file of a given directory
6336
#
6337
# Inputs          : --Recurse               - Recurse subdirs
6338
#                   --NoRecurse             - Done recurse subdirs
6339
#                   --Dirnames              - Record Dir names
6340
#                   --NoDirnames            - Don't record dirnames
6341
#                   --NoQuiet               - Display the operatios
6342
#                   --Dir=xxxx              - Symbolic Directory to zip
6343
#                   --ZipDir=ttt            - Symbolic target directory
6344
#                   --ZipFile=yyyy          - Zipfile to create
6345
#
6346
# Returns         : Will not return on error
6347
#                   Requires 'zip' to be provided by a 'package' such as InfoZip
6348
#
6349
sub createZip
6350
{
6351
    my $recurse = 1;
6352
    my $dirnames = 0;
6353
    my $quiet = 1;
6354
    my $sdir;
6355
    my $tdir;
6356
    my $tfile;
1530 dpurdie 6357
 
1534 dpurdie 6358
    #
6359
    #   Only on Windows at the moment.
6360
    #   Perhaps Unix should create a .gz file
6361
    #
6362
    Warning ("createZip not supported on $MachType. Operation skipped")
6363
        unless ( "$MachType" eq "win32" );
6364
 
6365
    #
6366
    #   Process user arguments
6367
    #
6368
    foreach ( @_ )
6369
    {
6370
        if ( m/^--Recurse/ ) {
6371
            $recurse = 1;
6372
 
6373
        } elsif ( m/^--NoRecurse/) {
6374
            $recurse = 0;
6375
 
6376
        } elsif ( m/^--Dirnames/ ) {
6377
            $dirnames = 1;
6378
 
6379
        } elsif ( m/^--NoDirnames/ ) {
6380
            $dirnames = 0;
6381
 
6382
        } elsif ( m/^--NoQuiets/ ) {
6383
            $quiet = 0;
6384
 
6385
        } elsif ( m/^--Dir=(.*)/ ) {
6386
            $sdir = $1;
6387
 
6388
        } elsif ( m/^--ZipDir=(.*)/ ) {
6389
            $tdir = $1;
6390
 
6391
        } elsif ( m/^--ZipFile=(.*)/ ) {
6392
            $tfile = $1;
6393
 
6394
        } else {
6395
            Warning("createZip: Unknown argument ignored: $_");
6396
 
6397
        }
6398
    }
6399
 
6400
    #
6401
    #   Convert the source directory TAG into a real directory
6402
    #
6403
    Error ("createZip: Source directory not specified") unless ( $sdir );
6404
    my $sdir_a = getTargetDstDirValue($sdir, "A");
6405
 
6406
    #
6407
    #   Convert the destination directory tag into a real directory
6408
    #
6409
    Error ("createZip: Target directory not specified") unless ( $tdir );
6410
    Error ("createZip: Target filename not specified") unless ( $tfile );
6411
    my $tdir_a = getTargetDstDirValue($tdir, "A");
6412
 
6413
    #
6414
    #   Locate the 'zip' uitilty
6415
    #
6416
    my $prog = LocateProgInPath( 'zip' );
6417
    Error ("createZip: Cannot locate ZIP executable",
6418
            "May need to use the 'infozip' package") unless ( $prog );
6419
 
6420
    #
6421
    #   Generate command file
6422
    #
6423
    my $args = '-9';
6424
    $args .= 'q' unless ( (! $quiet) || IsVerbose(1));
6425
    $args .= 'r' if ( $recurse );
6426
    $args .= 'j' unless ( $dirnames );
6427
 
6428
    #
6429
    #   Zip up the files
6430
    #
6431
    Information ("Create Zip File: [$tdir] $tfile");
6432
    chdir ( $sdir_a ) || Error ("Cannot cd to $sdir_a");
6433
    my $rv = System ($prog, $args, "$tdir_a/$tfile", "." );
6434
    chdir($CurrentDir) || Error ("Cannot cd to $CurrentDir");
6435
 
6436
    Error ("createZip: Zip file not created") if ( $rv );
6437
}
6438
 
6439
 
1552 dpurdie 6440
#-------------------------------------------------------------------------------
6441
# Function        : convertFile
1530 dpurdie 6442
#
1552 dpurdie 6443
# Description     : This sub-routine is used to remove all carrage return\line
6444
#                   feeds from a line and replace them with the platform
6445
#                   specific equivalent chars.
1530 dpurdie 6446
#
1552 dpurdie 6447
#                   We let PERL determine what characters are written to the
6448
#                   file base on the  platform you are running on.
1530 dpurdie 6449
#
1552 dpurdie 6450
#                   i.e. LF    for unix
6451
#                   CR\LF for win32
1530 dpurdie 6452
#
1552 dpurdie 6453
# Inputs          : m_targetDirTag          - Symbolic name of target directory
6454
#                   m_nfiles                - List of files in that directory
6455
#                   or
6456
#                   SearchOptions           - Search options to find files
6457
#                                           --Recurse
6458
#                                           --NoRecurse
6459
#                                           --FilterIn=xxx
6460
#                                           --FilterInRE=xxx
6461
#                                           --FilterOut=xxx
6462
#                                           --FilterOutRE=xxx
1530 dpurdie 6463
#
1552 dpurdie 6464
#
6465
# Returns         : 1
6466
#
6467
sub convertFile
1530 dpurdie 6468
{
1552 dpurdie 6469
    my @uargs;
6470
    my $search =  LocateFiles->new( recurse => 0 );
6471
 
6472
    #
6473
    #   Process user arguments extracting options
6474
    #
6475
    foreach  ( @_ )
1530 dpurdie 6476
    {
1552 dpurdie 6477
        if ( m~^--Recurse~ ) {
6478
            $search->recurse(1);
1530 dpurdie 6479
 
1552 dpurdie 6480
        } elsif ( m~^--NoRecurse~) {
6481
            $search->recurse(0);
1530 dpurdie 6482
 
1552 dpurdie 6483
        } elsif ( /^--FilterOut=(.*)/ ) {
6484
            $search->filter_out($1);
1530 dpurdie 6485
 
1552 dpurdie 6486
        } elsif ( /^--FilterOutRE=(.*)/ ) {
6487
            $search->filter_out_re($1);
1530 dpurdie 6488
 
1552 dpurdie 6489
        } elsif ( /^--FilterIn=(.*)/ ) {
6490
            $search->filter_in($1);
1530 dpurdie 6491
 
1552 dpurdie 6492
        } elsif ( /^--FilterInRE=(.*)/ ) {
6493
            $search->filter_in_re($1);
1530 dpurdie 6494
 
1552 dpurdie 6495
        } elsif ( m~^--~) {
6496
            Error ("convertFile: Unknown option: $_");
1530 dpurdie 6497
 
1552 dpurdie 6498
        } else {
6499
            push @uargs, $_;
1530 dpurdie 6500
        }
6501
    }
6502
 
1552 dpurdie 6503
    #
6504
    #   Process non-option arguments
6505
    #       - Base dir
6506
    #       - List of files
6507
    #
6508
    my ($m_targetDirTag, @m_nfiles) = @uargs;
6509
    Error ("convertFiles: Target Dir must be specified" ) unless ( $m_targetDirTag );
1530 dpurdie 6510
 
1552 dpurdie 6511
    #
6512
    # Convert symbolic dir tag to physical path
6513
    #
6514
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
1530 dpurdie 6515
 
6516
    #
1552 dpurdie 6517
    #   Need to determine if we are searching or simply using a file list
6518
    #   There are two forms of the functions. If any of the search options have
6519
    #   been used then we assume that we are searchine
6520
    #
6521
    if ( $search->has_filter() )
1530 dpurdie 6522
    {
1552 dpurdie 6523
        Error ("convertFiles: Cannot mix search options with named files") if ( @m_nfiles );
6524
        @m_nfiles = $search->search($m_targetDirValue);
1530 dpurdie 6525
    }
1552 dpurdie 6526
    Error ("convertFiles: No files specified") unless ( @m_nfiles );
6527
 
6528
    #
6529
    #   Process all named files
6530
    #
6531
    foreach my $m_nfile ( @m_nfiles )
1530 dpurdie 6532
    {
1552 dpurdie 6533
 
6534
        # this is our file that we want to clean.
6535
        my ($m_ifileLoc) = "$m_targetDirValue/$m_nfile";
6536
        my ($m_tfileLoc) = "$m_targetDirValue/$m_nfile\.tmp";
6537
 
6538
 
6539
        # we will check to see if the file exists.
6540
        #
6541
        local *IFILE;
6542
        local *TFILE;
6543
        if ( -f "$m_ifileLoc" )
6544
        {
6545
            open (IFILE, "< $m_ifileLoc" ) or
6546
                Error("Failed to open file [$m_ifileLoc] : $!");
6547
 
6548
            open (TFILE, "> $m_tfileLoc" ) or
6549
                Error("Failed to open file [$m_tfileLoc] : $!");
6550
 
6551
            while ( <IFILE> ) 
6552
            {
1562 dpurdie 6553
                s~[\n\r]+$~~;               # Chomp
1552 dpurdie 6554
                print TFILE "$_\n";
6555
            }
6556
        }
6557
        else
6558
        {
6559
            Error("Deploy file [$m_ifileLoc] does not exist.");
6560
        }
6561
 
6562
        close IFILE;
6563
        close TFILE;
6564
 
6565
 
6566
        # lets replace our original file with the new one
6567
        #
6568
        if(File::Copy::move("$m_tfileLoc", "$m_ifileLoc"))
6569
        {
6570
            Information("Renamed [$m_tfileLoc] to [$m_ifileLoc] ...");
6571
        }
6572
        else
6573
        {
6574
            Error("Failed to rename file [$m_tfileLoc] to [$m_ifileLoc]: $!");
6575
        }
1530 dpurdie 6576
    }
6577
 
6578
    return 1;
6579
}
6580
 
1534 dpurdie 6581
#-------------------------------------------------------------------------------
6582
# Function        : installDeployFile
1530 dpurdie 6583
#
1534 dpurdie 6584
# Description     : This sub-routine is used to copy a local deployment file into
6585
#                   the target destination dir.
1530 dpurdie 6586
#
1534 dpurdie 6587
# Inputs          : m_srcDirTag             - Tag for Source Dir name
6588
#                                             Tag defined in %LocalSrcDirStructure
1554 dpurdie 6589
#                                             Or --Package=name,subdir
6590
#                                             Or --Interface=subdir
6591
#
1534 dpurdie 6592
#                   m_sfile                 - Name of the source file
6593
#                   m_targetDirTag          - Tag for the target directory
6594
#                                             Tag defined in %TargetDstDirStructure
6595
#                   m_nfile                 - Target filename
6596
#                                             Must be specified. If set to "", then
6597
#                                             the source filename will be used.
1530 dpurdie 6598
#
1534 dpurdie 6599
# Returns         : True
6600
#
1530 dpurdie 6601
#------------------------------------------------------------------------------
1534 dpurdie 6602
 
6603
sub installDeployFile
1530 dpurdie 6604
{
6605
    # correct number of parameters?
6606
    if ( ($#_+1) != 4 )
6607
    {
1534 dpurdie 6608
        Error("Incorrect number of params passed to " .
1530 dpurdie 6609
                  "installDeployFile() function. Check deploy config.");
6610
    }
6611
 
6612
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_nfile) = @_;
6613
 
6614
    # lets get the src dir value
6615
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
6616
 
6617
    # lets get the target dir value
6618
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
6619
 
6620
 
6621
    # we know where we are getting this from and where we 
6622
    # going to put them.
6623
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
6624
 
6625
    my ($m_nfileLoc) = "";
6626
    # lets determine what we are going to call the new file.
6627
    #
6628
    if ( "x$m_nfile" eq "x" )
6629
    {
6630
        $m_nfileLoc = "$m_targetDirValue/$m_sfile";
6631
    }
6632
    else
6633
    {
6634
        $m_nfileLoc = "$m_targetDirValue/$m_nfile";
6635
    }
6636
 
6637
 
6638
    # we will check to see if the file exists.
6639
    #
6640
    if ( -f "$m_sfileLoc" )
6641
    {
6642
        # now we need to copy the file. 
6643
        if(File::Copy::copy("$m_sfileLoc", "$m_nfileLoc"))
6644
        {
1534 dpurdie 6645
            Verbose("Copied [$m_sfile] to [$m_nfileLoc] ...");
1530 dpurdie 6646
 
6647
            # now we need to ensure the item is writable as it
6648
            # has come from our VOB that is by definition read-only
6649
            #
6650
            CORE::chmod oct("0755"), $m_nfileLoc;
6651
 
6652
        }
6653
        else
6654
        {
1534 dpurdie 6655
            Error("Failed to copy lib [$m_sfileLoc]: $!"); 
1530 dpurdie 6656
        }
6657
    }
6658
    else
6659
    {
1534 dpurdie 6660
        Error("Deploy file [$m_sfileLoc] does not exist.");
1530 dpurdie 6661
    }
6662
 
6663
    return 1;
6664
}
6665
 
6666
 
6667
#------------------------------------------------------------------------------
6668
sub getGenericNameForLib
6669
#
6670
# Description:
6671
#       This sub-routine is used to determine the generic name for
6672
#       a library. I.E remove the buildtype and version number.
6673
#
6674
#       It also checks if the name provided should be excluded from
6675
#       the build.
6676
#
6677
#------------------------------------------------------------------------------
6678
{
6679
   # correct number of parameters?
6680
    if ( ($#_+1) != 1 )
6681
    {
1534 dpurdie 6682
        Error("Incorrect number of params passed to " .
1530 dpurdie 6683
                  "getGenericNameForLib() function. Check deploy config.");
6684
    }
6685
 
6686
    # lets just check to see if we can execute this function on
6687
    # this machine.
6688
    #
6689
    if ( "$MachType" ne "sparc" )
6690
    {
1534 dpurdie 6691
        Verbose("getGenericNameForLib() not supported on this machine type.");
1530 dpurdie 6692
        return "";
6693
    }
6694
 
6695
 
6696
    my($itemName) = @_;
6697
 
6698
    # first we need to check to see if it belongs in this build
6699
    #
6700
    my ($gName) = "";
6701
    if(excludeItemFromBuild($itemName))
6702
    {
1534 dpurdie 6703
        Verbose("Excluding item [$itemName] from build as not compatible with build type " .
1530 dpurdie 6704
                "[$BuildType].");
6705
        return "";  # file should be excluded.
6706
    }
6707
    else
6708
    {
6709
        $gName = removeBuildTypeFromItemName($itemName);
6710
        $gName = removeVersionNumberFromItemName($gName);
6711
 
6712
        return "$gName";
6713
    }
6714
 
6715
    return 1;
6716
}
6717
 
6718
 
6719
#------------------------------------------------------------------------------
6720
sub getGenericNameNoVersionForLib
6721
#
6722
# Description:
6723
#       This sub-routine is used to determine the generic name for
6724
#       a library. I.E removes the version number.
6725
#
6726
#       It also checks if the name provided should be excluded from
6727
#       the build.
6728
#
6729
#------------------------------------------------------------------------------
6730
{
1556 lkelly 6731
    my $installProdAndDebug;
6732
    my $itemName = "";
1530 dpurdie 6733
   # correct number of parameters?
1556 lkelly 6734
    if ( (($#_+1) < 1) || (($#_+1) > 2))
1530 dpurdie 6735
    {
1534 dpurdie 6736
        Error("Incorrect number of params passed to " .
1530 dpurdie 6737
                  "getGenericNameNoVersionForLib() function. Check deploy config.");
6738
    }
6739
 
1556 lkelly 6740
    #
6741
    #   Process parameters and extract options
6742
    #
6743
    foreach  ( @_ )
6744
    {
6745
        if ( m/^--InstallProdAndDebug/ ) {
6746
            # not sure if the filename conventions allow the installation
6747
            # of both prod/debug files on windows, so limit this to sparc/unix.
6748
            if ( "$MachType" ne "sparc" ){
6749
                Error("Can only use the InstallProdAndDebug option for sparc.");
6750
            }
6751
 
6752
            $installProdAndDebug = 1;
6753
        } else {
6754
            $itemName = $_;
6755
        }
6756
    }
6757
 
1530 dpurdie 6758
    # lets just check to see if we can execute this function on
6759
    # this machine.
6760
    #
6761
    if ( "$MachType" ne "sparc" )
6762
    {
1534 dpurdie 6763
        Verbose("getGenericNameNoVersionForLib() not supported on this machine type.");
1530 dpurdie 6764
        return "";
6765
    }
6766
 
6767
 
1556 lkelly 6768
    # first we need to check to see if it belongs in this build.
6769
    # if we've been told that both P & D are allowed, skip this check.
1530 dpurdie 6770
    my ($gName) = "";
1556 lkelly 6771
    if( !$installProdAndDebug && excludeItemFromBuild($itemName))
1530 dpurdie 6772
    {
1534 dpurdie 6773
        Verbose("Excluding item [$itemName] from build as not compatible with build type " .
1530 dpurdie 6774
                "[$BuildType].");
6775
        return "";  # file should be excluded.
6776
    }
6777
    else
6778
    {
6779
        $gName = removeVersionNumberFromItemName($itemName);
6780
        return "$gName";
6781
    }
6782
 
6783
    return 1;
6784
}
6785
 
6786
 
6787
#------------------------------------------------------------------------------
6788
sub getGenericNameNoVersionForXML
6789
#
6790
# Description:
6791
#       This sub-routine is used to determine the generic name for
6792
#       an XML file. I.E removes the version number.
6793
#
6794
#------------------------------------------------------------------------------
6795
{
6796
   # correct number of parameters?
6797
    if ( ($#_+1) != 1 )
6798
    {
1534 dpurdie 6799
        Error("Incorrect number of params passed to " .
1530 dpurdie 6800
                  "getGenericNameNoVersionForXML() function. Check deploy config.");
6801
    }
6802
 
6803
    my($itemName) = @_;
6804
    my ($gName) = "";
6805
    $gName = removeVersionNumberFromXMLItemName($itemName);
6806
    return "$gName";
6807
 
6808
    return 1;
6809
}
6810
 
6811
 
6812
#------------------------------------------------------------------------------
6813
sub removeVersionNumberFromXMLItemName
6814
#
6815
#    Description:
6816
#        This sub-routine is used to remove the version number from the item name.
6817
#        i.e.  myFile_1_2_3.xml ==> myFile.xml
6818
#
6819
#    INPUT:
6820
#        item name
6821
#
6822
#    RETURN:
6823
#        new item name.
6824
#
6825
#------------------------------------------------------------------------------
6826
{
6827
    my ($file)  = @_;
6828
    my ($nfile) = $file;
6829
 
6830
    if ( $nfile =~ m/_[0-9]+_[0-9]+_[0-9]+\.xml$/ )
6831
    {
6832
        # if we match lets deal with it.
6833
        $nfile =~ s/_[0-9]+_[0-9]+_[0-9]+\.xml$/\.xml/;
6834
    }
6835
    else
6836
    {
1534 dpurdie 6837
        Warning("Filename [$nfile] does not contain required format [myfile_N_N_N.xml].");
1530 dpurdie 6838
    }
6839
    return "$nfile";
6840
}
6841
 
6842
 
6843
#------------------------------------------------------------------------------
6844
sub createDpkgArchive
6845
#
6846
# Description:
6847
#       This sub-routine is used to create a dpkg_archive directory
6848
#       structure.
6849
#
6850
#------------------------------------------------------------------------------
6851
{
6852
    # correct number of parameters?
6853
    if ( ($#_+1) != 1 )
6854
    {
1534 dpurdie 6855
        Error("Incorrect number of params passed to " .
1530 dpurdie 6856
                  "createDpkgArchive() function. Check deploy config.");
6857
    }
6858
 
6859
    my ($desc) = @_;
6860
 
6861
    # lets just check to see if we can execute this function on
6862
    # for  this build.
6863
    #
6864
    if ( "x$PkgPatchNum" ne "x" )
6865
    {
1534 dpurdie 6866
        Verbose("createDpkgArchive() can only be called during a RELEASE build.");
1530 dpurdie 6867
        return 1;
6868
    }
6869
 
6870
 
6871
    # 1. we create a dpkg_archive top level dir within the output directory
6872
    #
6873
    my ($m_tmpDir) = "$PkgBaseDir/dpkg_archive";
1534 dpurdie 6874
    make_directory( $m_tmpDir, 0777 );
6875
 
1530 dpurdie 6876
    # 2. we create a sub-directory with the package name
6877
    #
1570 gchristi 6878
    $m_tmpDir = ($TargetBaseDir ne ".") ? "$PkgBaseDir/dpkg_archive/$TargetBaseDir" : "$PkgBaseDir/dpkg_archive";
1534 dpurdie 6879
    make_directory( $m_tmpDir, 0777 );
1530 dpurdie 6880
 
6881
    # 3. we create a sub-directory with the package version number
6882
    #
1570 gchristi 6883
    my ($m_tmpDir2) = "$m_tmpDir/${PkgVersion}.${ProjectAcronym}";
1534 dpurdie 6884
    make_directory( $m_tmpDir2, 0777 );
1530 dpurdie 6885
 
6886
 
6887
    # 4. we replacate the contents of the original outputdir/package name
6888
    #    to do this we shall execute a find starting within the original package target dir
6889
    #    any copy all items we find to the new location under the dpkg_archive/package/version dir.
6890
    #
1570 gchristi 6891
    File::Find::find( \&DpkgFind, ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir );
1530 dpurdie 6892
 
6893
 
6894
    # 5. we create a descpkg file, with the Package Name, Version and Desc
6895
    #
1570 gchristi 6896
    my ($m_DescPkgFile) = "$m_tmpDir2/descpkg";
1530 dpurdie 6897
 
6898
    # now we need to update the prototype file
6899
    #
6900
    local *FILE;
6901
    open ( FILE, ">> $m_DescPkgFile") or
1534 dpurdie 6902
        Error("Failed to open file [$m_DescPkgFile].");
1530 dpurdie 6903
    printf FILE ("$PkgName, $PkgVersion.$ProjectAcronym - $desc\n");
6904
    close (FILE);
6905
 
6906
 
6907
    # done.
1534 dpurdie 6908
    Information("createDpkgArchive() completed.");
1530 dpurdie 6909
 
6910
    return 1;
6911
}
6912
 
6913
 
6914
#------------------------------------------------------------------------------
6915
sub DpkgFind
6916
#
6917
#    Description:
6918
#        This subroutine is used to locate all associated items to
6919
#        create a new dpkg_archive directory structure. 
6920
#
6921
#------------------------------------------------------------------------------
6922
{
6923
    my($item)= "$File::Find::name";
6924
    my($base)= File::Basename::basename($item);
6925
 
6926
 
6927
    # we get the absolute path from the find, but we only require
6928
    # a relative path from the starting dir.
6929
 
1570 gchristi 6930
    my $srcdir = ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir;
6931
    my $dstdir = ($TargetBaseDir ne ".") ? "$PkgBaseDir/dpkg_archive/$TargetBaseDir" : "$PkgBaseDir/dpkg_archive";
1530 dpurdie 6932
    # we need to determine which file we are dealing with
6933
    if ( ! -d "$item")
6934
    {
6935
        my ($m_sfile) = $item;
1570 gchristi 6936
        $item =~ s|$srcdir|$dstdir/$PkgVersion\.$ProjectAcronym|;
1530 dpurdie 6937
 
6938
        if(File::Copy::copy("$m_sfile", "$item"))
6939
        {
1534 dpurdie 6940
            Verbose("Copied [$base] to [$item] ...");
1530 dpurdie 6941
        }
6942
        else
6943
        {
1534 dpurdie 6944
            Error("Failed to copy pkg file [$m_sfile] to [$item]: $!");
1530 dpurdie 6945
        }
6946
    }
6947
    else
6948
    {
1570 gchristi 6949
        # if no TargetBaseDir then we will pick up dpkg_archive dir so lets prune it
6950
        if ( $_ eq "dpkg_archive" )
6951
        {
6952
            $File::Find::prune = 1;
6953
        }
6954
        else
6955
        {
6956
            # we have found a dir
6957
            my ($m_sDir) = $item;
6958
            $item =~ s|$srcdir|$dstdir/$PkgVersion\.$ProjectAcronym|;
6959
            make_directory( $item, 0777 );
6960
        }
1530 dpurdie 6961
    }
6962
}
6963
 
6964
 
6965
# This is now depricated
6966
sub generateReleaseNote
6967
{
1534 dpurdie 6968
    Error("generateReleaseNote is depricated please use generateHtmlReleaseNote");
1530 dpurdie 6969
    return 1;
6970
}
6971
 
6972
#------------------------------------------------------------------------------
6973
sub generateHtmlReleaseNote
6974
#
6975
#    Description:
6976
#
6977
#------------------------------------------------------------------------------
6978
{
1560 dpurdie 6979
    Warning('Deprecated Function: generateHtmlReleaseNote');
1530 dpurdie 6980
}
6981
 
1544 dpurdie 6982
#-------------------------------------------------------------------------------
6983
# Function        : generateXmlDependancy
6984
#
6985
# Description     : Generate an XML file that describes the despendencies of the
6986
#                   released package.
6987
#
6988
#                   The generated file needs to be packaged for deployment. This
6989
#                   function will only create the file. It needs to be added to the
6990
#                   files that are deployed into the field. The file is primarily
6991
#                   to be used by Windows based applications, but its use may be
6992
#                   extended to other platforms.
6993
#
6994
#                   The file 'should' be deployed in the same directory as the main
6995
#                   application executable, so that the executable may locate it.
6996
#
6997
#                   The XML file is named after the package. It is prefixed with
6998
#                   the string "PkgInfo_".
6999
#
7000
#                   By default file will be placed in the 'TargetBaseDir'.
7001
#                   This behaviour may be modified by the user.
7002
#
7003
#                   Refer to package_info.xsd for details on the structure of the
7004
#                   generated XML file. Do not randomly chnage the structure.
7005
#                   It is being used.
7006
#
7007
#                   This function requires access to Release Manager in order
7008
#                   to locate the package description and build-time information
7009
#
7010
#                   The function will use the current/last version of the package
7011
#                   in an attempt to locate package information.
7012
#
7013
#
7014
# Inputs          : platform        - Platforms for which the file will be created
7015
#                                     '*' indicate ALL platforms.
7016
#                   options         - Options to control the detail of the generated file
7017
#
7018
#                   Valid options
7019
#                       --TargetDir         - Symbolic target directory
7020
#                                             Default: TargetBaseDir
7021
#
7022
#                       --Depth=nn          - Depth to traverse the dependancy tree
7023
#                                             All packages below this depth will be ignored
7024
#                                             Default: 0. All packages will be included
7025
#                       --VisibleDepth=nn   - Package beyond this depth will be marked as invisible
7026
#                                             Default: 1. Only top level packages will be marked
7027
#                                             as visible.
7028
#                       --Ignore=name       - Ignore this package
7029
#                                             It will not be included in the dependancy list
7030
#                                             Default: None
7031
#                       --IgnoreChildren=name   - Do not include children of this package\
7032
#                                             Default: None
7033
#                       --Invisible=name    - Mark this package and its dependents as invisible
7034
#                                             Default: None
7035
#                       --InvisibleChildren=name
7036
#                                           - Mark this package as visible, but its dependents as invisible
7037
#                                             Default: None
7038
#
7039
# Example:
7040
#               generateXmlDependancy('*', '--TargetDir=OcpDir' );
7041
#               
7042
#
7043
# Returns         : Nothing
7044
#
7045
sub generateXmlDependancy
7046
{
7047
    my ($platforms, @opts) = @_;
7048
    my %data;
7049
    my $filename = "PkgInfo_$PkgName" . '.xml';
7050
    my $targetTag;
1530 dpurdie 7051
 
1544 dpurdie 7052
    return if ( ! ActivePlatform($platforms) );
7053
    Information("Generating XML dependancy information from RM data: $filename");
1560 dpurdie 7054
    Warning ("This function is not compatible with Escrow builds");
1530 dpurdie 7055
 
1544 dpurdie 7056
    #
7057
    #   Insert defaults
7058
    #
7059
    $data{default_visible} = 1;
7060
 
7061
    #
7062
    #   Parse the user options
7063
    #
7064
    foreach ( @opts )
7065
    {
7066
        if ( m/^--Depth=(\d+)/ ) {
7067
            $data{default_depth} = $1;
7068
 
7069
        } elsif ( m/^--VisibleDepth=(\d+)/ ) {
7070
            $data{default_visible} = $1;
7071
 
7072
        } elsif ( m/^--Ignore=(.*)/ ) {
7073
            $data{ignore}{$1} = 1;
7074
 
7075
        } elsif ( m/^--IgnoreChildren=(.*)/ ) {
7076
            $data{ignore_child}{$1} = 1;
7077
 
7078
        } elsif ( m/^--Invisible=(.*)/ ) {
7079
            $data{invisible}{$1} = 1;
7080
 
7081
        } elsif ( m/^--InvisibleChildren=(.*)/ ) {
7082
            $data{invisible_child}{$1} = 1;
7083
 
7084
        } elsif ( m/^--TargetDir=(.*)/ ) {
7085
            $targetTag = $1;
7086
 
7087
        } else {
7088
            Error ("generateXmlDependancy: Unknown option: $_");
7089
        }
7090
    }
7091
 
7092
    #
7093
    #   Sanity Tests
7094
    #
7095
    if ( $data{default_visible} && $data{default_depth} )
7096
    {
7097
        Error ("generateXmlDependancy:Visible depth must be less than total depth")
7098
            if ( $data{default_visible} > $data{default_depth} );
7099
    }
7100
 
7101
    # lets check to see if the target tag exists
7102
    # if does not the process with log an error.
7103
    #
7104
    my $targetValue;
7105
    if ( $targetTag )
7106
    {
7107
        $targetValue = getTargetDstDirValue($targetTag, "A");
7108
    }
7109
    else
7110
    {
1570 gchristi 7111
        $targetValue = ($TargetBaseDir ne ".") ? "$PkgBaseDir/$TargetBaseDir" : $PkgBaseDir;
1544 dpurdie 7112
    }
7113
    $filename = $targetValue . '/' . $filename;
7114
 
7115
 
7116
    #
7117
    #   Determine package information.
7118
    #   Must cater for a number of situations
7119
    #       1) Package rebuild
7120
    #       2) Package ripple
7121
    #       3) New package
7122
    #
7123
 
7124
 
7125
    # Set defaults for elements in RM if not found
7126
    DeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);
7127
    DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);
7128
 
7129
    #
7130
    #   Try with the current package version. It may be in RM
7131
    #
7132
    $RmPkgDetails = DeployUtils::RmPkgInfo->new( {
7133
                        PKG_NAME => $PkgName,
7134
                        PKG_VERSION => $PkgVersionUser,
7135
                        NO_WARN => 1
7136
                    } );
7137
 
7138
    unless ( $RmPkgDetails->foundDetails() && $PkgPreviousVersionStr )
7139
    {
7140
        #
7141
        #   Try with the 'Previous' package
7142
        #
7143
        my $RmPkgDetailsPrev = DeployUtils::RmPkgInfo->new( {
7144
                        PKG_NAME => $PkgName,
7145
                        PKG_VERSION => $PkgPreviousVersionStr,
7146
                        NO_WARN => 1
7147
                    } );
7148
 
7149
        if ( $RmPkgDetailsPrev->foundDetails() )
7150
        {
7151
            Information ("generateXmlDependancy. Using previous version ($PkgPreviousVersionStr)");
7152
            $RmPkgDetails = $RmPkgDetailsPrev;
7153
        }
7154
    }
7155
 
7156
    unless ( $RmPkgDetails->foundDetails() )
7157
    {
7158
        Warning ("generateXmlDependancy. Package Information not in RM. Using defaults");
7159
    }
7160
 
7161
 
7162
    #
7163
    #   %packages   - information on packages that we have discovered
7164
    #   @to_process - An array of packages discovered, but not yet processed
7165
    #
7166
    my @to_process;
7167
 
7168
    #
7169
    #   Create the initial entry in the packages array
7170
    #
7171
    my @deps;
7172
    foreach my $i ( $BuildFileInfo->getDpkgArchiveList() )
7173
    {
7174
        my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
7175
        my $tag = join ($;, $i, $moduleInfo->{versionFull} );
7176
        push @deps, $tag;
7177
    }
7178
 
7179
    $data{packages}{$PkgName}{$PkgVersionUser}{date} = $RmPkgDetails->pv_modified_time() || localtime() ;
7180
    $data{packages}{$PkgName}{$PkgVersionUser}{overview} = $RmPkgDetails->pv_description();
7181
    $data{packages}{$PkgName}{$PkgVersionUser}{deps} = [ @deps ] ;
7182
 
7183
 
7184
    push @to_process, @deps;
7185
 
7186
    while ( my $entry = pop @to_process )
7187
    {
7188
        my ($package, $version) = split ( $;, $entry );
7189
 
7190
        #
7191
        #   Extract and save information for this package
7192
        #
7193
        next if ( exists $data{packages}{$package}{$version} );
7194
 
7195
        #
7196
        #   Some packages need to be totally ignored
7197
        #
7198
        next if ( exists $data{ignore}{$package} );
7199
 
7200
        my $RmPkgDetails = DeployUtils::RmPkgInfo->new(
7201
                        {
7202
                            PKG_NAME => $package,
7203
                            PKG_VERSION => $version,
7204
                        } );
7205
        Error ("generateXmlDependancy: Cannot locate base package: $package, $version")
7206
            unless ( $RmPkgDetails->foundPkg() );
7207
 
7208
        #
7209
        #   Determine the dependancies, unless we are ignoring the children too
7210
        #   Do not use the RmPkgInfo class method getDependencyNames to fetch the
7211
        #   dependancy information as this:
7212
        #       1) gets it wrong
7213
        #       2) Extracts a lot of data that we dont want.
7214
        #
7215
        my @deps;
7216
        unless ( exists $data{ignore_child}{$package} )
7217
        {
7218
            my $deps = $RmPkgDetails->getDependenciesHash();
7219
            foreach my $pkg ( keys %{$deps} )
7220
            {
7221
                foreach my $ver ( keys %{$deps->{$pkg}}  )
7222
                {
7223
                    my $tag = join ($;, $pkg, $ver );
7224
                    push @deps, $tag;
7225
                }
7226
            }
7227
        }
7228
 
7229
        $data{packages}{$package}{$version}{date} = $RmPkgDetails->pv_modified_time();
7230
        $data{packages}{$package}{$version}{overview} = $RmPkgDetails->pv_description();
7231
        $data{packages}{$package}{$version}{deps} = [ @deps ] ;
7232
 
7233
        push @to_process, @deps;
7234
    }
7235
#DebugDumpData ("Packages", \%packages);
7236
 
7237
    #
7238
    #   Now walk the tree and generate XML
7239
    #
7240
    sub output_entry
7241
    {
7242
        my ($datap, $depth, $package, $version, $vis ) = @_;
7243
        my $fh = $datap->{fh};
7244
        $depth++;
7245
 
7246
        #
7247
        #   Skip if too deep or an ignored package
7248
        #
7249
        return if ( $datap->{ignore}{$package} );
7250
        return if ( $datap->{default_depth} && $depth > $datap->{default_depth} );
7251
 
7252
        #
7253
        #   Check for invisible packages
7254
        #
7255
        $vis = 0 if ( $datap->{invisible}{$package} );
7256
 
7257
 
7258
        my $indent = "    " x ($depth - 1);
7259
        my $date = $datap->{packages}{$package}{$version}{date};
7260
        my $overview = $datap->{packages}{$package}{$version}{overview};
7261
 
7262
        #
7263
        #   Clean up the overview
7264
        #
7265
        $overview =~ s~\s+$~~;
7266
        $overview =~ s~\r\n~\n~g;
7267
        $overview =~ s~\n\r~\n~g;
7268
 
7269
        #
7270
        #   Determine visibility
7271
        #
7272
        $vis = 0 if ( $datap->{default_visible} && $depth > $datap->{default_visible} );
7273
        my $visible = ( $vis > 0 ) ? 'true' : 'false';
7274
        $vis = 0 if ( $datap->{invisible_child}{$package} );
7275
 
7276
        #
7277
        #   The top level entry is different
7278
        #
7279
        if ( $depth == 0 )
7280
        {
7281
            $indent = "    " ;
7282
            print $fh "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
7283
            print $fh "<ERG_Package xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:noNamespaceSchemaLocation=\"package_info.xsd\" SchemaVersion=\"1.0.0\">\n";
7284
            print $fh "$indent<Package_Name>$package</Package_Name>\n";
7285
            print $fh "$indent<Package_Version>$version</Package_Version>\n";
7286
            print $fh "$indent<Package_Overview>$overview</Package_Overview>\n";
7287
            print $fh "$indent<Build_Date>$date</Build_Date>\n";
7288
        }
7289
        else
7290
        {
7291
            print $fh "${indent}<Package Name=\"$package\" Version=\"$version\" BuildDate=\"$date\" Visible=\"$visible\">\n";
7292
		    print $fh "${indent}    ";
7293
            print $fh "<Overview>${overview}" if ($overview);
7294
		    print $fh "</Overview>\n";
7295
        }
7296
 
7297
        #
7298
        #   Process dependancies
7299
        #
7300
        unless ( $datap->{ignore_child}{$package} )
7301
        {
7302
            foreach my $entry ( @{ $datap->{packages}{$package}{$version}{deps} } )
7303
            {
7304
                my ($package, $version) = split ( $;, $entry );
7305
                output_entry ( $datap, $depth, $package, $version, $vis );
7306
            }
7307
        }
7308
 
7309
        if ( $depth == 0 )
7310
        {
7311
            print $fh "</ERG_Package>\n";
7312
        }
7313
        else
7314
        {
7315
		    print $fh "${indent}</Package>\n";
7316
        }
7317
    }
7318
 
7319
    #
7320
    #   Output the XML header and information about the first package
7321
    #
7322
    Information ( "Creating file $filename" );
7323
    open ( $data{fh}, ">", $filename ) || Error( "Cannot create $filename");
7324
    output_entry ( \%data, -1, $PkgName, $PkgVersionUser, 1 );
7325
    close $data{fh};
7326
 
7327
#    DebugDumpData( "DATA", \%data );
7328
}
7329
 
7330
 
1530 dpurdie 7331
#------------------------------------------------------------------------------
7332
sub createPerlSvcWin32
7333
#
7334
# Description:
7335
#       This sub-routine is used to create a Win32  service 
7336
#       using a PERL script as the input.
7337
#
7338
#       note we assume here that you have installed ther ActiveState PERL
7339
#       developement KIT and have also installed a valid license key.
7340
#
7341
#------------------------------------------------------------------------------
7342
{
7343
    # lets just check to see if we can execute this function on
7344
    # this machine.
7345
    #
7346
    if ( "$MachType" ne "win32" )
7347
    {
1534 dpurdie 7348
        Information("createPerlSvcWin32() not supported on this machine type.");
1530 dpurdie 7349
        return 1;
7350
    }
7351
 
7352
 
7353
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;
7354
 
7355
 
7356
    # lets get the src dir value
7357
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
7358
 
7359
 
7360
    # lets get the lib src dir value
7361
    my (@m_libDirValue) = ();
7362
    my $i;
7363
    my ($_libStr) = "";
7364
    foreach $i ( 0 .. $#m_libDirTags )
7365
    {
7366
        $m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");
7367
        $_libStr = $_libStr . "$m_libDirValue[$i];"
7368
    }
7369
    if ( -d $DpkgScriptsDir )
7370
    {
7371
        $_libStr = $_libStr . "$DpkgScriptsDir";
7372
    }
1534 dpurdie 7373
    Verbose("additional places to look for perl modules, [$_libStr]");
1530 dpurdie 7374
 
7375
 
7376
    # lets get the target dir value
7377
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
7378
 
7379
    # we know where we are getting this from and where we
7380
    # going to put them.
7381
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
7382
 
7383
 
7384
    my ($_cmdStr) = "perlsvc --verbose --lib $_libStr --exe $m_targetDirValue/$m_ofile $m_sfileLoc";
7385
 
7386
 
7387
    # lets execute the package commands.
7388
    my ($retVal);
7389
    $retVal = system("$_cmdStr");
7390
    if ( $retVal != 0 )
7391
    {
1534 dpurdie 7392
        Error("Failed to complete command [$_cmdStr].");
1530 dpurdie 7393
    }
7394
 
7395
    # done.
7396
    return 1;
7397
}
7398
 
7399
 
7400
#------------------------------------------------------------------------------
7401
sub createPerlAppWin32
7402
#
7403
# Description:
7404
#       This sub-routine is used to create a Win32 free-standing application 
7405
#       using a PERL script as the input.
7406
#
7407
#       note we assume here that you have installed ther ActiveState PERL
7408
#       developement KIT and have also installed a valid license key.
7409
#
7410
#------------------------------------------------------------------------------
7411
{
7412
    # lets just check to see if we can execute this function on
7413
    # this machine.
7414
    #
7415
    if ( "$MachType" ne "win32" )
7416
    {
1534 dpurdie 7417
        Information("createPerlAppWin32() not supported on this machine type.");
1530 dpurdie 7418
        return 1;
7419
    }
7420
 
7421
 
7422
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;
7423
 
7424
 
7425
    # lets get the src dir value
7426
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
7427
 
7428
 
7429
    # lets get the lib src dir value
7430
    my (@m_libDirValue) = ();
7431
    my $i;
7432
    my ($_libStr) = "";
7433
    foreach $i ( 0 .. $#m_libDirTags )
7434
    {
7435
        $m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");
7436
        $_libStr = $_libStr . "$m_libDirValue[$i];"
7437
    }
7438
    if ( -d $DpkgScriptsDir )
7439
    {
7440
        $_libStr = $_libStr . "$DpkgScriptsDir";
7441
    }
1534 dpurdie 7442
    Verbose("additional places to look for perl modules, [$_libStr]");
1530 dpurdie 7443
 
7444
 
7445
    # lets get the target dir value
7446
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
7447
 
7448
    # we know where we are getting this from and where we
7449
    # going to put them.
7450
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
7451
 
7452
 
7453
    my ($_cmdStr) = "perlapp --verbose --clean --force --lib $_libStr --exe $m_targetDirValue/$m_ofile --script $m_sfileLoc";
7454
 
7455
 
7456
    # lets execute the package commands.
7457
    my ($retVal);
7458
    $retVal = system("$_cmdStr");
7459
    if ( $retVal != 0 )
7460
    {
1534 dpurdie 7461
        Error("Failed to complete command [$_cmdStr].");
1530 dpurdie 7462
    }
7463
 
7464
    # done.
7465
    return 1;
7466
}
7467
 
1534 dpurdie 7468
#-------------------------------------------------------------------------------
7469
# Function        : make_directory
7470
#
7471
# Description     : Create a directory if it does not already exist
7472
#                   Simple function to provide user messages on the way
7473
#                   Will create a complete path. There is no need to
7474
#                   break it into bits.
7475
#
7476
# Inputs          : name        - path to the directory
7477
#                   umask       - umask
7478
#                   text        - User text (optional)
7479
#
7480
# Returns         :
7481
#
7482
 
7483
sub make_directory
7484
{
7485
    my ($name, $umask, $text ) = @_;
7486
 
7487
    Error ("make_directory needs a umask") unless ( $umask );
7488
    Error ("make_directory needs a path") unless ( $name );
7489
    $text = "Create directory"  unless ( $text );
7490
 
7491
    my $umask_text = sprintf( "0%o", $umask );
7492
 
7493
    unless ( -d $name )
7494
    {
7495
        Verbose ( "$text: $name [$umask_text]");
7496
        mkpath ( $name, 0, $umask);
7497
    }
7498
    else
7499
    {
7500
        Verbose2 ( "$text: $name [$umask_text] - already exists");
7501
    }
1554 dpurdie 7502
 
7503
    #
7504
    #   Ensure that the target directory is not setgid
7505
    #   as this will mess up the Solaris packaging process. The setgid on the
7506
    #   directories will be propergated into the final package. This is not good.
7507
    #
7508
    #   If the user gets directories with SETGID, then they  must be created
7509
    #   specifically after the directory has been created.
7510
    #
7511
    #   Why is this a problem? Seen when a build user has directory setgid
7512
    #   for the purposes of making the directory accessible by many.
7513
    #
7514
    if ( -g $name )
7515
    {
7516
        system ('chmod', 'g-s', $name );
7517
        Error ("Cannot remove setGID on directory.", "Dir: $name") if ( -g $name );
7518
    }
1534 dpurdie 7519
}
7520
 
1544 dpurdie 7521
 
7522
#-------------------------------------------------------------------------------
7523
# Function        : ActivePlatform
7524
#
7525
# Description     : Determine if the specified platform is currently 'active'
7526
#                   This is used by all user directives in order to determine
7527
#                   if the directive should be ignored for the current platform
7528
#
7529
# Inputs          : $platform_spec      - A (simple)platform specifier
7530
#
7531
# Returns         : TRUE if the platform spec contains the current platform
7532
#
7533
sub ActivePlatform
7534
{
7535
    my( $platform_spec ) = @_;
7536
 
7537
    Error ("No platform specified in some directive") unless ( $platform_spec );
7538
 
7539
    #
7540
    #   Wild card
7541
    #
7542
    return 1 if ( $platform_spec eq '*' );
7543
 
7544
    #
7545
    #   Simple test
7546
    #
7547
    foreach ( split (',', $platform_spec))
7548
    {
7549
        return 1 if ( $_ eq $Platform );
7550
    }
7551
 
7552
    #
7553
    #   Not for me
7554
    #
7555
    return 0;
7556
}
7557
 
1546 dpurdie 7558
#-------------------------------------------------------------------------------
7559
# Function        : LocatePackageBase
7560
#
7561
# Description     : Locate a package and return the path to a directory within
7562
#                   the package
7563
#
7564
# Inputs          : $ufn            - User function. Error reporting
7565
#                   $PkgName        - Name of the Package
7566
#                   $PkgSubDir      - Subdir within the package
7567
#
7568
#
7569
# Returns         : Absolute path to a directory within the package
7570
#
7571
my %LocatePackageBase_cache;
7572
sub LocatePackageBase
7573
{
7574
    my ( $ufn, $PkgName, $PkgSubDir ) = @_;
7575
    my $src_base_dir;
7576
 
7577
    if ( exists $LocatePackageBase_cache{$PkgName} )
7578
    {
7579
        $src_base_dir = $LocatePackageBase_cache{$PkgName};
7580
    }
7581
    else
7582
    {
7583
        #
7584
        #   Convert the package name into a real path name to the package as
7585
        #   held in dpkg_archive. Do not use the copy in the 'interface' directory
7586
        #
7587
        for my $entry ( $BuildFileInfo->getBuildPkgRules() )
7588
        {
7589
            next unless ( $entry->{'DNAME'} eq $PkgName );
7590
            $src_base_dir = $entry->{'ROOT'};
7591
            Verbose ("Discovered package in: $src_base_dir");
7592
        }
7593
 
7594
        Error ("$ufn: Package not located: $PkgName")
7595
            unless ( $src_base_dir );
7596
 
7597
        Error ("$ufn: Package directory not found: $src_base_dir")
7598
            unless ( -d $src_base_dir );
7599
 
7600
        #
7601
        #   Mainatin a cache of located packages
7602
        #
7603
        $LocatePackageBase_cache{$PkgName} = $src_base_dir;
7604
    }
7605
 
7606
    if ( $PkgSubDir )
7607
    {
7608
        $src_base_dir .= '/' . $PkgSubDir;
7609
        Error ("$ufn: Package subdirectory not found: $PkgSubDir" )
7610
            unless ( -d $src_base_dir );
7611
    }
7612
 
7613
    return $src_base_dir;
7614
}
7615
 
1552 dpurdie 7616
#===============================================================================
7617
#
7618
#   Internal Package
1556 lkelly 7619
#   An attempt to simplify the WildCarding interface by capturing the parameters
1552 dpurdie 7620
#   in a package. The idea is that storing the arguments can be easier
7621
#
7622
package LocateFiles;
7623
use JatsError;
7624
 
7625
#-------------------------------------------------------------------------------
7626
# Function        : new
7627
#
7628
# Description     : Create a new instance of a searcher
7629
#
7630
# Inputs          : 
7631
#
7632
# Returns         : 
7633
#
7634
sub new {
7635
    my $class = shift;
7636
    my $self  = {};
7637
    $self->{recurse}  = 0;
7638
    $self->{exclude}  = [];
7639
    $self->{include}  = [];
7640
    $self->{base_dir} = undef;
7641
    $self->{results}  = [];
1556 lkelly 7642
    $self->{dirs_too} = 0;
1552 dpurdie 7643
    bless ($self, $class);
7644
 
7645
    #
7646
    #   Process user arguments
7647
    #   These are are a hash
7648
    #
7649
    my %href = @_;
7650
    foreach my $entry ( keys %href )
7651
    {
7652
        Error( "LocateFiles:new. Unknown initialiser: $entry") unless ( exists $self->{$entry} );
7653
        $self->{$entry} = $href{$entry};
7654
    }
7655
    return $self;
7656
}
7657
 
7658
#-------------------------------------------------------------------------------
1556 lkelly 7659
# Function        :  Class accessor fucntions
7660
#                   recurse                     - Recurse subdirs
7661
#                   filter_in                   - Filter in these files
7662
#                   filter_in_re                - Filter in (Regular Expression)
7663
#                   filter_out                  - Filter out these files
7664
#                   filter_out_re               - Filter out (RE)
7665
#                   base_dir                    - Base dir for search
7666
#                   results                     - Results of the last search
7667
#                   dirs_too                    - Include dirs in the search
7668
#                   has_filter                  - Has any filter been defined
7669
#                   search                      - Perform the search
1552 dpurdie 7670
#
7671
# Description     : Accessor functions
7672
#
7673
# Inputs          : class
7674
#                   One argument (optional)
7675
#
7676
# Returns         : Current value of the daat item
7677
#
7678
sub recurse
7679
{
7680
    my $self = shift;
7681
    if (@_) { $self->{recurse} = shift }
7682
    return $self->{recurse};
7683
}
7684
 
7685
sub filter_in
7686
{
7687
    my $self = shift;
7688
    if (@_) { push @{$self->{include}}, glob2pat( shift ) }
7689
    return $self->{include};
7690
}
7691
 
7692
sub filter_in_re
7693
{
7694
    my $self = shift;
7695
    if (@_) { push @{$self->{include}}, shift }
7696
    return $self->{include};
7697
}
7698
 
7699
sub filter_out
7700
{
7701
    my $self = shift;
7702
    if (@_) { push @{$self->{exclude}}, glob2pat( shift ) }
7703
    return $self->{exclude};
7704
}
7705
 
7706
sub filter_out_re
7707
{
7708
    my $self = shift;
7709
    if (@_) { push @{$self->{exclude}}, shift }
7710
    return $self->{exclude};
7711
}
7712
 
1556 lkelly 7713
sub dirs_too
7714
{
7715
    my $self = shift;
7716
    if (@_) { $self->{dirs_too} = shift }
7717
    return $self->{dirs_too};
7718
}
7719
 
1552 dpurdie 7720
sub base_dir
7721
{
7722
    my $self = shift;
7723
    if (@_) { $self->{base_dir} = shift }
7724
    return $self->{base_dir};
7725
}
7726
 
7727
sub has_filter
7728
{
7729
    my $self = shift;
7730
    return ( ( @{$self->{include}} || @{$self->{exclude}} ) );
7731
}
7732
 
7733
 
7734
#-------------------------------------------------------------------------------
7735
# Function        : search
7736
#
7737
# Description     : This function performs the search for files as specified
7738
#                   by the arguments already provided
7739
#
7740
# Inputs          : base_dir (Optional)
7741
#
7742
# Returns         : List of files that match the search criteria
7743
#
7744
 
7745
my @search_list;             # Must be global to avoid closure problems
7746
my $search_len;
1556 lkelly 7747
my $search_base_dir;
7748
my $search_dirs_too;
1552 dpurdie 7749
 
7750
sub search
7751
{
7752
    my $self = shift;
7753
    $self->{base_dir} = $_[0] if (defined $_[0] );
7754
    $self->{results} = ();
7755
 
7756
    #
7757
    #   Ensure user has provided enough info
7758
    #
7759
    Error ("LocateFiles: No base directory provided") unless ( $self->{base_dir} );
7760
 
7761
    #
7762
    #   Clean up the user dir. Remove any trailing / as we will be adding it back
7763
    #
7764
    $self->{base_dir} =~ s~/*$~~g;
7765
 
7766
    #
7767
    #   Init recursion information
7768
    #   Needed to avoid closure interactions
7769
    #
7770
    @search_list = ();
7771
    $search_len = length( $self->{base_dir} );
7772
 
7773
    #
7774
    #   Create a list of candidate files
7775
    #   If we are recursing the subtree, then this is a little harder
7776
    #   If we are not recursing then we can't simply glob the directory as
7777
    #   not all files are processed.
7778
    #
7779
    #   Will end up with a list of files that
7780
    #       1) Start with a '/'
7781
    #       2) Are rooted as $dir, but don't include $dir
7782
    #
7783
    if ( $self->{recurse} )
7784
    {
1556 lkelly 7785
        $search_dirs_too = $self->{dirs_too};
7786
        $search_base_dir = $self->{base_dir};
1552 dpurdie 7787
        sub find_file_wanted
7788
        {
1556 lkelly 7789
            return if ( !$search_dirs_too && -d $_ );               # skip if current is dir and we are not including dirs
7790
            return if ( $search_base_dir eq $File::Find::name );    # skip if current is base_dir as we dont include it
1552 dpurdie 7791
            my $file = $File::Find::name;
7792
            push @search_list, substr($file, $search_len );
7793
        }
7794
 
7795
        #
7796
        #       Under Unix we need to follow symbolic links, but Perl's
7797
        #       Find:find does not work with -follow under windows if the source
7798
        #       path contains a drive letter.
7799
        #
7800
        #       Solution. Only use follow under non-windows systems.
7801
        #                 Works as Windows does not have symlinks (yet).
7802
        #
7803
        my $follow_opt =  ! ( "$MachType" eq "win32" || "$MachType" eq "WinCE" );
7804
 
7805
        File::Find::find( {wanted => \&find_file_wanted, follow_fast => $follow_opt }, $self->{base_dir} );
7806
    }
7807
    else
7808
    {
7809
        local *DIR ;
7810
        opendir DIR, $self->{base_dir} || die ("Cannot open $self->{base_dir}");
7811
        foreach ( readdir( DIR ) )
7812
        {
7813
            next if /^\Q.\E$/;
7814
            next if /^\Q..\E$/;
1556 lkelly 7815
            next if ( !$self->{dirs_too} && -d "$self->{base_dir}/$_" );
1552 dpurdie 7816
            push @search_list, '/' . $_;
7817
 
7818
        }
7819
        closedir DIR;
7820
    }
7821
 
7822
    #
7823
    #   If filtering is not present then return the entire file list
7824
    #
7825
    $self->{results} = \@search_list ;
7826
    return @search_list
7827
        unless ( @{$self->{include}} || @{$self->{exclude}} );
7828
 
7829
    #
7830
    #   Filtering is present
7831
    #   Apply the filterin rules and then the filter out rules
7832
    #   If no filter-in rules, then assume that all files are allowed in and
7833
    #   simply apply the filter-out rules.
7834
    #
7835
    my @patsin  = map { qr/$_/ } @{$self->{include}};
7836
    my @patsout = map { qr/$_/ } @{$self->{exclude}};
7837
    my @result;
7838
 
7839
#    map { print "Include:$_\n"; } @{$self->{include}};
7840
#    map { print "Exclude:$_\n"; } @{$self->{exclude}};
7841
 
7842
 
7843
    file:
7844
    foreach my $file ( @search_list )
7845
    {
7846
        if ( @{$self->{include}} )
7847
        {
7848
            my $in = 0;
7849
            for my $pat (@patsin)
7850
            {
7851
                if ( $file =~ /$pat/ )
7852
                {
7853
                    $in = 1;
7854
                    last;
7855
                }
7856
            }
7857
#print "------- Not included $file\n" unless $in;
7858
            next unless ( $in );
7859
        }
7860
 
7861
        for my $pat (@patsout)
7862
        {
7863
#print "------- REJECT $file :: $pat \n" if ( $file =~ /$pat/ );
7864
            next file if ( $file =~ /$pat/ );
7865
        }
7866
 
7867
        push @result, $file;
7868
    }
7869
 
7870
    $self->{results} = \@result;
7871
#DebugDumpData ("Search", $self);
7872
 
7873
    return @result;
7874
}
7875
 
7876
#-------------------------------------------------------------------------------
7877
# Function        : glob2pat
7878
#
7879
# Description     : Convert four shell wildcard characters into their equivalent
7880
#                   regular expression; all other characters are quoted to
7881
#                   render them literals.
7882
#
7883
# Inputs          : Shell style wildcard pattern
7884
#
7885
# Returns         : Perl RE
7886
#
7887
 
7888
sub glob2pat
7889
{
7890
    my $globstr = shift;
7891
    $globstr =~ s~^/~~;
7892
    my %patmap = (
7893
        '*' => '[^/]*',
7894
        '?' => '[^/]',
7895
        '[' => '[',
7896
        ']' => ']',
7897
    );
7898
    $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
7899
    return '/' . $globstr . '$';
7900
}
7901
 
1530 dpurdie 7902
#------------------------------------------------------------------------------
7903
1;