Subversion Repositories DevTools

Rev

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