Subversion Repositories DevTools

Rev

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