Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

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