Subversion Repositories DevTools

Rev

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