Subversion Repositories DevTools

Rev

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

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