Subversion Repositories DevTools

Rev

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