Subversion Repositories DevTools

Rev

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

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