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