Subversion Repositories DevTools

Rev

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