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
    #
1599
    for my $entry ( $BuildFileInfo->getBuildPkgRules() )
1600
    {
1601
        next unless ( $entry->{'DNAME'} eq $pkgName );
1602
        $src_base_dir = $entry->{'ROOT'};
1603
        Verbose ("Discovered package in: $src_base_dir");
1604
    }
1605
 
1606
    Error ("installDpkgArchivePkgRaw: Package not located: $pkgName")
1607
        unless ( $src_base_dir );
1608
 
1609
    Error ("installDpkgArchivePkgRaw: Package directory not found: $src_base_dir")
1610
        unless ( -d $src_base_dir );
1611
 
1612
    #
1613
    #   Build up a list of files to copy
1614
    #   Creating a list allows:
1615
    #       Simplified coding
1616
    #       Flattening and testing of the flattening
1617
    #
1618
    my @elements = ExpandDirTree( $src_base_dir, \@dir_tree_exclude, \@dir_tree_include, $recurse );
1619
    Information("Installing Raw Pkg files: $pkgName") if @elements;
1620
 
1621
    #
1622
    #   Perform the file copy
1623
    #   This copy will NOT create empty directories, but it will create needed
1624
    #   directories on the fly.
1625
    #
1626
    foreach  my $sfile ( @elements )
1627
    {
1628
 
1629
        #
1630
        #   Split into directory and file as we may need to make the directory
1631
        #   since the copy operation will not
1632
        #
1633
        my $dir;                                # Target directory
1634
        my $tfile;                              # Target path
1635
       (my $fname = $sfile )=~ s~^.*/+~~;       # Filename(only)
1636
 
1637
        unless ( $flatten )
1638
        {
1639
            $sfile =~ m~^(.*/)~;
1640
            $dir = "$dstDir/$1";
1641
            $tfile = $sfile;
1642
        }
1643
        else
1644
        {
1645
            $dir = $dstDir;
1646
            $tfile = $fname;
1647
        }
1648
 
1649
        #
1650
        #   Ensure the target directory is present
1651
        #
1652
        make_directory ( $dir, 0775 );
1653
 
1654
        #
1655
        #   Copy the file
1656
        #   Ensure that the target file does not already exist
1657
        #   This is most likely to occur when flattening the directory structure
1658
        #
1659
        my $m_sfile = "$src_base_dir$sfile";
1660
        my $m_tfile = "$dstDir/$tfile";
1661
 
1662
        if ( -f $m_tfile  )
1663
        {
1664
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: File already exists");
1665
        }
1666
 
1667
        if( File::Copy::copy("$m_sfile", "$m_tfile") )
1668
        {
1669
            Verbose("Copied [$fname] to [$m_tfile] ...");
1670
        }
1671
        else
1672
        {
1673
            Error("Failed to copy file [$m_sfile] to [$m_tfile]: $!");
1674
        }
1675
    }
1676
 
1677
    #
1678
    #   Return the number of files transferred
1679
    #
1680
    my $nfiles = $#elements + 1;
1681
    Warning("Installing Raw Pkg files: $pkgName - No files transferred") if ( $warning && ! $nfiles ) ;
1682
 
1683
    return $nfiles;
1684
}
1685
 
1686
 
1687
#------------------------------------------------------------------------------
1530 dpurdie 1688
sub installAllDpkgArchiveDevcdFiles
1689
#
1690
# Description:
1691
#       This sub-routine is used to install all devcd files from the
1692
#       dpkg_archive into the defined install area.
1693
#
1694
#       It assumes based on the build type where the src files will be located.
1695
#
1696
#       If it has any problems it will log an error and stop processing.
1697
#
1698
#       Source directory: $DpkgDevcdDir       (interface/devcd)
1699
#       Target directory: Symbolic Directory
1700
#
1701
# Inputs: None
1702
#
1703
#------------------------------------------------------------------------------
1704
{
1705
    # correct number of parameters?
1706
    if ( ($#_+1) != 1 )
1707
    {
1534 dpurdie 1708
        Error("Incorrect number of params passed to " .
1709
              "installAllDpkgArchiveDevcdFiles() function. ",
1710
              "Check deploy config.");
1530 dpurdie 1711
    }
1712
 
1534 dpurdie 1713
    Information("Installing all Prepared Day 0 devcd files...");
1530 dpurdie 1714
 
1715
 
1716
    my ($targetTag) = @_;
1717
 
1718
    # lets check to see if the target tag exists
1719
    # if does not the process with log an error.
1720
    #
1721
    my ($targetValue) = getTargetDstDirValue($targetTag, "R");
1722
 
1723
 
1724
    # ok we have a valid dst value we now need to get a hold of all the 
1725
    # lib scripts files.
1726
    #
1727
    if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" )
1728
    {
1729
        $TmpGlobalVariable = $targetValue; 
1730
        File::Find::find( \&pkgFindDevcd, "$DpkgDevcdDir");
1731
    }
1732
    else
1733
    {
1734
        my ($i);
1735
        my(@FindRes) = `find $DpkgDevcdDir -follow`;
1736
        my ($m_sfile);
1737
        my ($tmp_DstDir) = "$PkgBaseDir/$targetValue";
1738
        my ($tmp_SrcDir) = "$DpkgDevcdDir";
1739
        foreach $i (@FindRes)
1740
        {
1741
 
1742
            chomp($i);
1743
            my($base)= File::Basename::basename($i);
1744
 
1745
            if ( $base eq "devcd" )
1746
            {
1747
                next;
1748
            }
1749
 
1750
            my ($tmp_dItem) = $i;
1751
            $tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;
1752
 
1534 dpurdie 1753
            if ( -d $i )
1530 dpurdie 1754
            {
1534 dpurdie 1755
                make_directory ( $tmp_dItem, 0775 );
1530 dpurdie 1756
            }
1757
            else
1758
            {
1534 dpurdie 1759
                if(File::Copy::copy( $i , $tmp_dItem ))
1530 dpurdie 1760
                {
1534 dpurdie 1761
                    Verbose("Copied [$base] to [$tmp_dItem] ...");
1530 dpurdie 1762
                }
1763
                else
1764
                {
1534 dpurdie 1765
                    Error("Failed to copy pkg file [$tmp_dItem] to [$i]: $!");
1530 dpurdie 1766
                }
1767
            }
1768
        }
1769
    }
1770
 
1771
    return 1;
1772
}
1773
 
1774
 
1775
#------------------------------------------------------------------------------
1776
sub pkgFindDevcd
1777
#
1778
#    Description:
1779
#        This subroutine is used to locate all associated devcd files in 
1780
#        a pre-defined dpkg_archive.
1781
#
1782
#   Trick: Will not copy a file/directory called 'devcd'
1783
#          Not too sure why. May be an attempt to prevent empty devcd directories
1784
#          If you know better, then correct this comment.
1785
#------------------------------------------------------------------------------
1786
{
1787
    my($item)= "$File::Find::name";
1788
    my($base)= File::Basename::basename($item);
1789
 
1790
    if ( $base eq "devcd" )
1791
    {
1792
        return 1;
1793
    }
1794
 
1795
    my ($tmp_dItem) = $item;
1796
    my ($tmp_DstDir) = "$PkgBaseDir/$TmpGlobalVariable";
1797
    my ($tmp_SrcDir) = "$DpkgDevcdDir";
1798
    $tmp_dItem =~ s/$tmp_SrcDir/$tmp_DstDir/;
1799
 
1800
    # we need to determine what type of item we are dealing with file we are dealing with
1801
    if ( -d "$item")
1802
    {
1534 dpurdie 1803
        make_directory( $tmp_dItem, 0775 );
1530 dpurdie 1804
    }
1805
    else
1806
    {
1807
        if(File::Copy::copy("$item", "$tmp_dItem"))
1808
        {
1534 dpurdie 1809
            Verbose("Copied [$base] to [$tmp_dItem] ...");
1530 dpurdie 1810
        }
1811
        else
1812
        {
1534 dpurdie 1813
            Error("Failed to copy pkg file [$tmp_dItem] to [$item]: $!"); 
1530 dpurdie 1814
        }
1815
    }
1816
}
1817
 
1818
#------------------------------------------------------------------------------
1819
sub installAllDpkgArchiveFiles
1820
#
1821
# Description:
1822
#       This sub-routine is used to install all files from the
1823
#       dpkg_archive into the defined install area.
1824
#
1825
#       It assumes based on the build type where the src files will be located.
1826
#
1827
#       If it has any problems it will log an error and stop processing.
1828
#
1829
# Inputs:   $targetType         - Internal tag to specify source file
1830
#           $targetTag          - Users tag for destination
1831
#
1832
#
1833
#------------------------------------------------------------------------------
1834
{
1835
    # correct number of parameters?
1836
    if ( ($#_+1) != 2 )
1837
    {
1534 dpurdie 1838
        Error("Incorrect number of params passed to " .
1839
              "installAllDpkgArchiveFiles() function. ",
1840
              "Check deploy config.");
1530 dpurdie 1841
    }
1842
 
1843
    my ($targetType, $targetTag) = @_;
1844
 
1845
    # lets check to see if the target tag exists
1846
    # if does not the process with log an error.
1847
    #
1848
    my $targetValue;
1849
    if ( $targetTag eq "--NoTag" )
1850
    {
1851
        $targetValue = "$PkgBaseDir/$TargetBaseDir";
1852
    }
1853
    else
1854
    {
1855
       $targetValue = getTargetDstDirValue($targetTag, "A");
1856
    }
1857
 
1858
    # ok we have a valid dst value we now need to get a hold of all the 
1859
    # lib scripts files.
1860
    #
1861
    local *DIR;
1862
    my $src_dir;
1863
 
1864
    if    ( "$targetType" eq "jar" )        { $src_dir = $DpkgJarDir; }
1865
    elsif ( "$targetType" eq "sar" )        { $src_dir = $DpkgSarDir; }
1866
    elsif ( "$targetType" eq "include" )    { $src_dir = $DpkgIncludeDir; }
1867
    elsif ( "$targetType" eq "war" )        { $src_dir = $DpkgWarDir; }
1868
    elsif ( "$targetType" eq "infofiles" )  { $src_dir = $DpkgInfoFilesDir; }
1869
    elsif ( "$targetType" eq "sql" )        { $src_dir = $DpkgSqlDir; }
1870
    elsif ( "$targetType" eq "etc" )        { $src_dir = $DpkgEtcDir; }
1871
    elsif ( "$targetType" eq "scripts" )    { $src_dir = $DpkgScriptsDir; }
1872
    elsif ( "$targetType" eq "rox" )        { $src_dir = $DpkgRoxDir; }
1873
    elsif ( "$targetType" eq "rpt" )        { $src_dir = $DpkgRptDir; }
1874
    elsif ( "$targetType" eq "doc" )        { $src_dir = $DpkgDocDir; }
1875
    elsif ( "$targetType" eq "jsp" )        { $src_dir = $DpkgJspDir; }
1876
#    elsif ( "$targetType" eq "achtml" )     { $src_dir = $DpkgAcHtmlDir; }
1877
    else  {
1534 dpurdie 1878
        Error("installAllDpkgArchiveFiles() passed unknown target type [$targetType].");
1530 dpurdie 1879
    }
1880
 
1881
    opendir(DIR, $src_dir) or
1534 dpurdie 1882
            Error("Can't opendir $src_dir: $!");
1530 dpurdie 1883
 
1884
 
1885
    # lets process what we have found
1886
    #
1887
    my ($file);
1888
    while (defined($file = readdir(DIR))) 
1889
    {
1890
        if ( $file !~ /^.$/  && 
1891
             $file !~ /^..$/ ) 
1892
        {
1893
            my ($m_fLoc) = "$src_dir/$file";
1894
 
1895
            if(File::Copy::copy("$m_fLoc", "$targetValue"))
1896
            {
1534 dpurdie 1897
                Verbose("Copied [$targetType] item [$file] to [$targetValue] ...");
1530 dpurdie 1898
            }
1899
            else
1900
            {
1534 dpurdie 1901
                Error("Failed to copy [$targetType] item [$m_fLoc]: $!"); 
1530 dpurdie 1902
            }
1903
        }
1904
    }
1905
 
1906
    closedir(DIR);
1907
    return 1;
1908
}
1909
 
1910
 
1911
#------------------------------------------------------------------------------
1912
sub installAllDpkgArchiveAcHtmlFiles
1913
#
1914
# Description:
1915
#       This sub-routine is used to install all achtml files from the
1916
#       dpkg_archive into the defined install area.
1917
#
1918
#       It assumes based on the build type where the src files will be located.
1919
#
1920
#       If it has any problems it will log an error and stop processing.
1921
#
1922
#
1923
# Ugly trick:
1924
#       This function tags a $$targetType argument which is used in constructing
1925
#       the source directory path. ie: InterfaceDir/achtml/$targetType
1926
#
1927
#       Could provide as an option to installAllDpkgArchiveFiles and re-use that
1928
#       function
1929
#
1930
#------------------------------------------------------------------------------
1931
{
1932
    # correct number of parameters?
1933
    if ( ($#_+1) != 2 )
1934
    {
1534 dpurdie 1935
        Error("Incorrect number of params passed to " .
1936
              "installAllDpkgArchiveAcHtmlFiles() function. ",
1937
              "Check deploy config.");
1530 dpurdie 1938
    }
1939
    my ($targetType, $targetTag) = @_;
1940
 
1941
    # lets check to see if the target tag exists
1942
    # if does not the process with log an error.
1943
    #
1944
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
1945
 
1946
    # lets check to see if the source type dir actually exists
1947
    #
1948
    my($m_sDirLoc)  = "$DpkgAcHtmlDir/$targetType";
1949
    if( ! -d "$m_sDirLoc" )
1950
    {
1534 dpurdie 1951
        Error("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");
1530 dpurdie 1952
    }
1953
 
1954
    # know everything exists so lets do the biz.
1955
    #
1956
    # now we need to copy all the files.
1957
    #
1958
    local *DIR;
1959
    opendir(DIR, $m_sDirLoc) or 
1534 dpurdie 1960
        Error("Can't opendir $m_sDirLoc: $!");
1530 dpurdie 1961
 
1962
    my ($m_fLoc) = "";
1963
    my ($file) = "";
1964
    while (defined($file = readdir(DIR)))
1965
    {
1966
        if ( $file !~ /^.$/  &&
1967
             $file !~ /^..$/ )
1968
        {
1969
            $m_fLoc = "$m_sDirLoc/$file";
1970
            if(File::Copy::copy("$m_fLoc", "$targetValue"))
1971
            {
1534 dpurdie 1972
                Verbose("Copied AcHtml [$targetType] item [$file] to [$targetValue] ...");
1530 dpurdie 1973
            }
1974
            else
1975
            {
1534 dpurdie 1976
                Error("Failed to copy AcHtml [$targetType] item [$m_fLoc]: $!");
1530 dpurdie 1977
            }
1978
        }
1979
    }
1980
 
1981
    closedir(DIR);
1982
    return 1;
1983
}
1984
 
1985
 
1986
#------------------------------------------------------------------------------
1987
sub installAllDpkgArchiveInfoFilesFiles
1988
#
1989
# Description:
1990
#       This sub-routine is used to install all infofiles files from the
1991
#       dpkg_archive into the defined install area.
1992
#
1993
#       It assumes based on the build type where the src files will be located.
1994
#
1995
#       If it has any problems it will log an error and stop processing.
1996
#
1997
#------------------------------------------------------------------------------
1998
{
1999
    # correct number of parameters?
2000
    if ( ($#_+1) != 1 )
2001
    {
1534 dpurdie 2002
        Error("Incorrect number of params passed to " .
2003
              "installAllDpkgArchiveInfoFilesFiles() function. ",
2004
              "Check deploy config.");
1530 dpurdie 2005
    }
2006
 
2007
    my ($targetTag) = @_;
2008
 
2009
    # lets check to see if the target tag exists
2010
    # if does not the process with log an error.
2011
    #
2012
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2013
 
2014
 
2015
    # for now lets call the generic funtion to move all items
2016
    # in the associated dpkg_archive dir.
2017
    #
2018
    installAllDpkgArchiveFiles("infofiles", $targetTag);
2019
 
2020
    return 1;
2021
}
2022
 
2023
 
2024
 
2025
#------------------------------------------------------------------------------
2026
sub installAllDpkgArchiveSqlFiles
2027
#
2028
# Description:
2029
#       This sub-routine is used to install all sql files from the
2030
#       dpkg_archive into the defined install area.
2031
#
2032
#       It assumes based on the build type where the src files will be located.
2033
#
2034
#       If it has any problems it will log an error and stop processing.
2035
#
2036
#------------------------------------------------------------------------------
2037
{
2038
    # correct number of parameters?
2039
    if ( ($#_+1) != 1 )
2040
    {
1534 dpurdie 2041
        Error("Incorrect number of params passed to " .
2042
              "installAllDpkgArchiveSqlFiles() function. ",
2043
              "Check deploy config.");
1530 dpurdie 2044
    }
2045
 
2046
    my ($targetTag) = @_;
2047
 
2048
    # lets check to see if the target tag exists
2049
    # if does not the process with log an error.
2050
    #
2051
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2052
 
2053
 
2054
    # for now lets call the generic funtion to move all items
2055
    # in the associated dpkg_archive dir.
2056
    #
2057
    installAllDpkgArchiveFiles("sql", $targetTag);
2058
 
2059
    return 1;
2060
}
2061
 
2062
 
2063
#------------------------------------------------------------------------------
2064
sub installAllDpkgArchiveWarFiles
2065
#
2066
# Description:
2067
#       This sub-routine is used to install all war files from the
2068
#       dpkg_archive into the defined install area.
2069
#
2070
#       It assumes based on the build type where the src files will be located.
2071
#
2072
#       If it has any problems it will log an error and stop processing.
2073
#
2074
#------------------------------------------------------------------------------
2075
{
2076
    # correct number of parameters?
2077
    if ( ($#_+1) != 1 )
2078
    {
1534 dpurdie 2079
        Error("Incorrect number of params passed to " .
2080
              "installAllDpkgArchiveWarFiles() function. " ,
2081
              "Check deploy config.");
1530 dpurdie 2082
    }
2083
 
2084
    my ($targetTag) = @_;
2085
 
2086
    # lets check to see if the target tag exists
2087
    # if does not the process with log an error.
2088
    #
2089
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2090
 
2091
 
2092
    # for now lets call the generic funtion to move all items
2093
    # in the associated dpkg_archive dir.
2094
    #
2095
    installAllDpkgArchiveFiles("war", $targetTag);
2096
 
2097
    return 1;
2098
}
2099
 
2100
 
2101
#------------------------------------------------------------------------------
2102
sub installAllDpkgArchiveJarFiles
2103
#
2104
# Description:
2105
#       This sub-routine is used to install all jar files from the
2106
#       dpkg_archive into the defined install area.
2107
#
2108
#       It assumes based on the build type where the src files will be located.
2109
#
2110
#       If it has any problems it will log an error and stop processing.
2111
#
2112
#------------------------------------------------------------------------------
2113
{
2114
    # correct number of parameters?
2115
    if ( ($#_+1) != 1 )
2116
    {
1534 dpurdie 2117
        Error("Incorrect number of params passed to " .
2118
              "installAllDpkgArchiveJarFiles() function. " ,
2119
              "Check deploy config.");
1530 dpurdie 2120
    }
2121
 
2122
    my ($targetTag) = @_;
2123
 
2124
    # lets check to see if the target tag exists
2125
    # if does not the process with log an error.
2126
    #
2127
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2128
 
2129
 
2130
    # for now lets call the generic funtion to move all items
2131
    # in the associated dpkg_archive dir.
2132
    #
2133
    installAllDpkgArchiveFiles("jar", $targetTag);
2134
 
2135
    return 1;
2136
}
2137
 
2138
 
2139
#------------------------------------------------------------------------------
2140
sub installAllDpkgArchiveEtcFiles
2141
#
2142
# Description:
2143
#       This sub-routine is used to install all etc files from the
2144
#       dpkg_archive into the defined install area.
2145
#
2146
#       It assumes based on the build type where the src files will be located.
2147
#
2148
#       If it has any problems it will log an error and stop processing.
2149
#
2150
#------------------------------------------------------------------------------
2151
{
2152
    # correct number of parameters?
2153
    if ( ($#_+1) != 1 )
2154
    {
1534 dpurdie 2155
        Error("Incorrect number of params passed to " .
2156
              "installAllDpkgArchiveEtcFiles() function. " ,
2157
              "Check deploy config.");
1530 dpurdie 2158
    }
2159
 
2160
    my ($targetTag) = @_;
2161
 
2162
    # lets check to see if the target tag exists
2163
    # if does not the process with log an error.
2164
    #
2165
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2166
 
2167
 
2168
    # for now lets call the generic funtion to move all items
2169
    # in the associated dpkg_archive dir.
2170
    #
2171
    installAllDpkgArchiveFiles("etc", $targetTag);
2172
 
2173
    return 1;
2174
}
2175
 
2176
 
2177
#------------------------------------------------------------------------------
2178
sub installAllDpkgArchiveScriptsFiles
2179
#
2180
# Description:
2181
#       This sub-routine is used to install all scripts files from the
2182
#       dpkg_archive into the defined install area.
2183
#
2184
#       It assumes based on the build type where the src files will be located.
2185
#
2186
#       If it has any problems it will log an error and stop processing.
2187
#
2188
#------------------------------------------------------------------------------
2189
{
2190
    # correct number of parameters?
2191
    if ( ($#_+1) != 1 )
2192
    {
1534 dpurdie 2193
        Error("Incorrect number of params passed to " .
2194
              "installAllDpkgArchiveScriptsFiles() function. " ,
2195
              "Check deploy config.");
1530 dpurdie 2196
    }
2197
 
2198
    my ($targetTag) = @_;
2199
 
2200
    # lets check to see if the target tag exists
2201
    # if does not the process with log an error.
2202
    #
2203
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2204
 
2205
 
2206
    # for now lets call the generic funtion to move all items
2207
    # in the associated dpkg_archive dir.
2208
    #
2209
    installAllDpkgArchiveFiles("scripts", $targetTag);
2210
 
2211
    return 1;
2212
}
2213
 
2214
 
2215
#------------------------------------------------------------------------------
2216
sub installAllDpkgArchiveIncludeFiles
2217
#
2218
# Description:
2219
#       This sub-routine is used to install all include files from the
2220
#       dpkg_archive into the defined install area.
2221
#
2222
#       It assumes based on the build type where the src files will be located.
2223
#
2224
#       If it has any problems it will log an error and stop processing.
2225
#
2226
#------------------------------------------------------------------------------
2227
{
2228
    # correct number of parameters?
2229
    if ( ($#_+1) != 1 )
2230
    {
1534 dpurdie 2231
        Error("Incorrect number of params passed to " .
2232
              "installAllDpkgArchiveIncludeFiles() function. " ,
2233
              "Check deploy config.");
1530 dpurdie 2234
    }
2235
 
2236
    my ($targetTag) = @_;
2237
 
2238
    # lets check to see if the target tag exists
2239
    # if does not the process with log an error.
2240
    #
2241
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2242
 
2243
 
2244
    # for now lets call the generic funtion to move all items
2245
    # in the associated dpkg_archive dir.
2246
    #
2247
    installAllDpkgArchiveFiles("include", $targetTag);
2248
 
2249
    return 1;
2250
}
2251
 
2252
 
2253
#------------------------------------------------------------------------------
2254
sub installAllDpkgArchiveDocFiles
2255
#
2256
# Description:
2257
#       This sub-routine is used to install all include files from the
2258
#       dpkg_archive into the defined install area.
2259
#
2260
#       It assumes based on the build type where the src files will be located.
2261
#
2262
#       If it has any problems it will log an error and stop processing.
2263
#
2264
#------------------------------------------------------------------------------
2265
{
2266
    # correct number of parameters?
2267
    if ( ($#_+1) != 1 )
2268
    {
1534 dpurdie 2269
        Error("Incorrect number of params passed to " .
2270
              "installAllDpkgArchiveIncludeFiles() function. " ,
2271
              "Check deploy config.");
1530 dpurdie 2272
    }
2273
 
2274
    my ($targetTag) = @_;
2275
 
2276
    # lets check to see if the target tag exists
2277
    # if does not the process with log an error.
2278
    #
2279
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2280
 
2281
 
2282
    # for now lets call the generic funtion to move all items
2283
    # in the associated dpkg_archive dir.
2284
    #
2285
    installAllDpkgArchiveFiles("doc", $targetTag);
2286
 
2287
    return 1;
2288
}
2289
 
2290
#------------------------------------------------------------------------------
2291
sub installAllDpkgArchiveJspFiles
2292
#
2293
# Description:
2294
#       This sub-routine is used to install all jsp associated files from the
2295
#       dpkg_archive into the defined install area.
2296
#
2297
#       It assumes based on the build type where the src files will be located.
2298
#
2299
#       If it has any problems it will log an error and stop processing.
2300
#
2301
#   Source directory: $DpkgJspDir
2302
#   Target directory: $TargetBaseDir
2303
#
2304
#------------------------------------------------------------------------------
2305
{
2306
    # correct number of parameters?
2307
    if ( ($#_+1) != 0 )
2308
    {
1534 dpurdie 2309
        Error("Incorrect number of params passed to " .
2310
              "installAllDpkgArchiveJspFiles() function. " ,
2311
              "Check deploy config.");
1530 dpurdie 2312
    }
2313
 
2314
    return installAllDpkgArchiveFiles ('jsp', '--NoTag');
2315
}
2316
 
2317
 
2318
#------------------------------------------------------------------------------
2319
sub installDpkgArchiveFile
2320
#
2321
# Description:
2322
#       This sub-routine is used to install a file of a particular type
2323
#       from the dpkg_archive into the supplied install dir. 
2324
#
2325
#       It assumes based on the build type where the file will be located.
2326
#
2327
#       If it fails to find the file it will report an error and terminates
2328
#       processing.
2329
#
2330
# Inputs:   $targetType         - Type of target ( provides source directory)
2331
#           $sfile              - Source file name, within source directory
2332
#           $targetTag          - Symbolic target dir
2333
#
2334
#
2335
# Note: This function will copy a single file
2336
#
2337
#------------------------------------------------------------------------------
2338
{
2339
    # correct number of parameters?
2340
    if ( ($#_+1) != 3 )
2341
    {
1534 dpurdie 2342
        Error("Incorrect number of params passed to " .
2343
              "installDpkgArchiveFile() function. " ,
2344
              "Check deploy config.");
1530 dpurdie 2345
    }
2346
 
2347
    my ($targetType, $sfile, $targetTag) = @_;
2348
 
2349
    # lets check to see if the target tag exists
2350
    # if does not the process with log an error.
2351
    #
2352
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2353
 
2354
 
2355
    # lets define the absolute location of the file
2356
    #
2357
    my ($m_dstFileLocation) = "$targetValue/$sfile";
2358
    my ($m_srcFileLocation) = "";
2359
 
2360
    if    ( "$targetType" eq "jar" )        { $m_srcFileLocation = "$DpkgJarDir/$sfile"; }
2361
    elsif ( "$targetType" eq "sar" )        { $m_srcFileLocation = "$DpkgSarDir/$sfile"; }
2362
    elsif ( "$targetType" eq "include" )    { $m_srcFileLocation = "$DpkgIncludeDir/$sfile"; }
2363
    elsif ( "$targetType" eq "war" )        { $m_srcFileLocation = "$DpkgWarDir/$sfile"; }
2364
    elsif ( "$targetType" eq "infofiles" )  { $m_srcFileLocation = "$DpkgInfoFilesDir/$sfile"; }
2365
    elsif ( "$targetType" eq "sql" )        { $m_srcFileLocation = "$DpkgSqlDir/$sfile"; }
2366
    elsif ( "$targetType" eq "etc" )        { $m_srcFileLocation = "$DpkgEtcDir/$sfile"; }
2367
    elsif ( "$targetType" eq "scripts" )    { $m_srcFileLocation = "$DpkgScriptsDir/$sfile";  }
2368
    elsif ( "$targetType" eq "rox" )        { $m_srcFileLocation = "$DpkgRoxDir/$sfile";  }
2369
    elsif ( "$targetType" eq "dat" )        { $m_srcFileLocation = "$DpkgDatDir/$sfile";  }
2370
    elsif ( "$targetType" eq "thx" )        { $m_srcFileLocation = "$DpkgThxDir/$sfile";  }
2371
    elsif ( "$targetType" eq "mug" )        { $m_srcFileLocation = "$DpkgMugDir/$sfile";  }
2372
    elsif ( "$targetType" eq "rpt" )        { $m_srcFileLocation = "$DpkgRptDir/$sfile";  }
2373
    elsif ( "$targetType" eq "doc" )        { $m_srcFileLocation = "$DpkgDocDir/$sfile";  }
2374
    else  {
1534 dpurdie 2375
        Error("installDpkgArchiveFile() passed unknown target type [$targetType].");
1530 dpurdie 2376
    }
2377
 
2378
 
2379
    # we will check to see if the file exists.
2380
    #
2381
    if ( -f "$m_srcFileLocation" )
2382
    {
2383
        # now we need to copy the file. 
2384
        if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
2385
        {
1534 dpurdie 2386
            Verbose("Copied [$targetType] item [$sfile] to [$m_dstFileLocation] ...");
1530 dpurdie 2387
        }
2388
        else
2389
        {
1534 dpurdie 2390
            Error("Failed to copy [$targetType] item [$sfile]: $!"); 
1530 dpurdie 2391
        }
2392
    }
2393
    else
2394
    {
1534 dpurdie 2395
        Error("Dpkg_archive [$targetType] item [$sfile] does not exist.");
1530 dpurdie 2396
    }
2397
 
2398
    return 1;
2399
}
2400
 
2401
 
2402
#------------------------------------------------------------------------------
2403
sub installDpkgArchiveAcHtmlFile
2404
#
2405
# Description:
2406
#       This sub-routine is used to install a achtml file from the
2407
#       dpkg_archive into the supplied install dir. 
2408
#
2409
#       It assumes based on the build type where the file will be located.
2410
#
2411
#       If it fails to find the file it will report an error and terminates
2412
#       processing.
2413
#
2414
# Ugly trick:
2415
#       This function tags a $$targetType argument which is used in constructing
2416
#       the source directory path. ie: InterfaceDir/achtml/$targetType
2417
#
2418
#       Could provide as an option to installDpkgArchiveFile and re-use that
2419
#       function
2420
#------------------------------------------------------------------------------
2421
{
2422
    # correct number of parameters?
2423
    if ( ($#_+1) != 3 )
2424
    {
1534 dpurdie 2425
        Error("Incorrect number of params passed to " .
2426
              "installDpkgArchiveAcHtmlFile() function. " ,
2427
              "Check deploy config.");
1530 dpurdie 2428
    }
2429
    my ($targetType, $sfile, $targetTag) = @_;
2430
 
2431
    # lets check to see if the source type and file actually exist
2432
    #
2433
    my($m_sDirLoc)  = "$DpkgAcHtmlDir/$targetType";
2434
    if( ! -d "$m_sDirLoc" )
2435
    {
1534 dpurdie 2436
        Error("Failed to locate [$targetType] AcHtml dir [$m_sDirLoc].");
1530 dpurdie 2437
    }
2438
 
2439
    # lets check to see if the file exists
2440
    #
2441
    my($m_sFileLoc) = "$DpkgAcHtmlDir/$targetType/$sfile";
2442
    if( ! -f "$m_sFileLoc" )
2443
    {
1534 dpurdie 2444
        Error("Failed to locate [$targetType] AcHtml file [$m_sFileLoc].");
1530 dpurdie 2445
    }
2446
 
2447
    # lets check to see if the target tag exists
2448
    # if does not the process with log an error.
2449
    #
2450
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2451
 
2452
    # know everything exists so lets do the biz.
2453
    #
2454
    # now we need to copy the file.
2455
    if(File::Copy::copy("$m_sFileLoc", "$targetValue"))
2456
    {
1534 dpurdie 2457
        Verbose("Copied [$targetType] AcHtml item [$sfile] to [$targetValue] ...");
1530 dpurdie 2458
    }
2459
    else
2460
    {
1534 dpurdie 2461
        Error("Failed to copy [$targetType] AcHtml item [$sfile]: $!");
1530 dpurdie 2462
    }
2463
 
2464
    return 1;
2465
}
2466
 
2467
 
2468
#------------------------------------------------------------------------------
2469
sub installDpkgArchiveRptFile
2470
#
2471
# Description:
2472
#       This sub-routine is used to install a rpt file from the
2473
#       dpkg_archive into the supplied install dir. 
2474
#
2475
#       It assumes based on the build type where the file will be located.
2476
#
2477
#       If it fails to find the file it will report an error and terminates
2478
#       processing.
2479
#
2480
#------------------------------------------------------------------------------
2481
{
2482
    # correct number of parameters?
2483
    if ( ($#_+1) != 2 )
2484
    {
1534 dpurdie 2485
        Error("Incorrect number of params passed to " .
2486
              "installDpkgArchiveRptFile() function. " ,
2487
              "Check deploy config.");
1530 dpurdie 2488
    }
2489
 
2490
    my ($sfile, $targetTag) = @_;
2491
 
2492
    # lets check to see if the target tag exists
2493
    # if does not the process with log an error.
2494
    #
2495
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2496
 
2497
 
2498
    # for now lets call the generic funtion to move all items
2499
    # in the associated dpkg_archive dir.
2500
    #
2501
    installDpkgArchiveFile("rpt", $sfile, $targetTag);
2502
 
2503
    return 1;
2504
}
2505
 
2506
 
2507
#------------------------------------------------------------------------------
2508
sub installDpkgArchiveRoxFile
2509
#
2510
# Description:
2511
#       This sub-routine is used to install a rox file from the
2512
#       dpkg_archive into the supplied install dir. 
2513
#
2514
#       It assumes based on the build type where the file will be located.
2515
#
2516
#       If it fails to find the file it will report an error and terminates
2517
#       processing.
2518
#
2519
#------------------------------------------------------------------------------
2520
{
2521
    # correct number of parameters?
2522
    if ( ($#_+1) != 2 )
2523
    {
1534 dpurdie 2524
        Error("Incorrect number of params passed to " .
2525
              "installDpkgArchiveRoxFile() function. " ,
2526
              "Check deploy config.");
1530 dpurdie 2527
    }
2528
 
2529
    my ($sfile, $targetTag) = @_;
2530
 
2531
    # lets check to see if the target tag exists
2532
    # if does not the process with log an error.
2533
    #
2534
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2535
 
2536
 
2537
    # for now lets call the generic funtion to move all items
2538
    # in the associated dpkg_archive dir.
2539
    #
2540
    installDpkgArchiveFile("rox", $sfile, $targetTag);
2541
 
2542
    return 1;
2543
}
2544
 
2545
 
2546
#------------------------------------------------------------------------------
2547
sub installDpkgArchiveDatFile
2548
#
2549
# Description:
2550
#       This sub-routine is used to install a dat file from the
2551
#       dpkg_archive into the supplied install dir. 
2552
#
2553
#       It assumes based on the build type where the file will be located.
2554
#
2555
#       If it fails to find the file it will report an error and terminates
2556
#       processing.
2557
#
2558
#------------------------------------------------------------------------------
2559
{
2560
    # correct number of parameters?
2561
    if ( ($#_+1) != 2 )
2562
    {
1534 dpurdie 2563
        Error("Incorrect number of params passed to " .
2564
              "installDpkgArchiveDatFile() function. " ,
2565
              "Check deploy config.");
1530 dpurdie 2566
    }
2567
 
2568
    my ($sfile, $targetTag) = @_;
2569
 
2570
    # lets check to see if the target tag exists
2571
    # if does not the process with log an error.
2572
    #
2573
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2574
 
2575
 
2576
    # for now lets call the generic funtion to move all items
2577
    # in the associated dpkg_archive dir.
2578
    #
2579
    installDpkgArchiveFile("dat", $sfile, $targetTag);
2580
 
2581
    return 1;
2582
}
2583
 
2584
 
2585
#------------------------------------------------------------------------------
2586
sub installDpkgArchiveThxFile
2587
#
2588
# Description:
2589
#       This sub-routine is used to install a thx file from the
2590
#       dpkg_archive into the supplied install dir. 
2591
#
2592
#       It assumes based on the build type where the file will be located.
2593
#
2594
#       If it fails to find the file it will report an error and terminates
2595
#       processing.
2596
#
2597
#------------------------------------------------------------------------------
2598
{
2599
    # correct number of parameters?
2600
    if ( ($#_+1) != 2 )
2601
    {
1534 dpurdie 2602
        Error("Incorrect number of params passed to " .
2603
              "installDpkgArchiveThxFile() function. " ,
2604
              "Check deploy config.");
1530 dpurdie 2605
    }
2606
 
2607
    my ($sfile, $targetTag) = @_;
2608
 
2609
    # lets check to see if the target tag exists
2610
    # if does not the process with log an error.
2611
    #
2612
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2613
 
2614
 
2615
    # for now lets call the generic funtion to move all items
2616
    # in the associated dpkg_archive dir.
2617
    #
2618
    installDpkgArchiveFile("thx", $sfile, $targetTag);
2619
 
2620
    return 1;
2621
}
2622
 
2623
 
2624
#------------------------------------------------------------------------------
2625
sub installDpkgArchiveMugFile
2626
#
2627
# Description:
2628
#       This sub-routine is used to install a mug file from the
2629
#       dpkg_archive into the supplied install dir. 
2630
#
2631
#       It assumes based on the build type where the file will be located.
2632
#
2633
#       If it fails to find the file it will report an error and terminates
2634
#       processing.
2635
#
2636
#------------------------------------------------------------------------------
2637
{
2638
    # correct number of parameters?
2639
    if ( ($#_+1) != 2 )
2640
    {
1534 dpurdie 2641
        Error("Incorrect number of params passed to " .
2642
              "installDpkgArchiveMugFile() function. " ,
2643
              "Check deploy config.");
1530 dpurdie 2644
    }
2645
 
2646
    my ($sfile, $targetTag) = @_;
2647
 
2648
    # lets check to see if the target tag exists
2649
    # if does not the process with log an error.
2650
    #
2651
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2652
 
2653
 
2654
    # for now lets call the generic funtion to move all items
2655
    # in the associated dpkg_archive dir.
2656
    #
2657
    installDpkgArchiveFile("mug", $sfile, $targetTag);
2658
 
2659
    return 1;
2660
}
2661
 
2662
 
2663
#------------------------------------------------------------------------------
2664
sub installDpkgArchiveInfoFilesFile
2665
#
2666
# Description:
2667
#       This sub-routine is used to install a infofiles file from the
2668
#       dpkg_archive into the supplied install dir. 
2669
#
2670
#       It assumes based on the build type where the file will be located.
2671
#
2672
#       If it fails to find the file it will report an error and terminates
2673
#       processing.
2674
#
2675
#------------------------------------------------------------------------------
2676
{
2677
    # correct number of parameters?
2678
    if ( ($#_+1) != 2 )
2679
    {
1534 dpurdie 2680
        Error("Incorrect number of params passed to " .
2681
              "installDpkgArchiveInfoFilesFile() function. " ,
2682
              "Check deploy config.");
1530 dpurdie 2683
    }
2684
 
2685
    my ($sfile, $targetTag) = @_;
2686
 
2687
    # lets check to see if the target tag exists
2688
    # if does not the process with log an error.
2689
    #
2690
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2691
 
2692
 
2693
    # for now lets call the generic funtion to move all items
2694
    # in the associated dpkg_archive dir.
2695
    #
2696
    installDpkgArchiveFile("infofiles", $sfile, $targetTag);
2697
 
2698
    return 1;
2699
}
2700
 
2701
 
2702
#------------------------------------------------------------------------------
2703
sub installDpkgArchiveSqlFile
2704
#
2705
# Description:
2706
#       This sub-routine is used to install a sql file from the
2707
#       dpkg_archive into the supplied install dir. 
2708
#
2709
#       It assumes based on the build type where the file will be located.
2710
#
2711
#       If it fails to find the file it will report an error and terminates
2712
#       processing.
2713
#
2714
#------------------------------------------------------------------------------
2715
{
2716
    # correct number of parameters?
2717
    if ( ($#_+1) != 2 )
2718
    {
1534 dpurdie 2719
        Error("Incorrect number of params passed to " .
2720
              "installDpkgArchiveSqlFile() function. " ,
2721
              "Check deploy config.");
1530 dpurdie 2722
    }
2723
 
2724
    my ($sfile, $targetTag) = @_;
2725
 
2726
    # lets check to see if the target tag exists
2727
    # if does not the process with log an error.
2728
    #
2729
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2730
 
2731
 
2732
    # for now lets call the generic funtion to move all items
2733
    # in the associated dpkg_archive dir.
2734
    #
2735
    installDpkgArchiveFile("sql", $sfile, $targetTag);
2736
 
2737
    return 1;
2738
}
2739
 
2740
 
2741
#------------------------------------------------------------------------------
2742
sub installDpkgArchiveWarFile
2743
#
2744
# Description:
2745
#       This sub-routine is used to install a war file from the
2746
#       dpkg_archive into the supplied install dir. 
2747
#
2748
#       It assumes based on the build type where the file will be located.
2749
#
2750
#       If it fails to find the file it will report an error and terminates
2751
#       processing.
2752
#
2753
#------------------------------------------------------------------------------
2754
{
2755
    # correct number of parameters?
2756
    if ( ($#_+1) != 2 )
2757
    {
1534 dpurdie 2758
        Error("Incorrect number of params passed to " .
2759
              "installDpkgArchiveWarFile() function. " ,
2760
              "Check deploy config.");
1530 dpurdie 2761
    }
2762
 
2763
    my ($sfile, $targetTag) = @_;
2764
 
2765
    # lets check to see if the target tag exists
2766
    # if does not the process with log an error.
2767
    #
2768
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2769
 
2770
 
2771
    # for now lets call the generic funtion to move all items
2772
    # in the associated dpkg_archive dir.
2773
    #
2774
    installDpkgArchiveFile("war", $sfile, $targetTag);
2775
 
2776
    return 1;
2777
}
2778
 
2779
 
2780
 
2781
#------------------------------------------------------------------------------
2782
sub installDpkgArchiveJarFile
2783
#
2784
# Description:
2785
#       This sub-routine is used to install a jar file from the
2786
#       dpkg_archive into the supplied install dir. 
2787
#
2788
#       It assumes based on the build type where the file will be located.
2789
#
2790
#       If it fails to find the file it will report an error and terminates
2791
#       processing.
2792
#
2793
#------------------------------------------------------------------------------
2794
{
2795
    # correct number of parameters?
2796
    if ( ($#_+1) != 2 )
2797
    {
1534 dpurdie 2798
        Error("Incorrect number of params passed to " .
2799
              "installDpkgArchiveJarFile() function. " ,
2800
              "Check deploy config.");
1530 dpurdie 2801
    }
2802
 
2803
    my ($sfile, $targetTag) = @_;
2804
 
2805
    # lets check to see if the target tag exists
2806
    # if does not the process with log an error.
2807
    #
2808
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2809
 
2810
 
2811
    # for now lets call the generic funtion to move all items
2812
    # in the associated dpkg_archive dir.
2813
    #
2814
    installDpkgArchiveFile("jar", $sfile, $targetTag);
2815
 
2816
    return 1;
2817
}
2818
 
2819
 
2820
 
2821
#------------------------------------------------------------------------------
2822
sub installDpkgArchiveSarFile
2823
#
2824
# Description:
2825
#       This sub-routine is used to install a sar file from the
2826
#       dpkg_archive into the supplied install dir. 
2827
#
2828
#       It assumes based on the build type where the file will be located.
2829
#
2830
#       If it fails to find the file it will report an error and terminates
2831
#       processing.
2832
#
2833
#------------------------------------------------------------------------------
2834
{
2835
    # correct number of parameters?
2836
    if ( ($#_+1) != 2 )
2837
    {
1534 dpurdie 2838
        Error("Incorrect number of params passed to " .
2839
              "installDpkgArchiveSarFile() function. " ,
2840
              "Check deploy config.");
1530 dpurdie 2841
    }
2842
 
2843
    my ($sfile, $targetTag) = @_;
2844
 
2845
    # lets check to see if the target tag exists
2846
    # if does not the process with log an error.
2847
    #
2848
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2849
 
2850
 
2851
    # for now lets call the generic funtion to move all items
2852
    # in the associated dpkg_archive dir.
2853
    #
2854
    installDpkgArchiveFile("sar", $sfile, $targetTag);
2855
 
2856
    return 1;
2857
}
2858
 
2859
 
2860
 
2861
 
2862
 
2863
#------------------------------------------------------------------------------
2864
sub installDpkgArchiveEtcFile
2865
#
2866
# Description:
2867
#       This sub-routine is used to install an etc file from the
2868
#       dpkg_archive into the supplied install dir. 
2869
#
2870
#       It assumes based on the build type where the file will be located.
2871
#
2872
#       If it fails to find the file it will report an error and terminates
2873
#       processing.
2874
#
2875
#------------------------------------------------------------------------------
2876
{
2877
    # correct number of parameters?
2878
    if ( ($#_+1) != 2 )
2879
    {
1534 dpurdie 2880
        Error("Incorrect number of params passed to " .
2881
              "installDpkgArchiveEtcFile() function. " ,
2882
              "Check deploy config.");
1530 dpurdie 2883
    }
2884
 
2885
    my ($sfile, $targetTag) = @_;
2886
 
2887
    # lets check to see if the target tag exists
2888
    # if does not the process with log an error.
2889
    #
2890
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2891
 
2892
 
2893
    # for now lets call the generic funtion to move all items
2894
    # in the associated dpkg_archive dir.
2895
    #
2896
    installDpkgArchiveFile("etc", $sfile, $targetTag);
2897
 
2898
    return 1;
2899
}
2900
 
2901
 
2902
#------------------------------------------------------------------------------
2903
sub installDpkgArchiveScriptsFile
2904
#
2905
# Description:
2906
#       This sub-routine is used to install a scripts file from the
2907
#       dpkg_archive into the supplied install dir. 
2908
#
2909
#       It assumes based on the build type where the file will be located.
2910
#
2911
#       If it fails to find the file it will report an error and terminates
2912
#       processing.
2913
#
2914
#------------------------------------------------------------------------------
2915
{
2916
    # correct number of parameters?
2917
    if ( ($#_+1) != 2 )
2918
    {
1534 dpurdie 2919
        Error("Incorrect number of params passed to " .
2920
              "installDpkgArchiveScriptsFile() function. " ,
2921
              "Check deploy config.");
1530 dpurdie 2922
    }
2923
 
2924
   my ($sfile, $targetTag) = @_;
2925
 
2926
    # lets check to see if the target tag exists
2927
    # if does not the process with log an error.
2928
    #
2929
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2930
 
2931
 
2932
    # for now lets call the generic funtion to move all items
2933
    # in the associated dpkg_archive dir.
2934
    #
2935
    installDpkgArchiveFile("scripts", $sfile, $targetTag);
2936
 
2937
    return 1;
2938
}
2939
 
2940
 
2941
 
2942
#------------------------------------------------------------------------------
2943
sub installDpkgArchiveIncludeFile
2944
#
2945
# Description:
2946
#       This sub-routine is used to install a include file from the
2947
#       dpkg_archive into the supplied install dir. 
2948
#
2949
#       It assumes based on the build type where the file will be located.
2950
#
2951
#       If it fails to find the file it will report an error and terminates
2952
#       processing.
2953
#
2954
#------------------------------------------------------------------------------
2955
{
2956
    # correct number of parameters?
2957
    if ( ($#_+1) != 2 )
2958
    {
1534 dpurdie 2959
        Error("Incorrect number of params passed to " .
2960
              "installDpkgArchiveIncludeFile() function. " ,
2961
              "Check deploy config.");
1530 dpurdie 2962
    }
2963
 
2964
   my ($sfile, $targetTag) = @_;
2965
 
2966
    # lets check to see if the target tag exists
2967
    # if does not the process with log an error.
2968
    #
2969
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
2970
 
2971
 
2972
    # for now lets call the generic funtion to move all items
2973
    # in the associated dpkg_archive dir.
2974
    #
2975
    installDpkgArchiveFile("include", $sfile, $targetTag);
2976
 
2977
    return 1;
2978
}
2979
 
2980
 
2981
 
2982
#------------------------------------------------------------------------------
2983
sub installDpkgArchiveDocFile
2984
#
2985
# Description:
2986
#       This sub-routine is used to install a include file from the
2987
#       dpkg_archive into the supplied install dir. 
2988
#
2989
#       It assumes based on the build type where the file will be located.
2990
#
2991
#       If it fails to find the file it will report an error and terminates
2992
#       processing.
2993
#
2994
#------------------------------------------------------------------------------
2995
{
2996
    # correct number of parameters?
2997
    if ( ($#_+1) != 2 )
2998
    {
1534 dpurdie 2999
        Error("Incorrect number of params passed to " .
3000
              "installDpkgArchiveDocFile() function. " ,
3001
              "Check deploy config.");
1530 dpurdie 3002
    }
3003
 
3004
   my ($sfile, $targetTag) = @_;
3005
 
3006
    # lets check to see if the target tag exists
3007
    # if does not the process with log an error.
3008
    #
3009
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
3010
 
3011
 
3012
    # for now lets call the generic funtion to move all items
3013
    # in the associated dpkg_archive dir.
3014
    #
3015
    installDpkgArchiveFile("doc", $sfile, $targetTag);
3016
 
3017
    return 1;
3018
}
3019
 
3020
 
3021
#------------------------------------------------------------------------------
3022
sub installDpkgArchiveBinFile
3023
#
3024
# Description:
3025
#       This sub-routine is used to install a binary file from the
3026
#       dpkg_archive into the supplied install dir. 
3027
#
3028
#       It assumes based on the build type where the file will be located.
3029
#
3030
#       If it fails to find the file it will report an error and terminates
3031
#       processing.
3032
#
3033
# Inputs          :     $sfile              - Name of source file
3034
#                                             or a reference to a list of files
3035
#                       $targetTag          - Symbolic name of target
3036
#                       Options             - Optional options
3037
#
3038
# Options:
3039
#                   --SelectFrom=xxxx       - Limits foile source selection
3040
#                                             By default all LIB sources are searched.
3041
#                                             The selector should be a Platform, Product
3042
#                                             ,Target or MachineType
3043
#
3044
#
3045
# Returns         :     Nothing of use
3046
#                       Will not return if the file is not found
3047
#
3048
#------------------------------------------------------------------------------
3049
{
3050
    my @args;
3051
    my $select = '_ALL_';
3052
 
3053
    #
3054
    #   Process parameters and extract options
3055
    #
3056
    foreach  ( @_ )
3057
    {
3058
        if ( m/^--SelectFrom=(.*)/ ) {
3059
            $select = $1;
1534 dpurdie 3060
            Error("installDpkgArchiveBinFile: Selector not known: $_")
1530 dpurdie 3061
                unless ( defined $DpkgLibDirList{$select} );
3062
 
3063
        } elsif ( m/^--/ ) {
1534 dpurdie 3064
            Warning ("installDpkgArchiveBinFile: Unknown option ignored: $_")
1530 dpurdie 3065
 
3066
        } else {
3067
            push @args, $_;
3068
        }
3069
    }
3070
 
3071
 
3072
    # correct number of parameters?
3073
    my ($fref, $targetTag) = @_;
3074
    if ( $#args != 1 )
3075
    {
1534 dpurdie 3076
        Error("Incorrect number of params passed to " .
3077
              "installDpkgArchiveBinFile() function. " ,
3078
              "Check deploy config.");
1530 dpurdie 3079
    }
3080
 
3081
    # lets check to see if the target tag exists
3082
    # if does not the process with log an error.
3083
    #
3084
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
3085
 
3086
    #
3087
    #   Process the file name
3088
    #   This will either be a scalar name, or a reference to an array of names
3089
    #   If the user has provided an array of names then expand the list
3090
    #
3091
    #   Convert $fref into an reference to a list
3092
    #
3093
    my @one_file;
3094
    unless ( ref ( $fref ) eq 'ARRAY' )
3095
    {
3096
        push @one_file, $fref;
3097
        $fref = \@one_file;
3098
    }
3099
 
3100
    foreach my $sfile ( @$fref )
3101
    {
3102
 
3103
        if ( "$MachType" eq "win32" )
3104
        {
3105
            # if the item does not have an .exe extention
3106
            # we shall add one for convience.
3107
            #
3108
            if ( $sfile !~ m/\.exe$/  &&
3109
                 $sfile !~ m/\.dll$/ )
3110
            {
3111
                $sfile = $sfile . ".exe";
3112
            }
3113
        }
3114
 
3115
 
3116
        my ($i);
3117
        my ($foundFileFlag) = "false";
3118
        my ($m_DpkgBinDir)  = "";
3119
        my ($m_srcFileLocation) = "";
3120
        my ($m_dstFileLocation) = "";
3121
        foreach $i (@{$DpkgBinDirList{$select}})
3122
        {
3123
            $m_DpkgBinDir = "$DpkgBinDir" . "/$i";
3124
            if ( ! -d "$m_DpkgBinDir" )
3125
            {
1534 dpurdie 3126
                Debug("Directory [$m_DpkgBinDir] not found.");
1530 dpurdie 3127
                next;
3128
            }
3129
 
3130
            # lets define the absolute location of the file
3131
            $m_srcFileLocation = "$m_DpkgBinDir/$sfile";
3132
            $m_dstFileLocation = "$targetValue/$sfile";
3133
 
3134
            # we will check to see if the file exists.
3135
            #
3136
            if ( -f "$m_srcFileLocation" )
3137
            {
3138
                # now we need to copy the file.
3139
                if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
3140
                {
1534 dpurdie 3141
                    Verbose("Copied Bin [$sfile] to [$m_dstFileLocation] ...");
1530 dpurdie 3142
                    $foundFileFlag = "true";
3143
 
3144
                    # no need to go further, we have found the file.
3145
                    #
3146
                    last;
3147
                }
3148
                else
3149
                {
1534 dpurdie 3150
                    Error("Failed to copy binary [$sfile]: $!");
1530 dpurdie 3151
                }
3152
            }
3153
            # else we have not found the file yet!
3154
        }
3155
 
3156
        # if we do not find the file at all we need to inform
3157
        # the user.
3158
        #
3159
        if ( "$foundFileFlag" eq "false" )
3160
        {
1534 dpurdie 3161
            Error("Dpkg_archive bin file [$sfile] does not exist or is not in correct directory structure.");
1530 dpurdie 3162
        }
3163
    }
3164
 
3165
    return 1;
3166
}
3167
 
3168
 
3169
#------------------------------------------------------------------------------
3170
sub installDpkgArchiveLibFile
3171
#
3172
# Description:
3173
#       This sub-routine is used to install a binary file from the
3174
#       dpkg_archive into the supplied install location dir.
3175
#
3176
#       It assumes based on the build type where the file will be located.
3177
#
3178
#       If it fails to find the file it will report an error and terminates
3179
#       processing.
3180
#
3181
#       Added optional 3rd parameter & if set to NoLinks then no generic named
3182
#       libs will be created
3183
#
1534 dpurdie 3184
# Inputs          :     $sfile              - Name of source file OR
3185
#                                             A --Filter specification ( below)
3186
#                                             A reference to a list of files OR
1530 dpurdie 3187
#                       $targetTag          - Symbolic name of target
3188
#                       $links              - Optional. 'nolinks' will supress generic named libs
3189
#                       Options             - Optional options
3190
#
3191
# Options:
1534 dpurdie 3192
#                   --NoLink                - same as 3rd arg == nolinks
1530 dpurdie 3193
#                   --Link                  - Default
3194
#                   --SelectFrom=xxxx       - Limits foile source selection
3195
#                                             By default all LIB sources are searched.
3196
#                                             The selector should be a Platform, Product
3197
#                                             ,Target or MachineType
3198
#
1534 dpurdie 3199
# SourceFile options:
3200
#                   Source files may be a filter rule which will expand to
3201
#                   one or more files.
3202
#                       --FilterIn=xx
3203
#                       --FilterInRE=xx
3204
#                       --FilterOut=xx
3205
#                       --FilterOutRE=xx
1530 dpurdie 3206
#
1534 dpurdie 3207
#                     Notes:    --FilterIn=xxxx, --FilterOut=xxx
3208
#                               xxx is a simple Shell style filter where:
3209
#                                   * means one or more charters        '*.EXE'
3210
#                                   ? means a single character          '*.?'
3211
#                                   [abc] means either a or b or c      'file.[ch]'
3212
#
3213
#                               --FilterInRE=xxx, --FilterOutRE=xxx
3214
#                               xxx is a Regular Expression. There are harder to use but very
3215
#                               powerful. ie '.*\.EXE$'
3216
#
3217
#                               The 'In' filters are applied before the 'Out' filters.
3218
#
3219
#                               Multiple options may be joined with a comma.
3220
#
1530 dpurdie 3221
# Returns         :     Nothing of use
3222
#                       Will not return if the file is not found
3223
#
3224
#------------------------------------------------------------------------------
3225
{
3226
    my @args;
3227
    my $links = 1;
3228
    my $select = '_ALL_';
3229
 
3230
    #
3231
    #   Process parameters and extract options
3232
    #
3233
    foreach  ( @_ )
3234
    {
3235
        if ( m/^--NoLink/ ) {
3236
            $links = 0;
3237
 
3238
        } elsif ( m/^--Link/ ) {
3239
            $links = 1;
3240
 
3241
        } elsif ( m/^--SelectFrom=(.*)/ ) {
3242
            $select = $1;
1534 dpurdie 3243
            Error("installDpkgArchiveLibFile: Selector not known: $_")
1530 dpurdie 3244
                unless ( defined $DpkgLibDirList{$select} );
3245
 
1534 dpurdie 3246
        } elsif ( m/^--Filter.*=/ ) {
3247
            push @args, $_;
3248
 
1530 dpurdie 3249
        } elsif ( m/^--/ ) {
1534 dpurdie 3250
            Warning ("installDpkgArchiveLibFile: Unknown option ignored: $_")
1530 dpurdie 3251
 
3252
        } else {
3253
            push @args, $_;
3254
        }
3255
    }
3256
 
3257
    #
3258
    #   Handle the optional 3rd argument
3259
    #
3260
    if ( $args[2] )
3261
    {
3262
        $links = $args[2] !~ m/nolink/i;
3263
        delete $args[2];
3264
    }
3265
 
3266
    # correct number of parameters?
3267
    my ($fref, $targetTag) = @_;
3268
    if ( $#args != 1 )
3269
    {
1534 dpurdie 3270
        Error("Incorrect number of params passed to " .
3271
              "installDpkgArchiveLibFile() function. " ,
3272
              "Check deploy config.");
1530 dpurdie 3273
    }
3274
 
3275
    #
3276
    # Check to see if the target tag exists
3277
    # If does not the process with log an error.
3278
    #
3279
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
3280
 
3281
    #
3282
    #   Process the file name
3283
    #   This will either be a scalar name, or a reference to an array of names
3284
    #   If the user has provided an array of names then expand the list
3285
    #
3286
    #   Convert $fref into an reference to a list
3287
    #
3288
    my @one_file;
3289
    unless ( ref ( $fref ) eq 'ARRAY' )
3290
    {
3291
        push @one_file, $fref;
3292
        $fref = \@one_file;
3293
    }
3294
 
1534 dpurdie 3295
    #
3296
    #   If the source file contains a pattern, then expand the pattern
3297
    #   This may result in multiple files.
3298
    #   Note: Allow for a single entry of the form
3299
    #           --Filterin=xxx,---FilterOut=yyy
3300
    #
3301
    my @flist;
3302
    my @dir_tree_exclude;
3303
    my @dir_tree_include;
3304
    foreach my $element ( @$fref )
1530 dpurdie 3305
    {
1534 dpurdie 3306
        foreach  ( split /,/ , $element )
3307
        {
3308
            if ( /^--FilterOut=(.*)/ ) {
3309
                push @dir_tree_exclude, glob2pat($1);
1530 dpurdie 3310
 
1534 dpurdie 3311
            } elsif ( /^--FilterOutRE=(.*)/ ) {
3312
                push @dir_tree_exclude, $1;
1530 dpurdie 3313
 
1534 dpurdie 3314
            } elsif ( /^--FilterIn=(.*)/ ) {
3315
                push @dir_tree_include, glob2pat($1);
3316
 
3317
            } elsif ( /^--FilterInRE=(.*)/ ) {
3318
                push @dir_tree_include, $1;
3319
 
3320
            } elsif ( m/^--/ ) {
3321
                Warning( "installDpkgArchiveLibFile: Unknown Filter option ignored: $_");
3322
 
3323
            } else {
3324
                push @flist, $_;
3325
            }
3326
        }
3327
    }
3328
 
3329
    #
3330
    #   If any patterns have been found, then expand them
3331
    #
3332
    if ( @dir_tree_exclude || @dir_tree_include )
3333
    {
3334
        foreach my $i (@{$DpkgLibDirList{$select}})
3335
        {
3336
            my @elements = ExpandDirTree( "$DpkgLibDir/$i", \@dir_tree_exclude, \@dir_tree_include, 0 );
3337
 
3338
            #
3339
            #   Clean off any leading / from each filename then add to a list
3340
            #   Remove any duplicates that were found
3341
            #
3342
            map { $_ =~ s~^/~~ } @elements;
3343
            UniquePush \@flist, @elements;
3344
        }
3345
    }
3346
 
3347
 
3348
    #
3349
    #   Process each file
3350
    #
3351
    foreach my $sfile ( @flist )
3352
    {
3353
 
1530 dpurdie 3354
        # we exclude .dll files if this is a sparc build
3355
        #
3356
        if ( "$MachType" eq "sparc"  &&
3357
             $sfile =~ m/\.dll/
3358
           )
3359
        {
1534 dpurdie 3360
            Verbose("Excluding item [$sfile] from build, as we do not deliver dlls for this machine type [$MachType].");
1530 dpurdie 3361
            return 1;
3362
        }
3363
 
3364
        # we exclude .so files if this is a win32 build
3365
        #
3366
        if ( "$MachType" eq "win32"  &&
3367
             $sfile =~ m/\.so/
3368
           )
3369
        {
1534 dpurdie 3370
            Verbose("Excluding item [$sfile] from build, as we do not deliver sosss for this machine type [$MachType].");
1530 dpurdie 3371
            return 1;
3372
        }
3373
 
3374
        my ($libName) = $sfile;
3375
        if ( "$MachType" eq "sparc" )
3376
        {
3377
            $libName =~ s/\.so.*$//;
3378
        }
3379
 
3380
        # lets define the absolute location of the file
3381
        my ($m_srcFileLocation) = "";
3382
        my ($m_dstFileLocation) = "";
3383
        my ($m_DpkgLibDir) = "";
3384
 
3385
        my ($i);
3386
        my ($j);
3387
        my ($count);
3388
        my ($foundFileFlag) = "false";
3389
        my ($ExcludedFlag) = "false";
3390
 
3391
        #
3392
        #   Search all the 'lib' locations, or a specified subset
3393
        #
3394
        foreach $i (@{$DpkgLibDirList{$select}})
3395
        {
3396
 
3397
            $m_DpkgLibDir = "$DpkgLibDir" . "/$i";
3398
            if ( ! -d "$m_DpkgLibDir" )
3399
            {
1534 dpurdie 3400
                Debug("Directory [$m_DpkgLibDir] not found.");
1530 dpurdie 3401
                next;
3402
            }
3403
 
1534 dpurdie 3404
 
1530 dpurdie 3405
            $m_srcFileLocation = "$m_DpkgLibDir/$sfile";
3406
            $m_dstFileLocation = "$targetValue/$sfile";
3407
 
3408
 
3409
            # we only want debug items in a debug build
3410
            #
3411
            if(excludeItemFromBuild($sfile))
3412
            {
1534 dpurdie 3413
                Verbose("Excluding item [$sfile] from build as not compatible with build type [$BuildType].");
1530 dpurdie 3414
                $ExcludedFlag = "true";
3415
            }
3416
            else
3417
            {
3418
                # we need to ensure that only a single version/entry of the lib exists in the lib list
3419
                #
3420
                $count = 1;
3421
                foreach $j (@LibCheckList)
3422
                {
3423
                    if ( $j =~ m/^$libName$/ )
3424
                    {
3425
                        $count++;
3426
                    }
3427
 
3428
                    if ( $count > 1 )
3429
                    {
1534 dpurdie 3430
                        Error("Detected multiple references of lib [$libName] in lib list, check item [$sfile].");
1530 dpurdie 3431
                    }
3432
                }
3433
 
3434
                # we will check to see if the file exists.
3435
                #
3436
                if ( -f "$m_srcFileLocation" )
3437
                {
3438
                    # now we need to copy the file.
3439
 
3440
                    # we also want to create a generically named copy
1534 dpurdie 3441
                    # of the library. ie:
3442
                    #       libraryP.nn.nn.nn.dll -> library.dll, libraryP.dll
3443
                    #       libraryP.so.nn.nn.nn  -> library.so, libraryP.so
1530 dpurdie 3444
                    #
3445
                    my ($gName)    = $sfile;
3446
                    my ($nVerName) = $sfile;
3447
                    $gName = removeBuildTypeFromItemName($sfile);
3448
                    $gName = removeVersionNumberFromItemName($gName);
3449
                    $nVerName = removeVersionNumberFromItemName($sfile);
3450
 
3451
                    if(File::Copy::copy("$m_srcFileLocation", "$m_dstFileLocation"))
3452
                    {
1534 dpurdie 3453
                        Verbose("Copied Lib [$sfile] to [$m_dstFileLocation] ...");
1530 dpurdie 3454
                        $foundFileFlag = "true";
3455
 
3456
                        if ( $links && ( "x$PkgPatchID" eq "x" || "$MachType" eq "win32") )
3457
                        {
3458
                            # normal build or if we are building win32 we want generic names
3459
 
3460
                            # we want to create a copy of our target using
3461
                            # the generic name
3462
                            if ( $sfile ne $nVerName )
3463
                            {
3464
                                createGenericCopy("$sfile", "$m_srcFileLocation", "$nVerName", "$targetValue");
3465
                            }
3466
                            if ( $sfile ne $gName )
3467
                            {
3468
                                createGenericCopy("$sfile", "$m_srcFileLocation", "$gName",    "$targetValue");
3469
                            }
3470
                        }
3471
 
3472
 
3473
                        # lets add this lib to our check list for next time.
3474
                        #
3475
                        push @LibCheckList, $libName;
3476
 
3477
                        # no need to go further, implies we found the file!
3478
                        #
3479
                        last;
3480
                    }
3481
                    else
3482
                    {
3483
                        # here found the file but we had some trouble
3484
                        #
1534 dpurdie 3485
                        Error("Failed to copy lib [$m_srcFileLocation]: $!");
1530 dpurdie 3486
                    }
3487
 
3488
                }
3489
                # else have not found the file yet!
3490
            }
3491
        }
3492
 
3493
        # if we do not find the file at all we need to inform
3494
        # the user.
3495
        #
3496
        if ( "$foundFileFlag" eq "false" && $ExcludedFlag eq "false" )
3497
        {
1534 dpurdie 3498
            Error("Dpkg_archive lib file [$sfile] does not exist or is not in correct directory structure.");
1530 dpurdie 3499
        }
3500
    }
3501
 
3502
    return 1;
3503
}
3504
 
3505
 
3506
#------------------------------------------------------------------------------
3507
sub installPkgAddConfigFile
3508
#
3509
# Description:
3510
#       This sub-routine is used to install a package config file from a supplied
3511
#       source location to a predefined destination location that is based on
3512
#       the build type.
3513
#
3514
#       The sub routine also updates to the prototype file with an appropriate
3515
#       entry for the associated file.
3516
#
3517
#       If it has any problems it will log an error and stop processing.
3518
#
3519
#------------------------------------------------------------------------------
3520
{
3521
    # correct number of parameters?
3522
    if ( ($#_+1) != 3 )
3523
    {
1534 dpurdie 3524
        Error("Incorrect number of params passed to " .
3525
              "installPkgAddConfigFile() function. " ,
3526
              "Check deploy config.");
1530 dpurdie 3527
    }
3528
 
3529
    # lets just check to see if we can execute this function on
3530
    # this machine.
3531
    #
3532
    if ( "$MachType" ne "sparc" )
3533
    {
1534 dpurdie 3534
        Verbose("installPkgAddConfigFile() not supported on this machine type.");
1530 dpurdie 3535
        return 1;
3536
    }
3537
 
3538
 
3539
    my ($sDirTag, $sfile, $tfile) = @_;
3540
 
3541
 
3542
    # we must have a filename.
3543
    #
3544
    if ( "x$sfile" eq "x" )
3545
    {
1534 dpurdie 3546
        Error("Source filename not supplied. Check deploy config.");
1530 dpurdie 3547
    }
3548
 
3549
 
3550
    # lets check to see if the local src dir tag exists
3551
    # if does not the process with log an error.
3552
    #
3553
    my ($sDirValue) = getLocalDirValue("$sDirTag", "A");
3554
 
3555
 
3556
    # lets check to see if the source file exists
3557
    #
3558
    if ( ! -f "$sDirValue/$sfile" )
3559
    {
1534 dpurdie 3560
        Error("Failed to find local source file [$sDirValue/$sfile].");
1530 dpurdie 3561
    }
3562
 
3563
    if ( ! -f "$ProtoTypeFile" )
3564
    {
1534 dpurdie 3565
        Error("Prototype file [$ProtoTypeFile] does not exist.",
3566
              "Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function.",
3567
              "Check deploy config.");
1530 dpurdie 3568
    }
3569
 
3570
 
3571
    # lets determine which prototype file we are going to
3572
    # use
3573
    my ($dFileName);
3574
    $dFileName     = "$PkgBaseDir/$sfile";
3575
 
3576
    # lets copy the file
3577
    #
3578
    if(File::Copy::copy("$sDirValue/$sfile", "$dFileName"))
3579
    {
1534 dpurdie 3580
        Verbose("Copied [$sfile] to [$dFileName] ...");
1530 dpurdie 3581
    }
3582
    else
3583
    {
1534 dpurdie 3584
        Error("Failed to copy local source file [$sDirValue/$sfile]: $!"); 
1530 dpurdie 3585
    }
3586
 
3587
 
3588
    # now we need to update the prototype file
3589
    #
3590
    local *FILE;
3591
    open ( FILE, ">> $ProtoTypeFile") or
1534 dpurdie 3592
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 3593
    printf FILE ("i $tfile=$sfile\n");
3594
    close (FILE);
3595
 
3596
 
3597
    return 1;
3598
}
3599
 
3600
 
3601
#------------------------------------------------------------------------------
3602
sub installPkgAddSystemClassFile
3603
#
3604
# Description:
3605
#       This sub-routine is used to install a package system class file from a supplied
3606
#       source location to a predefined destination location the class type is also 
3607
#       supplied and must be sed, awk, build or preserve
3608
#
3609
#       The sub routine also updates to the prototype file with an appropriate
3610
#       entry for the associated file.
3611
#
3612
#       If it has any problems it will log an error and stop processing.
3613
#
3614
#------------------------------------------------------------------------------
3615
{
3616
    # correct number of parameters?
3617
    if ( ($#_+1) != 4 )
3618
    {
1534 dpurdie 3619
        Error("Incorrect number of params passed to " .
3620
              "installPkgAddConfigFile() function. " ,
3621
              "Check deploy config.");
1530 dpurdie 3622
    }
3623
 
3624
    # lets just check to see if we can execute this function on
3625
    # this machine.
3626
    #
3627
    if ( "$MachType" ne "sparc" )
3628
    {
1534 dpurdie 3629
        Verbose("installPkgAddConfigFile() not supported on this machine type.");
1530 dpurdie 3630
        return 1;
3631
    }
3632
 
3633
 
3634
    my ($sDirTag, $sfile, $tfile, $class) = @_;
3635
 
3636
    if ( $class ne "sed" && $class ne "build" && $class ne "awk" && $class ne "preserve" )
3637
    {
1534 dpurdie 3638
        Error("Class Name for System Class File can only be one of sed, build, awk or preserve");
1530 dpurdie 3639
    }
3640
 
3641
    # we must have a filename.
3642
    #
3643
    if ( "x$sfile" eq "x" )
3644
    {
1534 dpurdie 3645
        Error("Source filename not supplied. Check deploy config.");
1530 dpurdie 3646
    }
3647
 
3648
 
3649
    # lets check to see if the local src dir tag exists
3650
    # if does not the process with log an error.
3651
    #
3652
    my ($sDirValue) = getLocalDirValue("$sDirTag", "A");
3653
 
3654
 
3655
    # lets check to see if the source file exists
3656
    #
3657
    if ( ! -f "$sDirValue/$sfile" )
3658
    {
1534 dpurdie 3659
        Error("Failed to find local source file [$sDirValue/$sfile].");
1530 dpurdie 3660
    }
3661
 
3662
    if ( ! -f "$ProtoTypeFile" )
3663
    {
1534 dpurdie 3664
        Error("Prototype file [$ProtoTypeFile] does not exist.",
3665
              "Ensure createPrototypeFile() function has been called before executing installPkgAddConfigFile() function.",
3666
              "Check deploy config.");
1530 dpurdie 3667
    }
3668
 
3669
 
3670
    # lets determine which prototype file we are going to
3671
    # use
3672
    my ($dFileName);
3673
    $dFileName     = "$PkgBaseDir/$sfile";
3674
 
3675
    # lets copy the file
3676
    #
3677
    if(File::Copy::copy("$sDirValue/$sfile", "$dFileName"))
3678
    {
1534 dpurdie 3679
        Verbose("Copied [$sfile] to [$dFileName] ...");
1530 dpurdie 3680
    }
3681
    else
3682
    {
1534 dpurdie 3683
        Error("Failed to copy local source file [$sDirValue/$sfile]: $!"); 
1530 dpurdie 3684
    }
3685
 
3686
 
3687
    # now we need to update the prototype file
3688
    #
3689
    local *FILE;
3690
    open ( FILE, ">> $ProtoTypeFile") or
1534 dpurdie 3691
        Error("Failed to open file [$ProtoTypeFile].");
1530 dpurdie 3692
    printf FILE ("e $class $tfile=$sfile ? ? ?\n");
3693
    close (FILE);
3694
 
3695
 
3696
    return 1;
3697
}
3698
 
3699
 
3700
 
3701
#------------------------------------------------------------------------------
3702
sub updatePrototypeFileAddItem
3703
#
3704
# Description:
3705
#       This sub-routine is used to update the prototype file with an
3706
#       extra package add item. Here we pre-pend the ERGAFC_BASEDIR to the
3707
#       destination item.
3708
#
3709
#       The only item type we support at this stage are "s" and "f" types.
3710
#
3711
#       You also need to supply the source tag, destination tag, user id, group id 
3712
#       and permissions associated to this item.
3713
#
3714
#       If it has any problems it will log an error and stop processing.
3715
#
3716
#------------------------------------------------------------------------------
3717
{
3718
    # correct number of parameters?
3719
    if ( ($#_+1) != 6 )
3720
    {
1534 dpurdie 3721
        Error("Incorrect number of params passed to " .
3722
              "updatePrototypeFileAddItem() function. " ,
3723
              "Check deploy config.");
1530 dpurdie 3724
    }
3725
 
3726
 
3727
    # lets just check to see if we can execute this function on
3728
    # this machine.
3729
    #
3730
    if ( "$MachType" ne "sparc" )
3731
    {
1534 dpurdie 3732
        Verbose("updatePrototypeFileAddItem() not supported on this machine type.");
1530 dpurdie 3733
        return 1;
3734
    }
3735
 
3736
    my ($sTag, $dTag, $perms, $uid, $gid, $type) = @_;
3737
 
3738
    # lets determine which prototype file we are going to
3739
    # use
3740
    my ($protoTypeFile);
3741
    $protoTypeFile = "$ProtoTypeFile";
3742
 
3743
 
3744
    # lets check the valid types
3745
    $type = uc($type);
3746
    if ( "$type" !~ /S/ )
3747
    {
1534 dpurdie 3748
        Error("Invalid type field supplied in updatePrototypeFileAddItem(). Check deploy config.");
1530 dpurdie 3749
    }
3750
 
3751
    # now we need to update the prototype file
3752
    #
3753
    local *FILE;
3754
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 3755
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3756
 
3757
    my($m_Str)=""; 
3758
    if ( "$type" eq "S" )
3759
    {
3760
        $m_Str = "s none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";
1534 dpurdie 3761
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3762
    }
3763
    else
3764
    {
3765
        $m_Str = "f none $sTag=$ERGAFC_BASEDIR/$dTag $perms $uid $gid";
1534 dpurdie 3766
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3767
    }
3768
    printf FILE ("$m_Str\n");
3769
    close (FILE);
3770
 
3771
    return 1;
3772
}
3773
 
3774
 
3775
#------------------------------------------------------------------------------
3776
sub updatePrototypeFileAddItem2
3777
#
3778
# Description:
3779
#       This sub-routine is used to update the prototype file with an
3780
#       extra package add item. Here we do not pre-append the 
3781
#       ERGAFC_BASEDIR to the destination item.
3782
#
3783
#       The only item type we support at this stage are "s", "i" and "e" types.
3784
#
3785
#       You also need to supply the source tag, destination tag, user id, group id 
3786
#       and permissions associated to this item.
3787
#
3788
#       If it has any problems it will log an error and stop processing.
3789
#
3790
#------------------------------------------------------------------------------
3791
{
3792
    # correct number of parameters?
3793
    if ( ($#_+1) != 6 && ($#_+1) != 7 )
3794
    {
1534 dpurdie 3795
        Error("Incorrect number of params passed to " .
3796
              "updatePrototypeFileAddItem2() function. " ,
3797
              "Check deploy config.");
1530 dpurdie 3798
    }
3799
 
3800
 
3801
    # lets just check to see if we can execute this function on
3802
    # this machine.
3803
    #
3804
    if ( "$MachType" ne "sparc" )
3805
    {
1534 dpurdie 3806
        Verbose("updatePrototypeFileAddItem2() not supported on this machine type.");
1530 dpurdie 3807
        return 1;
3808
    }
3809
 
3810
    # class must be last as it is optional
3811
    my ($sTag, $dTag, $perms, $uid, $gid, $type, $class) = @_;
3812
 
3813
    $class = "none" if ( ($#_+1) == 6 );
3814
 
3815
    # lets determine which prototype file we are going to
3816
    # use
3817
    my ($protoTypeFile);
3818
    $protoTypeFile = "$ProtoTypeFile";
3819
 
3820
    # lets check the valid types
3821
    $type = uc($type);
3822
    if ( "$type" !~ /S/ && "$type" !~ /I/ && "$type" !~ /E/ )
3823
    {
1534 dpurdie 3824
        Error("Invalid type field supplied in updatePrototypeFileAddItem2(). Check deploy config.");
1530 dpurdie 3825
    }
3826
 
3827
    # now we need to update the prototype file
3828
    #
3829
    local *FILE;
3830
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 3831
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3832
 
3833
    my($m_Str)="";
3834
    if ( "$type" eq "S" )
3835
    {
3836
        $m_Str = "s $class $sTag=$dTag $perms $uid $gid";
1534 dpurdie 3837
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3838
    }
3839
    elsif ( "$type" eq "E" )
3840
    {
3841
        $m_Str = "e $class $sTag=$dTag $perms $uid $gid";
1534 dpurdie 3842
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3843
    }
3844
    else
3845
    {
3846
        $m_Str = "i $sTag=$dTag";
1534 dpurdie 3847
        Verbose("Updated prototype file with entry [$m_Str]");
1530 dpurdie 3848
    }
3849
    printf FILE ("$m_Str\n");
3850
    close (FILE);
3851
 
3852
    return 1;
3853
}
3854
 
3855
 
3856
#------------------------------------------------------------------------------
3857
sub addPath2Prototype
3858
#
3859
# Description:
3860
#       This sub-routine is used to add directory entries to the prototype file
3861
#   to make sure the supplied path exists in the prototype file
3862
#
3863
#------------------------------------------------------------------------------
3864
{
3865
    # lets just check to see if we can execute this function on
3866
    # this machine.
3867
    #
3868
    if ( "$MachType" ne "sparc" )
3869
    {
1534 dpurdie 3870
        Verbose("addPath2Prototype() not supported on this machine type.");
1530 dpurdie 3871
        return 1;
3872
    }
3873
 
3874
    # class must be last as it is optional
3875
    my ($path, $perms, $uid, $gid, $class) = @_;
3876
 
3877
    # set defaults if not supplied
3878
    $perms  = "?"       if ( ($#_+1) < 2 );
3879
    $uid    = "?"       if ( ($#_+1) < 3 );
3880
    $gid    = "?"       if ( ($#_+1) < 4 );
3881
    $class  = "none"    if ( ($#_+1) < 5 );
3882
 
1534 dpurdie 3883
    Information("addPathToPrototype adding path [$path $perms $uid $gid $class]");
1530 dpurdie 3884
 
3885
    # lets determine which prototype file we are going to
3886
    # use
3887
    my ($protoTypeFile);
3888
    $protoTypeFile = "$ProtoTypeFile";
3889
 
3890
    # now we need to update the prototype file
3891
    #
3892
    local *FILE;
1534 dpurdie 3893
    open ( FILE, "+<$protoTypeFile") or Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 3894
 
3895
    # set up has of all paths to be added
3896
    my ( %pathDirs );
3897
    my ( $workPath );
3898
    my ( $i );
3899
 
3900
    $workPath = "/" if ( $path =~ s|^/|| );
3901
    foreach $i ( split("/" , $path) )
3902
    {
3903
        $workPath .= $i;
3904
        $pathDirs{$workPath} = 1;
3905
        $workPath .= "/";
3906
    }
3907
 
3908
    while ( <FILE> )
3909
    {
3910
        # lets get all the current dir entries and check for duplicates
3911
        #        class   path    mode    owner   group
3912
        if ( /^d ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*) ([^ ]*)/ )
3913
        {
3914
            # if this dir entry is defined in our paths to add we need to remove the entry
3915
            if ( defined($pathDirs{$2}) )
3916
            {
1534 dpurdie 3917
                Warning("addPath2Prototype: Path [$2] already exists in prototype file");
1530 dpurdie 3918
                delete($pathDirs{$2});
3919
            }
3920
        }
3921
    }
3922
 
3923
    my $protoLine;
3924
    # now we write the remaining dirs in the hash 
3925
    foreach $i ( sort keys(%pathDirs) )
3926
    {
3927
        $protoLine = sprintf("d %s %s %s %s %s", $class, $i, $perms, $uid, $gid);
1534 dpurdie 3928
        Verbose("addPath2Prototype: Adding Dir entry [$protoLine]");
1530 dpurdie 3929
        printf FILE "$protoLine\n"; 
3930
    }
3931
 
3932
    close FILE;
3933
    return 1;
3934
}
3935
 
3936
 
3937
#------------------------------------------------------------------------------
3938
sub createAfcRcScriptLink
3939
#
3940
#    Description:
3941
#        This sub-routine is used to create links into /afc/rc.d for start & stop 
3942
#         scripts.
3943
#
3944
#    INPUT:
3945
#        Start prefix number (2 digit number)
3946
#        Stop prefix Number (2 digit Number)
3947
#        Full path to script to create link to.
3948
#
3949
#------------------------------------------------------------------------------
3950
{
3951
    # correct number of parameters?
3952
    if ( ($#_+1) != 3 )
3953
    {
1534 dpurdie 3954
        Error("Incorrect number of params passed to " .
3955
              "createAfcRcScriptLink() function. " ,
3956
              "Check deploy config.");
1530 dpurdie 3957
    }
3958
 
3959
 
3960
    # lets just check to see if we can execute this function on
3961
    # this machine.
3962
    #
3963
    if ( "$MachType" ne "sparc" )
3964
    {
1534 dpurdie 3965
        Verbose("createAfcRcScriptLink() not supported on this machine type.");
1530 dpurdie 3966
        return 1;
3967
    }
3968
 
3969
    my ($startPrefix, $stopPrefix, $scriptPath) = @_;
3970
 
3971
    if ( $startPrefix ne "" )
3972
    {
3973
        updatePrototypeFileAddItem2(sprintf("/afc/rc.d/S%02d%s", $startPrefix, $PkgName), 
3974
                                    $scriptPath, "0755", "root", "other", "S");
3975
    }
3976
    if ( $stopPrefix ne "" )
3977
    {
3978
        updatePrototypeFileAddItem2(sprintf("/afc/rc.d/K%02d%s", $stopPrefix, $PkgName), 
3979
                                    $scriptPath, "0755", "root", "other", "S");        
3980
    }
3981
}
3982
 
3983
 
3984
#------------------------------------------------------------------------------
3985
sub createAfcRcScriptLink2
3986
#
3987
#    Description:
3988
#        This sub-routine is used to create links into the afc rc.d for start & stop 
3989
#        scripts.  It differs from the original in that you pass a TargetDirType
3990
#        parameter and the filename instead of a full path.  It then creates a relative
3991
#        link from $BASEDIR/rc.d to TargetBaseDir
3992
#
3993
#    INPUT:
3994
#        Start prefix number (2 digit number)
3995
#        Stop prefix Number (2 digit Number)
3996
#        Full path to script to create link to.
3997
#
3998
#------------------------------------------------------------------------------
3999
{
4000
    # correct number of parameters?
4001
    if ( ($#_+1) != 4 )
4002
    {
1534 dpurdie 4003
        Error("Incorrect number of params passed to " .
4004
              "createAfcRcScriptLink() function. " ,
4005
              "Check deploy config.");
1530 dpurdie 4006
    }
4007
 
4008
 
4009
    # lets just check to see if we can execute this function on
4010
    # this machine.
4011
    #
4012
    if ( "$MachType" ne "sparc" )
4013
    {
1534 dpurdie 4014
        Verbose("createAfcRcScriptLink() not supported on this machine type.");
1530 dpurdie 4015
        return 1;
4016
    }
4017
 
4018
    my ($startPrefix, $stopPrefix, $targetTag, $scriptPath) = @_;
4019
 
4020
    # lets check to see if the target tag exists if does not the process with log an error.
4021
    my ($targetValue) = getTargetDstDirValue($targetTag, "R");
4022
 
4023
    if ( $startPrefix ne "" )
4024
    {
4025
        updatePrototypeFileAddItem2(sprintf("rc.d/S%02d%s", $startPrefix, $PkgName), 
4026
                                    "../$targetValue/$scriptPath", "0755", "root", "other", "S");
4027
    }
4028
    if ( $stopPrefix ne "" )
4029
    {
4030
        updatePrototypeFileAddItem2(sprintf("rc.d/K%02d%s", $stopPrefix, $PkgName), 
4031
                                    "../$targetValue/$scriptPath", "0755", "root", "other", "S");        
4032
    }
4033
}
4034
 
4035
 
4036
#------------------------------------------------------------------------------
4037
sub createGenericCopy
4038
#
4039
#    Description:
4040
#        This sub-routine is used to create a generic copy of a specific item.
4041
#
4042
#        On sparc this will be a link, but on win32 it will be a file based on the
4043
#        buildType.
4044
#
4045
#    INPUT:
4046
#        src item name
4047
#        generic item name
4048
#        target dir
4049
#
4050
#    RETURN:
4051
#         1
4052
#
4053
#------------------------------------------------------------------------------
4054
{
4055
    my ($sName, $sLoc, $gName, $tDir) = @_;
4056
 
4057
    my ($cmd);
4058
    my ($retVal);
4059
    if ( "$MachType" eq "sparc" )
4060
    {
4061
        # I want to cd into the tDir and then create the link.
4062
        # only if an item of the same name does not already exist
4063
        #
4064
        if ( ! -f "$tDir/$gName" )
4065
        {
4066
            $cmd = "cd $tDir; ln -s $sName $gName";
4067
            $retVal = system("$cmd");
4068
            if ( $retVal != 0 )
4069
            {
1534 dpurdie 4070
                Error("Failed to create generic link [$gName] to [$tDir/$sName]: $retVal");
1530 dpurdie 4071
            }
4072
            else
4073
            {
1534 dpurdie 4074
                Verbose("Created generic link [$gName] to [$tDir/$sName] ...");
1530 dpurdie 4075
            }
4076
        }
4077
    }
4078
    else
4079
    {
4080
 
4081
        # we only create a generic copy of the an item that matches
4082
        # our build type.  (i.e. if we are building a debug package then
4083
        # only the debug items shall be considered.
4084
        #
4085
        if ( "$BuildType" eq "D" )
4086
        {
4087
            if ( $sName !~ /D\./ )
4088
            {
4089
                # this item is not a debug one.
4090
                return 1;
4091
            }
4092
        }
4093
        else
4094
        {
4095
            # this is prod build
4096
            if ( $sName !~ /P\./ )
4097
            {
4098
                # this item is not a prod one.
4099
                return 1;
4100
            }
4101
        }
4102
 
4103
 
4104
        # we have a match, lets create the copy.
4105
        #
4106
        if(File::Copy::copy("$sLoc", "$tDir/$gName"))
4107
        {
1534 dpurdie 4108
            Verbose("Created generic lib copy [$tDir/$gName]...");
1530 dpurdie 4109
        }
4110
        else
4111
        {
1534 dpurdie 4112
            Error("Failed to create generic lib copy [$gName] from [$sLoc]: $!");
1530 dpurdie 4113
        }
4114
    }
4115
 
4116
    return 1;
4117
}
4118
 
4119
 
4120
 
4121
#------------------------------------------------------------------------------
4122
sub removeVersionNumberFromItemName
4123
#
4124
#    Description:
4125
#        This sub-routine is used to remove the version number from the item name.
4126
#        i.e.  myFile.so.1.2.3 ==> myFile.so
4127
#
4128
#    INPUT:
4129
#        item name
4130
#
4131
#    RETURN:
4132
#        new item name.
4133
#
4134
#------------------------------------------------------------------------------
4135
{
4136
    my ($file) = @_;
4137
 
4138
    my ($nfile) = $file;
4139
 
4140
    if ( "$MachType" eq "sparc" )
4141
    {
4142
        $nfile =~ s/\.so.*$/\.so/;
4143
    }
4144
    else
4145
    {
4146
        $nfile =~ s/\.[0-9]+\.[0-9]+.*dll$/\.dll/;
4147
    }
4148
    return "$nfile";
4149
}
4150
 
4151
 
4152
#------------------------------------------------------------------------------
4153
sub excludeItemFromBuild
4154
#
4155
#    Description:
4156
#        This sub-routine is used to determine is a item is to be included in
4157
#        a build based on the current build type and the extension 
4158
#        it SHOULD HAVE!.
4159
#
4160
#        i.e. debug files will be tagged with *D.* 
4161
#             prod  file will be tagged with *P.*
4162
#
4163
#        if the item does not have a *D.* or a *P.* we included it by default.
4164
#
4165
#        INPUT:
4166
#              filename
4167
#
4168
#        RETURN: 
4169
#              1  - exclude 
4170
#              0  - include 
4171
#
4172
#------------------------------------------------------------------------------
4173
{
4174
    my ($file) = @_;
4175
 
4176
    # we only want to deliver
4177
    if ( "$MachType" eq "win32" )
4178
    {
4179
        # we have to include it by default.
4180
        return 0;
4181
    }
4182
 
4183
 
4184
    #######################################################
4185
    #######################################################
4186
    #######################################################
4187
    # Third party packages do not adhere to the *D.* *P.*
4188
    # conventions of debug and production builds.
4189
    #
4190
    # Hopefully we won't have to many of these, only found 
4191
    # one so far.
4192
    # 
4193
    #######################################################
4194
    #######################################################
4195
    #######################################################
4196
    if ( $file =~ /libTAO_BiDirGIOP\.so/ )
4197
    {
4198
        return 0;
4199
    } 
4200
 
4201
    if ( $file !~ /D\./ &&
4202
         $file !~ /P\./
4203
       )
4204
    {
4205
        # we have to include it by default. 
4206
        return 0;
4207
    }
4208
 
4209
 
4210
    # we only want to deliver 
4211
    if ( "$BuildType" eq "D" )
4212
    { 
4213
        if ( $file !~ /D\./ )
4214
        {
4215
            # we do not want this file for this build type.
4216
            return 1;
4217
        }
4218
        else
4219
        {
4220
            return 0;
4221
        }
4222
    }
4223
    else
4224
    {
4225
        if ( $file !~ /P\./ )
4226
        {
4227
            # we do not want this file for this build type.
4228
            return 1;
4229
        }
4230
        else
4231
        {
4232
            return 0;
4233
        }
4234
    }
4235
 
4236
    return 1;
4237
}
4238
 
4239
 
4240
#------------------------------------------------------------------------------
4241
sub installAllDpkgArchiveBinFiles
4242
#
4243
# Description:
4244
#       This sub-routine is used to install all bin files from the
4245
#       dpkg_archive into the defined install area.
4246
#
4247
#       It assumes based on the build type where the src files will be located.
4248
#
4249
#       If it has any problems it will log an error and stop processing.
4250
#
4251
#------------------------------------------------------------------------------
4252
{
4253
    # correct number of parameters?
4254
    if ( ($#_+1) != 1 )
4255
    {
1534 dpurdie 4256
        Error("Incorrect number of params passed to " .
4257
              "installAllDpkgArchiveBinFiles() function. " ,
4258
              "Check deploy config.");
1530 dpurdie 4259
    }
4260
 
4261
    my ($targetTag) = @_;
4262
 
4263
    # lets check to see if the target tag exists
4264
    # if does not the process with log an error.
4265
    #
4266
    my ($targetValue) = getTargetDstDirValue($targetTag, "A");
4267
 
4268
 
4269
    # ok we have a valid dst value we now need to get a hold of all the 
4270
    # lib files for this buildtype
4271
    #
4272
    my ($i);
4273
    my ($m_DpkgBinDir);
4274
    foreach $i (@{$DpkgBinDirList{'_ALL_'}})
4275
    {
1534 dpurdie 4276
        $m_DpkgBinDir = "$DpkgBinDir/$i";
4277
        if ( ! -d $m_DpkgBinDir )
1530 dpurdie 4278
        {
1534 dpurdie 4279
            Verbose("Directory [$m_DpkgBinDir] not found.");
1530 dpurdie 4280
            next;
4281
        }
4282
 
4283
        local *DIR;
4284
        opendir(DIR, $m_DpkgBinDir) or 
1534 dpurdie 4285
            Error("can't opendir $m_DpkgBinDir : $!");
1530 dpurdie 4286
 
4287
        my ($file);
4288
        while (defined($file = readdir(DIR))) 
4289
        {
4290
            if ( $file !~ /^\.$/  &&     # we do not want the . and .. entries.
4291
                 $file !~ /^\.\.$/ &&
4292
                 $file !~ /\.pdb$/ )
4293
            {
4294
                my ($m_fLoc) = "$m_DpkgBinDir/$file"; 
4295
                if(File::Copy::copy("$m_fLoc", "$targetValue"))
4296
                {
1534 dpurdie 4297
                    Verbose("Copied [$file] to [$targetValue] ...");
1530 dpurdie 4298
                }
4299
                else
4300
                {
1534 dpurdie 4301
                    Error("Failed to copy bin [$m_fLoc]: $!"); 
1530 dpurdie 4302
                }
4303
            }
4304
        }
4305
        closedir(DIR);
4306
    }
4307
 
4308
    return 1;
4309
}
4310
 
4311
 
4312
#------------------------------------------------------------------------------
4313
sub rmDirectory
4314
#
4315
# Description:
4316
#       This sub-routine is used to remove an entire directory tree.
4317
#
4318
#       It recurses from a starting point removing each item and if it
4319
#       finds a dir it recurses into that dir cleaning it as well.
4320
#
4321
#------------------------------------------------------------------------------
4322
{
4323
    # correct number of parameters?
4324
    if ( ($#_+1) != 1  )
4325
    {
1534 dpurdie 4326
        Error("Incorrect number of params passed to rmDirectory() function.");
1530 dpurdie 4327
    }
4328
 
4329
    my ($startingPoint) = @_;
1534 dpurdie 4330
    Verbose("Recursively removing Directory tree [$startingPoint]");
1530 dpurdie 4331
 
4332
    #
1542 dpurdie 4333
    #   Use the rmtree function
4334
    #   It works better than glob when given a filepath with spaces
4335
    #
4336
    rmtree($startingPoint, IsVerbose(1), 1);
4337
    Error("Failed to remove dir [$startingPoint] : $!") if (-d $startingPoint);
4338
 
1530 dpurdie 4339
    return 1;
4340
}
4341
 
4342
#------------------------------------------------------------------------------
4343
sub CreateTargetDirStructure
4344
#
4345
# Description:
4346
#       This sub-routine create the target stucture based on what the user has
4347
#       previously defined in the %TargetDstDirStructure hash array
4348
#
4349
#       It will also clean the contents of this location prior to creation.
4350
#
4351
#       In this function we also check to see if all the LocalSrcDirStructure
4352
#       directories exist. We warn if they do not.
4353
#
4354
#------------------------------------------------------------------------------
4355
{
1534 dpurdie 4356
    Information("Cleaning any previous target file items...");
1530 dpurdie 4357
 
4358
    my ($i);
4359
    my ($m_dirD);
4360
 
4361
    # lets clean.
4362
    #
4363
    foreach $i ( sort {$b cmp $a} values %TargetDstDirStructure )
4364
    {
4365
        if ( "$i" !~ /^\.$/ &&
4366
             "$i" !~ /^\.\.$/   )
4367
        {
4368
 
4369
            $m_dirD = "$PkgBaseDir/$TargetBaseDir/$i";
4370
            if ( -d "$m_dirD" )
4371
            {
4372
                rmDirectory("$m_dirD");
4373
            }
4374
        }
4375
    } 
4376
 
4377
    $m_dirD = "$PkgPatchTmpDir";
4378
    if ( -d "$m_dirD" )
4379
    {
4380
        rmDirectory("$m_dirD");
4381
    }
4382
 
4383
    $m_dirD = "$PkgBaseDir/$TargetBaseDir";
4384
    if ( -d "$m_dirD" )
4385
    {
4386
        rmDirectory("$m_dirD");
4387
    }
4388
 
4389
    $m_dirD = "$PkgBaseDir";
4390
    if ( -d "$m_dirD" )
4391
    {
4392
        rmDirectory("$m_dirD");
4393
    }
4394
 
4395
    # lets create.
4396
    #
1534 dpurdie 4397
    Information ("Creating target directory structure...");
1530 dpurdie 4398
 
1534 dpurdie 4399
    make_directory( "$PkgBaseDir/$TargetBaseDir", 0777, "Create target dir");
1530 dpurdie 4400
    foreach $i ( sort {$a cmp $b} values %TargetDstDirStructure )
4401
    {
1534 dpurdie 4402
        make_directory("$PkgBaseDir/$TargetBaseDir/$i", 0777);
1530 dpurdie 4403
    }
4404
 
4405
 
4406
    # lets determine if we have a InstallShield config dir
4407
    #
4408
    if ( "$MachType" eq "win32" || "$MachType" eq "WinCE" )
4409
    {
4410
 
4411
        # if this is a patch build i expect to find a "p" in the front of the
4412
        # file names. we use this as a simple visual differentiation.
4413
        #
4414
        my ($m_ishieldDir);    
4415
        my ($m_ishieldProjFile);
4416
        if ( "x$PkgPatchNum" ne "x" )
4417
        {
4418
            # patch build.
4419
            $m_ishieldDir      = "$RootDir/" . "p$PkgName";
4420
            $m_ishieldProjFile = "$RootDir/" . "p$PkgName" . ".ism";
4421
        }
4422
        else
4423
        {
4424
            # normal build.
4425
            $m_ishieldDir      = "$RootDir/" . "$PkgName";
4426
            $m_ishieldProjFile = "$RootDir/" . "$PkgName" . ".ism";
4427
        }
4428
 
4429
        # here i can set the location of my IShield project dir
4430
        # so i can use it later if required.
4431
        $PKG_ISHIELD_DIR = $m_ishieldDir;
4432
 
4433
 
4434
        # we check for an ism file based on the pkg name
4435
        # if we find one we need to deal with the dir and
4436
        # the isheildlib files.
4437
        #
4438
        if ( -f "$m_ishieldProjFile" )
4439
        {
4440
            if ( ! -d "$m_ishieldDir" )
4441
            {
1534 dpurdie 4442
                Error ("Local InstallShield config dir [$m_ishieldDir] does not exist.",
4443
                       "Please create before continuing.");
1530 dpurdie 4444
            }
4445
            else
4446
            {
4447
                # we populate the ishield config dir with the ishieldlib files
4448
                #
4449
                my ($i);
1534 dpurdie 4450
                Verbose("Installing Standard ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");
1530 dpurdie 4451
                foreach $i ( @PKG_ISHIELD_FILES )
4452
                {
4453
                    # first we remove the file (as previously it install read-only).
4454
                    unlink("$m_ishieldDir/$i");
4455
                    if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") )
4456
                    {
1534 dpurdie 4457
                        Verbose("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");
1530 dpurdie 4458
                    }
4459
                    else
4460
                    {
1534 dpurdie 4461
                        Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");
1530 dpurdie 4462
                    }
4463
                }
4464
 
4465
 
4466
                # we also want to deliver the patch rule files
4467
                # if this build is a patch build.
4468
                #
4469
                if ( "x$PkgPatchNum" ne "x" )
4470
                {
1534 dpurdie 4471
                    Verbose("Installing Patch ishieldlib files from [$PKG_UTIL_DIR] to [$m_ishieldDir]");
1530 dpurdie 4472
                    foreach $i ( @PATCH_ISHIELD_FILES )
4473
                    {
4474
                        # first we remove the file (as previously it install read-only).
4475
                        unlink("$m_ishieldDir/$i");
4476
                        if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$m_ishieldDir") )
4477
                        {
1534 dpurdie 4478
                            Verbose("Copied [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] ...");
1530 dpurdie 4479
                        }
4480
                        else
4481
                        {
1534 dpurdie 4482
                            Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$m_ishieldDir] : $!");
1530 dpurdie 4483
                        }
4484
                    }
4485
                }
4486
 
4487
 
4488
                # we also want to deliver the islib imgages to be
4489
                # used by this project, we assume the image has a project
4490
                # acronym prefix, and if not found we just WARN the user
4491
                #
4492
                # we assume our source dir is the interface/etc dir and our
4493
                # dst dir is the PkgBaseDir
4494
                #
4495
                my ($m_islibImgFile) = "";
1534 dpurdie 4496
                Verbose("Installing ishield image files from [$DpkgEtcDir] to [$m_ishieldDir]");
1530 dpurdie 4497
                foreach $i ( @PKG_ISHIELD_IMG_FILES )
4498
                {
4499
                    $m_islibImgFile = "$DpkgEtcDir/$ProjectAcronym" . "_" . $i;
4500
                    if ( -f "$m_islibImgFile" )
4501
                    {
4502
                        if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") )
4503
                        {
1534 dpurdie 4504
                            Verbose("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");
1530 dpurdie 4505
                        }
4506
                        else
4507
                        {
1534 dpurdie 4508
                            Error("Failed to copy info file [$m_islibImgFile] to " .
1530 dpurdie 4509
                                     "[$PkgBaseDir] : $!");
4510
                        }
4511
                    }
4512
                    else
4513
                    {
4514
                        # we shall check for the MASS items, if the exist we copy them
4515
                        # over. Here we assume the 'mas' acronymn is correct.
4516
                        #
4517
                        $m_islibImgFile = "$DpkgEtcDir/mas" . "_" . $i;
4518
                        if ( -f "$m_islibImgFile" )
4519
                        {
4520
                            if( File::Copy::copy("$m_islibImgFile", "$PkgBaseDir") )
4521
                            {
1534 dpurdie 4522
                                Verbose("Copied [$m_islibImgFile] to [$PkgBaseDir] ...");
1530 dpurdie 4523
                            }
4524
                            else
4525
                            {
1534 dpurdie 4526
                                Error("Failed to copy info file [$m_islibImgFile] to " .
1530 dpurdie 4527
                                         "[$PkgBaseDir] : $!");
4528
                            } 
4529
                        } 
4530
                        else
4531
                        {
1534 dpurdie 4532
                            Warning("Failed to locate ishieldlib image [xxx_$i], no image copied, " .
1530 dpurdie 4533
                                    "check depolylib config.");
4534
                        }
4535
                    }
4536
                }
4537
 
4538
            }
4539
        }
4540
        else
4541
        {
1534 dpurdie 4542
            Warning("Did not detect InstallShield project file [$m_ishieldProjFile]");
4543
            Warning("Not installing InstallShield library files.");
1530 dpurdie 4544
        }
4545
    }
4546
 
4547
    # done.
4548
    return 1;
4549
}
4550
 
4551
#------------------------------------------------------------------------------
4552
sub generateIShieldIncludeFile ()
4553
#
4554
# Description:
4555
#     This subroutine is used to generate a definition include file 
4556
#     that is used during IShield builds.
4557
#
4558
#     The output location of the file is the IShieldProjDir.
4559
#    
4560
#------------------------------------------------------------------------------
4561
{
4562
    my ($outFile) = "$PKG_ISHIELD_DIR/$PKG_ISHIELD_DEF_FILE";
4563
 
4564
    # this is only relavent for win32 builds.
4565
    if ( "$MachType" eq "sparc" )
4566
    {
4567
        return 1;
4568
    }
4569
 
4570
    # lets open the file.
4571
    #
4572
    local *FILE;
4573
    open ( FILE, "> $outFile") or
1534 dpurdie 4574
        Error("Failed to open file [$outFile].");
1530 dpurdie 4575
 
4576
    # lets populate the pkgdef file.
4577
 
4578
    printf FILE ("// This is an automatically generated include file.\n");
4579
    printf FILE ("// Please do not modify, and please do not check into ClearCase.\n");
4580
    printf FILE ("//\n");
4581
    printf FILE ("#define PKG_NAME         \"$PkgName\"\n");
4582
    printf FILE ("#define PKG_NAMELONG     \"$PkgNameLong\"\n");
4583
    printf FILE ("#define PKG_VERSION      \"$PkgVersion\"\n");
4584
    printf FILE ("#define PKG_BUILDNUM     \"$PkgBuildNum\"\n");
4585
    printf FILE ("#define PKG_PROJACRONYM  \"$ProjectAcronym\"\n");
4586
    printf FILE ("#define PKG_DESC         \"$PkgDesc\"\n");
4587
 
4588
    # if this build is a patch build.
4589
    #
4590
    if ( "x$PkgPatchNum" ne "x" )
4591
    {
4592
        printf FILE ("#define PATCH_NAME       \"$PkgPatchName\"\n");
4593
        printf FILE ("#define PATCH_NUM        \"$PkgPatchNum\"\n");
4594
        printf FILE ("#define PATCH_ID         \"$PkgPatchID\"\n");
4595
    }
4596
    else
4597
    {
4598
        printf FILE ("#define PATCH_NAME       \"\"\n");
4599
        printf FILE ("#define PATCH_NUM        \"\"\n");
4600
        printf FILE ("#define PATCH_ID         \"\"\n");
4601
    }
4602
 
4603
    # lets close the file
4604
    close FILE;
4605
 
4606
    # done.
4607
    return 1;
4608
}
4609
 
4610
 
4611
#------------------------------------------------------------------------------
4612
sub ValidateLocalSrcDirStructure
4613
#
4614
# Description:
4615
#       This sub-routine is used to check the existence the local dir 
4616
#       configuration items, these are stored in 
4617
#       %LocalSrcDirStructure.
4618
#
4619
#------------------------------------------------------------------------------
4620
{
4621
    # lets check the configured local direcotry structure
4622
    #
4623
    my ($i);
4624
    foreach $i ( values %LocalSrcDirStructure )
4625
    {
4626
        my ($m_Dir) = "$SrcDir/$i";
4627
        if ( ! -d "$m_Dir" )
4628
        {
1534 dpurdie 4629
            Warning ("Local src dir [$m_Dir] does not exist.");
1530 dpurdie 4630
        }
4631
    }
4632
 
4633
    return 1;
4634
}
4635
 
4636
 
4637
#------------------------------------------------------------------------------
4638
sub getLocalDirValue
4639
#
4640
# Description:
4641
#       This sub-routine is used to return the local dir value from
4642
#       %LocalSrcDirStructure based on providing the 
4643
#       associated key.
4644
#
4645
#       If the value does not exist then it will return an error
4646
#       and terminate processing.
4647
#
4648
#------------------------------------------------------------------------------
4649
{
4650
    # correct number of parameters?
4651
    if ( ($#_+1) != 2 ) 
4652
    {
1534 dpurdie 4653
        Error("Incorrect number of params passed to " .
1530 dpurdie 4654
                  "getLocalDirValue() function.");
4655
    }
4656
 
4657
    my ($m_key, $m_type) = @_;
4658
    if (exists  $LocalSrcDirStructure{$m_key} )    
4659
    {
4660
        if ( "$m_type" eq "A" )
4661
        {
4662
            return "$SrcDir/" .
4663
                   "$LocalSrcDirStructure{$m_key}";
4664
        }
4665
        else
4666
        {
4667
            return "$LocalSrcDirStructure{$m_key}";
4668
        }
4669
    }
4670
    else
4671
    {
1534 dpurdie 4672
        Error("Local src tag [$m_key] does not exist in " .
4673
             "LocalSrcDirStructure. " ,
4674
             "Check deploy configuration.");
1530 dpurdie 4675
    }
4676
 
4677
    return 1;
4678
}
4679
 
4680
 
4681
#------------------------------------------------------------------------------
4682
sub getTargetDstDirValue
4683
#
4684
# Description:
4685
#       This sub-routine is used to return the target dest dir value from
4686
#       %TargetDstDirStructure based on providing the 
4687
#       associated key.
4688
#
4689
#       If the value does not exist then it will return an error
4690
#       and terminate processing.
4691
#
1532 dpurdie 4692
# Inputs:   $m_key          Symbolic name for target directory
4693
#           $m_type         Type : A    - Absolute
4694
#                                  R    - Relative
4695
#
1530 dpurdie 4696
#------------------------------------------------------------------------------
4697
{
4698
    # correct number of parameters?
4699
    if ( ($#_+1) != 2 ) 
4700
    {
1534 dpurdie 4701
        Error("Incorrect number of params passed to " .
1530 dpurdie 4702
                  "getTargetDstDirValue() function.");
4703
    }
4704
 
4705
    my ($m_key, $m_type) = @_;
1532 dpurdie 4706
    my $tdir;
4707
 
4708
    #
4709
    #   Look up the users tag conversion hash
4710
    #
4711
    if ( exists $TargetDstDirStructure{$m_key} )
1530 dpurdie 4712
    {
1532 dpurdie 4713
        $tdir = $TargetBaseDir . '/' . $TargetDstDirStructure{$m_key};
1530 dpurdie 4714
    }
4715
    else
4716
    {
1534 dpurdie 4717
        Error("Target destination dir tag [$m_key] does not exist in " .
4718
             "TargetDstDirStructure. " ,
4719
             "Check deploy configuration.");
1530 dpurdie 4720
    }
4721
 
1532 dpurdie 4722
 
4723
    #
4724
    #   If an absolute path is required than add the PkgBaseDir
4725
    #   otherwise the user must be requesting a relative path.
4726
    #
4727
    if ( "$m_type" eq "A" ) {
4728
        $tdir = "$PkgBaseDir/$tdir";
4729
    } elsif ( "$m_type" eq "R" )  {
4730
    } else {
1534 dpurdie 4731
        Error("getTargetDstDirValue: Bad call. Unknown type: $m_type");
1532 dpurdie 4732
    }
4733
 
4734
    return $tdir;
1530 dpurdie 4735
}
4736
 
4737
 
4738
#------------------------------------------------------------------------------
4739
sub createPatch
4740
#
4741
# Description:
4742
#       This sub-routine is used to create a solaris patch.
4743
#
4744
#------------------------------------------------------------------------------
4745
{
4746
    # correct number of parameters?
4747
    if ( ($#_+1) != 0 )
4748
    {
1534 dpurdie 4749
        Error("Incorrect number of params passed to " .
4750
              "createPatch() function.",
4751
              "Check deploy config.");
1530 dpurdie 4752
    }
4753
 
4754
    # lets just check to see if we can execute this function on
4755
    # this machine.
4756
    #
4757
    if ( "$MachType" ne "sparc" )
4758
    {
1534 dpurdie 4759
        Verbose("createPatch() not supported on this machine type.");
1530 dpurdie 4760
        return 1;
4761
    }
4762
 
4763
    # lets just check to see if we can execute this function on
4764
    # for  this build.
4765
    #
4766
    if ( "x$PkgPatchNum" eq "x" )
4767
    {
1534 dpurdie 4768
        Warning("createPatch() can only be called during a PATCH build.");
1530 dpurdie 4769
        return 1;
4770
    }
4771
 
4772
    # we need to create the patch directory that contains
4773
    #
1534 dpurdie 4774
    Information("Creating patch ...");
1530 dpurdie 4775
 
4776
    my ( $m_pkgmkCmd );
4777
    my ( $m_pkgtransCmd );
4778
    $m_pkgmkCmd = "pkgmk -o " .
4779
                  "-f $PkgBaseDir/prototype " .
4780
                  "-d $PkgBaseDir";
4781
 
4782
    # lets execute the package commands.
4783
    my ($retVal);
4784
    $retVal = system("$m_pkgmkCmd");
4785
    if ( $retVal != 0 )
4786
    {
1534 dpurdie 4787
        Error("Failed to complete command [$m_pkgmkCmd].");
1530 dpurdie 4788
    }
4789
 
4790
    # we need to generate a README file to help during installation
4791
    #
4792
    generatePatchREADME();
4793
 
4794
 
4795
    my ($m_Cmd)    = ""; 
4796
    my ($m_tmpDir) = "$PkgPatchTmpDir/$PkgPatchID";
4797
 
1534 dpurdie 4798
    Information("Creating staging area of patch...");
1530 dpurdie 4799
    $m_Cmd = "cd $PkgBaseDir && mkdir -p $m_tmpDir;";
4800
    system($m_Cmd);
4801
 
1534 dpurdie 4802
    Information("Copying patch contents to staging area of patch...");
1530 dpurdie 4803
    $m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";
4804
    system($m_Cmd);
4805
 
4806
    # we need to copy the patch install utility files from
4807
    # their resting place.
4808
    #
4809
    my ($i);
4810
    foreach $i ( @PATCH_UTIL_FILES )
4811
    {
4812
        if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgPatchTmpDir") )
4813
        {
1534 dpurdie 4814
            Verbose("Copied [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] ...");
1530 dpurdie 4815
            system("chmod 0755 $PkgPatchTmpDir/$i");
4816
        }
4817
        else
4818
        {
1534 dpurdie 4819
            Error("Failed to copy info file [$PATCH_UTIL_DIR/$i] to [$PkgPatchTmpDir] : $!");
1530 dpurdie 4820
        }
4821
    }
4822
 
4823
    # Lets put the readme in place
4824
    #
4825
    if( File::Copy::copy("$PkgPatchReadme", "$PkgPatchTmpDir") )
4826
    {
1534 dpurdie 4827
        Verbose("Copied [$PkgPatchReadme] to [$PkgPatchTmpDir] ...");
1530 dpurdie 4828
    }
4829
    else
4830
    {
1534 dpurdie 4831
        Error("Failed to copy info file [$PkgPatchReadme] to [$PkgPatchTmpDir] : $!");
1530 dpurdie 4832
    }
4833
 
1534 dpurdie 4834
    Information("Copying patch contents to staging area of patch...");
1530 dpurdie 4835
    $m_Cmd = "cd $PkgBaseDir && cp -r $PkgName $m_tmpDir;";
4836
    system($m_Cmd);
4837
 
4838
    my ($m_oFile) = "$PkgPatchID-$ProjectAcronym\.tgz";
1534 dpurdie 4839
    Information("Creating a gzip'd compressed tar (.tgz) output file [$m_oFile]...");
1530 dpurdie 4840
    my ($base) = File::Basename::basename($PkgPatchTmpDir);
4841
    $m_Cmd = "cd $PkgBaseDir && tar cvf - $base | gzip > $m_oFile";
4842
    system($m_Cmd);
4843
 
4844
    return 1;
4845
}
4846
 
4847
 
4848
 
4849
#------------------------------------------------------------------------------
4850
sub generatePatchREADME
4851
#
4852
#   This function is used to generate a README text file to help the user
4853
#   duing the patch installation.
4854
#
4855
#------------------------------------------------------------------------------
4856
{
4857
    local *FILE;
4858
    open ( FILE, "> $PkgPatchReadme") or
1534 dpurdie 4859
        Error("Failed to open file [$PkgPatchReadme].");
1530 dpurdie 4860
 
4861
    printf FILE ("This is a patch for $PkgName $PkgVersion\n");
4862
    printf FILE ("---------------------------------------------------------------\n");
4863
    printf FILE ("\n");
4864
    printf FILE ("Installing patch (as the 'root' user) :\n");
4865
    printf FILE ("---------------------------------------------------------------\n");
4866
    printf FILE ("./installpatch $PkgPatchID\n");
4867
    printf FILE ("\n");
4868
    printf FILE ("Backing Out patch:\n");
4869
    printf FILE ("---------------------------------------------------------------\n");
4870
    printf FILE ("./backoutpatch $PkgPatchID\n");
4871
    printf FILE ("\n");
4872
 
4873
    printf FILE ("Patch contents of $PkgPatchID\n");
4874
    printf FILE ("---------------------------------------------------------------\n");
4875
    close FILE;
4876
 
4877
    # now we need to get the contents of the patch we are creating.
4878
    #
4879
    File::Find::find(\&getPatchContents, "$PkgBaseDir/$TargetBaseDir");
4880
 
4881
    return 1;
4882
}
4883
 
4884
 
4885
#------------------------------------------------------------------------------
4886
sub getPatchContents
4887
#
4888
#   This sub-routine adds an entry into the readme file for each
4889
#   item in the patch delivery tree.
4890
#
4891
#------------------------------------------------------------------------------
4892
{
4893
    my($file)= "$File::Find::name";
4894
    my($base)= File::Basename::basename($file);
4895
 
4896
    # we get the absolute path from the find, but we only require
4897
    # a relative path from the starting dir.
4898
    # so our start dir.
4899
 
4900
    my ($m_sfile) = $file;
4901
    $file =~ s/$PkgBaseDir//;
4902
 
4903
    open ( FILE, ">> $PkgPatchReadme") or
1534 dpurdie 4904
         Error("Failed to open file [$deplylib::PkgPatchReadme].");
1530 dpurdie 4905
 
4906
    # lets populate the prototype file.
4907
    printf FILE ("* $file\n");
4908
 
4909
    close (FILE);
4910
}
4911
 
4912
 
4913
#------------------------------------------------------------------------------
4914
sub createPackage
4915
#
4916
# Description:
1532 dpurdie 4917
#       This sub-routine is used to create a package.
4918
#       The type of package is machine specific. The subroutine will invoke a
4919
#       machine specfic function to do the real work.
1530 dpurdie 4920
#
4921
#------------------------------------------------------------------------------
4922
{
1534 dpurdie 4923
    Information("createPackage");
1530 dpurdie 4924
 
4925
    # lets just check to see if we can execute this function on
4926
    # this machine.
4927
    #
1532 dpurdie 4928
    my $createRoutine = 'createPackage_' . $MachType;
4929
    if ( exists &$createRoutine )
1530 dpurdie 4930
    {
1532 dpurdie 4931
        # lets just check to see if we can execute this function on
4932
        # for  this build.
4933
        #
4934
        if ( $PkgPatchNum )
4935
        {
1534 dpurdie 4936
            Warning("createPackage() can only be called during a RELEASE build.");
1532 dpurdie 4937
            return 1;
4938
        }
4939
 
4940
        #
4941
        #   Ensure the Release directory is present
4942
        #
1534 dpurdie 4943
        make_directory( $ReleaseDir, 0777 );
1532 dpurdie 4944
 
4945
        # Ensure that the package descriptor is transferred
4946
        #
4947
        my ($m_copydesc) = "cp $SrcDir/descpkg $ReleaseDir";
4948
        system($m_copydesc);
4949
 
4950
        # Invoke the machine specific package builder by name
4951
        # Need to relax strictness. Yes we do know what we are doing here
4952
        #
4953
        no strict "refs";
1534 dpurdie 4954
        &$createRoutine( @_ ) || Error("Unspecified error building package");
1532 dpurdie 4955
        use strict "refs";
1530 dpurdie 4956
    }
1532 dpurdie 4957
    else
1530 dpurdie 4958
    {
1534 dpurdie 4959
        Verbose("createPackage() not supported on this machine type: $MachType.");
1530 dpurdie 4960
    }
1532 dpurdie 4961
    return 1;
4962
}
1530 dpurdie 4963
 
4964
 
1532 dpurdie 4965
#------------------------------------------------------------------------------
4966
sub createPackage_sparc
4967
#
4968
# Description:
4969
#       This sub-routine is used to create a package.
4970
#       The type of package is machine specific. The subroutine will invoke a
4971
#       machine specfic function to do the real work.
4972
#
4973
#------------------------------------------------------------------------------
4974
{
1534 dpurdie 4975
    Verbose("createPackage_sparc");
1532 dpurdie 4976
 
1530 dpurdie 4977
    # we need to copy the package utility files from
4978
    # their resting place.
4979
    #
1532 dpurdie 4980
    foreach my $i ( @PKG_UTIL_FILES )
1530 dpurdie 4981
    {
4982
        if( File::Copy::copy("$PKG_UTIL_DIR/$i", "$PkgBaseDir") )
4983
        {
1534 dpurdie 4984
            Verbose("Copied [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] ...");
1530 dpurdie 4985
            updatePrototypeFileAddItem2("$i", "$i", "", "", "", "I");
4986
            system("chmod 0755 $PkgBaseDir/$i");
4987
        }
4988
        else
4989
        {
1534 dpurdie 4990
            Error("Failed to copy info file [$PKG_UTIL_DIR/$i] to [$PkgBaseDir] : $!");
1530 dpurdie 4991
        }
4992
    }
4993
 
4994
 
4995
    my ( $m_pkgmkCmd );
4996
    my ( $m_pkgtransCmd );
4997
    $m_pkgmkCmd = "pkgmk -o " .
4998
                  "-f $PkgBaseDir/prototype " .
4999
                  "-d $PkgBaseDir";
5000
 
5001
 
5002
    $m_pkgtransCmd = "pkgtrans -o " .
5003
                     "-s $PkgBaseDir " .
5004
                     "$PkgOutputFile " .
5005
                     "$PkgName";
5006
 
5007
    # lets execute the package commands.
5008
    my ($retVal);
5009
    $retVal = system("$m_pkgmkCmd");
5010
    if ( $retVal != 0 )
5011
    {
1534 dpurdie 5012
        Error("Failed to complete command [$m_pkgmkCmd].");
1530 dpurdie 5013
    }
5014
 
5015
    $retVal = system("$m_pkgtransCmd");
5016
    system("$m_pkgtransCmd");
5017
    if ( $retVal != 0 )
5018
    {
1534 dpurdie 5019
        Error("Failed to complete command [$m_pkgtransCmd].");
1530 dpurdie 5020
    }
5021
 
5022
    # lets compress the output to save some space.
5023
    #
1534 dpurdie 5024
    Information("Compressing $PkgOutputFile");
1532 dpurdie 5025
    my ($m_compressCmd) = "cd $PkgBaseDir; gzip $PkgOutputFile; mv ${PkgOutputFile}.gz $ReleaseDir";
1530 dpurdie 5026
    system($m_compressCmd);
5027
 
5028
    return 1;
5029
}
5030
 
1532 dpurdie 5031
#------------------------------------------------------------------------------
5032
sub createPackage_WinCE
5033
#
5034
# Description:
5035
#       This sub-routine is used to create a package.
5036
#       Really a win32 machine type, but for some reason, the MachType gets
5037
#       stuffed around. Don't know why.
5038
#
5039
#       Do have the option of creating a WinCE specific packager
5040
#
5041
#------------------------------------------------------------------------------
5042
{
1534 dpurdie 5043
    Verbose("createPackage_WinCE");
1532 dpurdie 5044
    createPackage_win32(@_);
5045
}
1530 dpurdie 5046
 
5047
#------------------------------------------------------------------------------
1532 dpurdie 5048
sub createPackage_win32
5049
#
5050
# Description:
5051
#       This sub-routine is used to create a package.
5052
#       Invoke the isbuild.pl utility to build the install shield project
5053
#
5054
#------------------------------------------------------------------------------
5055
{
1534 dpurdie 5056
    Verbose("createPackage_win32");
1538 dpurdie 5057
 
1532 dpurdie 5058
    #
1538 dpurdie 5059
    #   Process any options that may be present
5060
    #   Don't complain about args we don't understand. They may apply to other
5061
    #   platforms
5062
    #
5063
    my @user_options = ();
5064
    foreach my $arg ( @_ )
5065
    {
5066
        if ( $arg =~ m/^-nonameversion/ || $arg =~ m/^-nameversion/   ) {
5067
            push @user_options, $arg;
5068
 
5069
        } elsif ( $arg =~ m/^-nocode/ || $arg =~ m/^-code/   ) {
5070
            push @user_options, $arg;
5071
 
5072
        } else {
5073
            Message ( "createPackage_win32: Unknown option: $_");
5074
        }
5075
    }
5076
 
5077
    #
1532 dpurdie 5078
    #   Locate MergeModules in external packages
5079
    #   These will be used by the InstallShield compiler
5080
    #
5081
    my @mm_dirs;
5082
    my @mm_tld;
5083
    my $tdir;
5084
 
5085
    #
5086
    #   Check for Merge Modules in the local directory
5087
    #   This must be a flat directory structure. ie: all files in the
5088
    #   subdirectory called MergeModule.
5089
    #
5090
    $tdir = "$RootDir/MergeModules";
5091
    push @mm_dirs, $tdir if ( -d $tdir );
1534 dpurdie 5092
    Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5093
 
5094
    #
5095
    #   Check for Merge Modules in the Interface directory
5096
    #   This will be pulled in via a BuildPkgArchive
5097
    #
5098
    $tdir = "$InterfaceDir/MergeModules";
5099
    push @mm_tld, $tdir if ( -d $tdir );
1534 dpurdie 5100
    Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5101
 
5102
    #
5103
    #   Check in LinkPkgArchive locations too
5104
    for my $entry ( $BuildFileInfo->getBuildPkgRules() )
5105
    {
5106
        next unless ( $entry->{'TYPE'} eq 'link' );
5107
        $tdir = $entry->{'ROOT'} . '/MergeModules';
5108
        push @mm_tld, $tdir if ( -d $tdir );
1534 dpurdie 5109
        Verbose ("Discovered MergeModules in: $tdir") if ( -d $tdir );
1532 dpurdie 5110
    }
5111
 
5112
    #
5113
    #   Expand the merge module subdirectory tree into
5114
    #   suitable paths:
5115
    #       Modules/i386
5116
    #       Modules/i386/<language>
5117
    #       Objects
5118
    #       Merge Modules
5119
    #
5120
    foreach my $dir ( @mm_tld )
5121
    {
5122
        $tdir = $dir . '/Modules/i386';
5123
        if ( -d $tdir )
5124
        {
5125
            push @mm_dirs, $tdir;
5126
            foreach my $file ( glob( "$tdir/*" ))
5127
            {
5128
                next unless ( -d $file );
5129
                push @mm_dirs, $file;
5130
            }
5131
        }
5132
 
5133
        $tdir = $dir . '/Objects';
5134
        push @mm_dirs, $tdir if ( -d $tdir );
5135
 
5136
        $tdir = $dir . '/Merge Modules';
5137
        push @mm_dirs, $tdir if ( -d $tdir );
5138
    }
5139
 
5140
 
5141
    #
5142
    #   Locate the program
5143
    #   It will be in a location addressed by the @INC path
5144
    #
5145
    my $prog_found;
5146
    my $prog;
5147
    foreach my $dir ( @INC )
5148
    {
5149
        $prog = $dir . '/isbuild.pl';
5150
        next unless ( -f $prog );
5151
        $prog_found = 1;
5152
        last;
5153
    }
5154
 
1534 dpurdie 5155
    Error("isbuild.pl not found") unless $prog_found;
5156
    Verbose("isbuild: $prog");
1532 dpurdie 5157
    my $rv = system ( $ENV{GBE_PERL}, $prog,
5158
                            "-project=../$PkgName.ism",
5159
                            "-version=$PkgVersionUser",
5160
                            "-out=$ReleaseDir",
5161
                            "-workdir=$InterfaceDir",
1538 dpurdie 5162
                            @user_options,
1532 dpurdie 5163
                            map { "-mergemodule=$_" } @mm_dirs
5164
                             );
1534 dpurdie 5165
    Error ("InstallShield Builder Error" ) if ( $rv );
1532 dpurdie 5166
    return 1;
5167
}
5168
 
5169
#------------------------------------------------------------------------------
1530 dpurdie 5170
sub createPrototypeFile
5171
#
5172
# Description:
1532 dpurdie 5173
#       This sub-routine is used to create the required package prototype file
1530 dpurdie 5174
#       from a known directory struture using the search path method.
5175
#
5176
#------------------------------------------------------------------------------
5177
{
5178
    # correct number of parameters?
5179
    if ( ($#_+1) != 2 )
5180
    {
1534 dpurdie 5181
        Error("Incorrect number of params passed to " .
5182
              "createPrototypeFile() function",
5183
              "Check deploy config.");
1530 dpurdie 5184
    }
5185
 
5186
    # lets just check to see if we can execute this function on
5187
    # this machine.
5188
    #
5189
    if ( "$MachType" ne "sparc" )
5190
    {
1534 dpurdie 5191
        Verbose("createPrototypeFile() not supported on this machine type.");
1530 dpurdie 5192
        return 1;
5193
    }
5194
 
5195
    # lets take the passed in args.
5196
    my ($uid, $gid) = @_;
5197
 
5198
 
5199
    # we need to determine whiich file we are dealing with
5200
    my ($protoTypeFile);
5201
    my ($targetBaseDir);
5202
    my ($pkgBaseDir);
5203
    $protoTypeFile = "$ProtoTypeFile"; 
5204
    $targetBaseDir = "$PkgBaseDir/$TargetBaseDir"; 
5205
    $pkgBaseDir    = "$PkgBaseDir"; 
5206
 
5207
 
5208
    # we need to locate the prototype file
5209
    if ( -f "$protoTypeFile" )
5210
    {
5211
        unlink("$protoTypeFile");
1534 dpurdie 5212
        Verbose("Removing prototype file [$protoTypeFile].");
1530 dpurdie 5213
    }
5214
 
5215
    # lets open the prototype file.
5216
    #    
5217
    local *FILE;
5218
    open ( FILE, "> $protoTypeFile") or
1534 dpurdie 5219
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 5220
 
5221
    # lets populate the prototype file.
5222
    printf FILE ("i pkginfo\n");
5223
 
5224
    if ( "x$TargetBaseDir" ne "x." )
5225
    {
5226
        printf FILE ("!search $TargetBaseDir");
5227
    }
5228
    else
5229
    {
5230
        printf FILE ("!search ");
5231
    }
5232
 
5233
    # now we need to add entries for each directory we will 
5234
    # be installing 
5235
    File::Find::find(\&prototypeFind, "$targetBaseDir");
5236
 
5237
    # lets populate the prototype file with a newline.
5238
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 5239
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 5240
    printf FILE ("\n");
5241
    close (FILE);
5242
 
5243
 
5244
    # lets put the pre-deinfed generic entries into the 
5245
    # prototype file
5246
    #
5247
    if ( "x$PkgPatchNum" ne "x" )
5248
    {
5249
        addPatchInfo2ProtoTypeFile();
5250
    }
5251
 
5252
 
5253
    # we need to expand and complete the creation of the 
5254
    # prototype file
5255
    # if targetbasedir is "." the pkgproto will pick up the pkginfo and
5256
    # prototype files so we need to remove them
5257
    my ($m_cmd) = "pkgproto " .
5258
                  "$TargetBaseDir " .
5259
                  "| egrep -v \"($ProtoTypeFileName|$PkgInfoFileName)\"" .
5260
                  "| cut -f1-4 -d' ' | sed " . '"s/\$/ ' . "$uid $gid" . '/g"' . 
5261
                  " >> $protoTypeFile";
5262
 
5263
    my ($retVal) = system("cd $pkgBaseDir; $m_cmd");
5264
    if ( $retVal != 0 )
5265
    {
1534 dpurdie 5266
        Error("Failed to create prototype file [$protoTypeFile].");
1530 dpurdie 5267
    }
5268
 
1534 dpurdie 5269
    Information("Created prototype file [$protoTypeFile].");
1530 dpurdie 5270
 
5271
    return 1;
5272
}
5273
 
5274
#------------------------------------------------------------------------------
5275
sub prototypeFind
5276
#
5277
#    Description:
5278
#        This subroutine is used to locate all associated package dirs.
5279
#        It also adds an entry into the prototype file for each dir.
5280
#
5281
#------------------------------------------------------------------------------
5282
{
5283
    my($file)= "$File::Find::name";
5284
    my($base)= File::Basename::basename($file);
5285
 
5286
    # we get the absolute path from the find, but we only require
5287
    # a relative path from the starting dir.
5288
    # so our start dir.
5289
 
5290
    # we need to determine whiich file we are dealing with
5291
    my ($pfile);
5292
    my ($tDir);
5293
    $pfile = "$ProtoTypeFile"; 
5294
    $tDir = "$PkgBaseDir/$TargetBaseDir"; 
5295
    if ( "$file" ne "$tDir" )
5296
    {
5297
        if ( -d "$file" )  
5298
        {
5299
            my ($m_sfile) = $file;
5300
 
5301
            if ( "x$TargetBaseDir" eq "x." )
5302
            {
5303
                $tDir = $tDir . "/";
5304
                $file =~ s/$tDir//;
5305
            }
5306
            else
5307
            {
5308
                $file =~ s/$tDir/$TargetBaseDir/;
5309
            }
5310
 
5311
            open ( FILE, ">> $pfile") or
1534 dpurdie 5312
                 Error("Failed to open file [$pfile].");
1530 dpurdie 5313
 
5314
            # lets populate the prototype file.
5315
            printf FILE (" $file");
5316
            close (FILE);
5317
        }
5318
    }
5319
}
5320
 
5321
 
5322
#------------------------------------------------------------------------------
5323
sub addPatchInfo2ProtoTypeFile
5324
#
5325
# Description:
5326
#       This sub-routine is used to add additonal genericinformation
5327
#       used by the patch.
5328
#
5329
#------------------------------------------------------------------------------
5330
{
1534 dpurdie 5331
    Information("Adding patch information files to patch build...");
1530 dpurdie 5332
 
5333
    # we need to determine whiich file we are dealing with
5334
    my ($protoTypeFile);
5335
    $protoTypeFile = "$ProtoTypeFile";
5336
 
5337
    # lets open the prototype file.
5338
    #
5339
    local *FILE;
5340
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 5341
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 5342
 
5343
 
5344
    # we need to copy the install informational files from
5345
    # their resting place.
5346
    my ($i);
5347
    foreach $i ( @PATCH_INFO_FILES )
5348
    {
5349
        if( File::Copy::copy("$PATCH_UTIL_DIR/$i", "$PkgBaseDir") )
5350
        {
1534 dpurdie 5351
            Verbose("Copied [$PATCH_UTIL_DIR/$i] to [$PkgBaseDir] ...");
1530 dpurdie 5352
            printf FILE ("i $i\n"); 
5353
        }
5354
        else
5355
        {
1534 dpurdie 5356
            Error("Failed to copy info file [$PATCH_UTIL_DIR/$i]: $!");
1530 dpurdie 5357
        }
5358
    }
5359
    close FILE;
5360
 
5361
    return 1;
5362
}
5363
 
5364
 
5365
#------------------------------------------------------------------------------
5366
sub useReplaceClass
5367
#
5368
# Description:
5369
#       This sub-routine is used to add replace class to the classes list and
5370
#       include the i.replace file in the PKG_INFO_FILES List
5371
#
5372
#------------------------------------------------------------------------------
5373
{
5374
 
1534 dpurdie 5375
    Information("useReplaceClass: Adding replace class to installer");
1530 dpurdie 5376
 
5377
    $PkgInfoClasses = $PkgInfoClasses . " " . "replace";
5378
    push(@PKG_UTIL_FILES, "i.replace");
5379
}
5380
 
5381
 
5382
#------------------------------------------------------------------------------
5383
sub addPkgInfoClasses
5384
#
5385
# Description:
5386
#       This sub-routine is used to add new classes to the pkginfo CLASSES variable.
5387
#
5388
#------------------------------------------------------------------------------
5389
{
5390
    # correct number of parameters?
5391
    if ( ($#_+1) == 0 )
5392
    {
1534 dpurdie 5393
        Error("Incorrect number of params passed to " .
5394
              "createPkginfoFile() function",
5395
              "Check deploy config.");
1530 dpurdie 5396
    }
5397
 
1534 dpurdie 5398
    Information("addPkgInfoClasses() Adding classes \"" . join(" ", @_) . "\" to CLASSES List");
1530 dpurdie 5399
 
5400
    $PkgInfoClasses = $PkgInfoClasses . " " . join(" ", @_);
5401
}
5402
 
5403
 
5404
#------------------------------------------------------------------------------
5405
sub addPkgInfoField
5406
#
5407
# Description:
5408
#       This sub-routine is used to add new fields to already created pkginfo file
5409
#       Acccepts any number of fields of format A=B as one string parameter.
5410
#------------------------------------------------------------------------------
5411
{
5412
    # lets just check to see if we can execute this function on this machine.
5413
    if ( "$MachType" ne "sparc" )
5414
    {
1534 dpurdie 5415
        Verbose("addPkgInfoField() not supported on this machine type.");
1530 dpurdie 5416
        return 1;
5417
    }
5418
    # lets open the pkginfo file.   
5419
    local *FILE;
1534 dpurdie 5420
    open ( FILE, ">> $PkgInfoFile") or Error("Failed to open file [$PkgInfoFile].");
1530 dpurdie 5421
 
5422
    foreach my $i ( @_ )
5423
    {
5424
        print FILE "$i\n";
5425
    }
5426
    close FILE;
5427
    return 1;
5428
}
5429
 
5430
#------------------------------------------------------------------------------
5431
sub updatePrototypeFileItemClass
5432
#
5433
# Description:
5434
#       This subroutine is used to change the class of a file already in the prototype file
5435
#
5436
#------------------------------------------------------------------------------
5437
{
5438
    # correct number of parameters?
5439
    if ( ($#_+1) != 2 )
5440
    {
1534 dpurdie 5441
        Error("Incorrect number of params passed to " .
1530 dpurdie 5442
                  "updatePrototypeFileItemClass() function. Check deploy config.");
5443
    }
5444
 
5445
 
5446
    # lets just check to see if we can execute this function on
5447
    # this machine.
5448
    #
5449
    if ( "$MachType" ne "sparc" )
5450
    {
1534 dpurdie 5451
        Verbose("updatePrototypeFileItemClass() not supported on this machine type.");
1530 dpurdie 5452
        return 1;
5453
    }
5454
 
5455
 
5456
    # lets setup the passed values.
5457
    my ($m_item, $class) = @_;
5458
 
5459
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5460
 
5461
    # lets open the prototype file if it exists
5462
    #
5463
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5464
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5465
 
5466
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5467
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5468
 
5469
    while ( <PFILE> )
5470
    {
5471
        chomp;
5472
        # The path section will normally contain "path [mode]" or path=path
5473
        # The passed arg can be full path or can skip top level dirs
5474
        # eg prototype can have line with path ergbpeod/etc/afcbp.ini
5475
        # arg to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini
5476
        # therefore we need to match arg to the end of the path in line 
5477
        # so we append [= ] to arg
5478
        s/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1$class$2/ if ( /$m_item[ =]/ );
5479
        printf PFILETMP ("$_\n");
5480
    }
5481
    close PFILE;
5482
    close PFILETMP;
5483
 
5484
    # now we need to copy the file.
5485
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5486
    {
1534 dpurdie 5487
        Verbose("Updated file $m_item to class $class");
1530 dpurdie 5488
        unlink($tmpProtoTypeFile);
5489
    }
5490
    else
5491
    {
1534 dpurdie 5492
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5493
    }
5494
 
5495
    return 1;
5496
 
5497
}
5498
 
5499
 
5500
 
5501
#------------------------------------------------------------------------------
5502
sub setReplaceClassFiles
5503
#
5504
# Description:
5505
#       This subroutine is used to change the class of a file already in the prototype file
5506
#
5507
#------------------------------------------------------------------------------
5508
{
5509
    # lets just check to see if we can execute this function on
5510
    # this machine.
5511
    #
5512
    if ( "$MachType" ne "sparc" )
5513
    {
1534 dpurdie 5514
        Verbose("updatePrototypeFileItemClass() not supported on this machine type.");
1530 dpurdie 5515
        return 1;
5516
    }
5517
 
1534 dpurdie 5518
    Error("Must call useReplaceClass() before calling setReplaceClassFiles()") if ( $PkgInfoClasses !~ /replace/ );
1530 dpurdie 5519
 
5520
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5521
 
5522
    # lets open the prototype file if it exists
5523
    #
5524
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5525
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5526
 
5527
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5528
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5529
 
5530
    my $line;
5531
    while ( $line = <PFILE> )
5532
    {
5533
        chomp $line;
5534
        # The path section will normally contain "path [mode]" or path=path
5535
        # The passed args can be full path or can skip top level dirs
5536
        # eg prototype can have line with path ergbpeod/etc/afcbp.ini
5537
        # args to match can be ergbpeod/etc/afcbp.ini, etc/afcbp.ini or afcbp.ini
5538
        # therefore we need to match each arg to the end of the path in line 
5539
        # so we append [= ] to end of each arg
5540
        $line =~ s/^(\s*[bcdefilpsvx]\s*)[^\s]*(.*$)/$1replace$2/ if ( scalar(grep { $line =~ /$_[ =]/ } @_) > 0 );
5541
        printf PFILETMP ("$line\n");
5542
    }
5543
    close PFILE;
5544
    close PFILETMP;
5545
 
5546
    # now we need to copy the file.
5547
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5548
    {
1534 dpurdie 5549
        Verbose("Updated prototype file entries to class replace");
1530 dpurdie 5550
        unlink($tmpProtoTypeFile);
5551
    }
5552
    else
5553
    {
1534 dpurdie 5554
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5555
    }
5556
 
5557
    return 1;
5558
 
5559
}
5560
 
5561
 
5562
#------------------------------------------------------------------------------
5563
sub createPkginfoFile
5564
#
5565
# Description:
5566
#       This sub-routine is used to create the required package info.
5567
#       Accepts any number of parameters, with each parameter taken as a literal
5568
#       Field=Value string and inserted into the PkgInfo File
5569
#------------------------------------------------------------------------------
5570
{
5571
    # lets check to see if our description has been set
5572
    if ( $PkgDesc eq "" )
5573
    {
1534 dpurdie 5574
        Error("Package description not set. " .
1530 dpurdie 5575
                 "Use setPkgDescription('my package description') function.");
5576
    }
5577
 
5578
    # lets check to see if our long name has been set
5579
    if ( $PkgNameLong eq "" )
5580
    {
1534 dpurdie 5581
        Error("Package name not set. Use setPkgName('my package long name') function.");
1530 dpurdie 5582
    }
5583
 
5584
 
5585
    # lets just check to see if we can execute this function on
5586
    # this machine.
5587
    #
5588
    if ( "$MachType" ne "sparc" )
5589
    {
5590
        generateIShieldIncludeFile();
5591
        return 1;
5592
    }
5593
 
5594
    # we need to determine whiich file we are dealing with
5595
    my ($pkginfoFile) = "$PkgInfoFile"; 
5596
 
5597
    # we need to locate the pkginfo file
5598
    if ( -f "$pkginfoFile" )
5599
    {
5600
        unlink("$pkginfoFile");
1534 dpurdie 5601
        Verbose("Removing pkginfo file [$pkginfoFile].");
1530 dpurdie 5602
    }
5603
 
5604
    # lets open the pkginfo file.
5605
    #    
5606
    local *FILE;
5607
    open ( FILE, "> $pkginfoFile") or
1534 dpurdie 5608
        Error("Failed to open file [$pkginfoFile].");
1530 dpurdie 5609
 
5610
    # lets populate the pkginfo file.
5611
    printf FILE ("PKG=$PkgName\n");
5612
 
5613
 
5614
    # here we deal with the new version number format
5615
    #
5616
    printf FILE ("NAME=$PkgNameLong\n");
5617
    printf FILE ("VERSION=$PkgVersion.$ProjectAcronym\n");
5618
    printf FILE ("ARCH=$MachType\n");
5619
    printf FILE ("VENDOR=$VENDOR_DESC\n");
5620
    printf FILE ("DESC=$PkgDesc\n");
5621
    printf FILE ("CATEGORY=$CATEGORY_DESC\n");
5622
    printf FILE ("BASEDIR=$ERGAFC_BASEDIR\n");
5623
    printf FILE ("TARGETBASEDIR=$TargetBaseDir\n");
5624
    printf FILE ("CLASSES=$PkgInfoClasses\n");
5625
 
5626
    foreach my $param ( @_ )
5627
    {
5628
        printf FILE "$param\n";
5629
    }
5630
 
5631
    if ( "x$PkgPatchNum" ne "x" )
5632
    {
5633
        my ($count)=1;
5634
        my ($pRev)="";
5635
        printf FILE ("MAXINST=$MAXINST\n");
5636
        printf FILE ("SUNW_PATCHID=$PkgPatchID\n");
5637
        printf FILE ("SUNW_REQUIRES=\n");
5638
        printf FILE ("SUNW_INCOMPAT=\n");
5639
 
5640
        $count=1;
5641
        $pRev="";
5642
        printf FILE ("SUNW_OBSOLETES=");
5643
        while ( $count < $PkgPatchNum )
5644
        {
5645
            $pRev = sprintf ("%02s", $count); 
5646
            printf FILE ("$PkgPatchName" . 
5647
                         "$PkgVersionStr" . 
5648
                         "-" . 
5649
                         "$pRev ");
5650
            $count++;
5651
        }
5652
        printf FILE ("\n");
5653
 
5654
        $count=1;
5655
        $pRev="";
5656
        printf FILE ("PATCH_OBSOLETES=");
5657
        while ( $count < $PkgPatchNum )
5658
        {
5659
            $pRev = sprintf ("%02s", $count); 
5660
            printf FILE ("$PkgPatchName" . 
5661
                         "$PkgVersionStr" . 
5662
                         "-" . 
5663
                         "$pRev ");
5664
            $count++;
5665
        }
5666
        printf FILE ("\n");
5667
    }
5668
 
5669
 
5670
    # now we will list the build dependencies so
5671
    # we can refer to them online
5672
    #
5673
    my ($i);
5674
    my ($m_Str);
5675
    # printf FILE ("\n");
5676
    my ($count) = 1;
5677
    foreach $i ( $BuildFileInfo->getDpkgArchiveList() )
5678
    {
5679
         my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
5680
 
5681
         printf FILE ( "$moduleInfo->{type}\_$count=$i $moduleInfo->{version}");
5682
 
5683
         # we shall print the project bit if we have one
5684
         if ( $moduleInfo->{proj} ne "" )
5685
         {
5686
             printf FILE ( "\.$moduleInfo->{proj}\n");
5687
         }
5688
         else
5689
         {
5690
             printf FILE ("\n");
5691
         }
5692
         $count++;
5693
    }
5694
    close FILE;
5695
 
5696
 
5697
    # lets close the pkginfo file.
5698
    close (FILE);
1534 dpurdie 5699
    Information("Created pkginfo file [$pkginfoFile].");
1530 dpurdie 5700
 
5701
    return 1;
5702
}
5703
 
5704
 
5705
#------------------------------------------------------------------------------
5706
sub updatePrototypeFileItemOwner
5707
#
5708
# Description:
5709
#       This sub-routine is used to change the ownership of a file item
5710
#       in the prototype file.
5711
#
5712
#------------------------------------------------------------------------------
5713
{
5714
    # correct number of parameters?
5715
    if ( ($#_+1) != 4 )
5716
    {
1534 dpurdie 5717
        Error("Incorrect number of params passed to " .
1530 dpurdie 5718
                  "updatePrototypeFileItemOwner() function. Check deploy config.");
5719
    }
5720
 
5721
 
5722
    # lets just check to see if we can execute this function on
5723
    # this machine.
5724
    #
5725
    if ( "$MachType" ne "sparc" )
5726
    {
1534 dpurdie 5727
        Verbose("chmod() not supported on this machine type.");
1530 dpurdie 5728
        return 1;
5729
    }
5730
 
5731
 
5732
    # lets setup the passed values.
5733
    my ($m_item, $m_ownPerms, $m_ownUser, $m_ownGroup) = @_;
5734
 
5735
 
5736
    my ($tmpProtoTypeFile) = "/tmp/xx_prototypefile.$$";
5737
 
5738
 
5739
    # lets open the prototype file if it exists
5740
    #
5741
    open (PFILE, "< $ProtoTypeFile") or
1534 dpurdie 5742
        Error("Failed to open prototype file [$ProtoTypeFile].");
1530 dpurdie 5743
 
5744
    open (PFILETMP, "> $tmpProtoTypeFile") or
1534 dpurdie 5745
        Error("Failed to open tmp prototype file [$tmpProtoTypeFile].");
1530 dpurdie 5746
 
5747
    my ($inLine);
5748
    while ( <PFILE> )
5749
    {
5750
        $inLine = $_;
5751
        chomp($inLine);
5752
        if ( "$inLine" =~ /^f / && "$inLine" =~ /$m_item/ )
5753
        {
5754
            my ($b1, $b2, $b3, $b4, $b5, $b6) = split (/ /, $inLine); 
5755
            printf PFILETMP ("$b1 $b2 $b3 $m_ownPerms $m_ownUser $m_ownGroup\n");
5756
        }
5757
        else
5758
        {
5759
            printf PFILETMP ("$inLine\n");
5760
        }
5761
    }
5762
    close PFILE;
5763
    close PFILETMP;
5764
 
5765
    # now we need to copy the file.
5766
    if(File::Copy::copy("$tmpProtoTypeFile", "$ProtoTypeFile"))
5767
    {
1534 dpurdie 5768
        Verbose("Copied [$tmpProtoTypeFile] to [$ProtoTypeFile] ...");
1530 dpurdie 5769
        unlink($tmpProtoTypeFile);
5770
    }
5771
    else
5772
    {
1534 dpurdie 5773
        Error("Failed to copy lib [$tmpProtoTypeFile]: $!");
1530 dpurdie 5774
    }
5775
 
5776
    return 1;
5777
 
5778
}
5779
 
5780
 
5781
#------------------------------------------------------------------------------
5782
sub chmod
5783
#
5784
# Description:
5785
#       This sub-routine is used to change the ownership of a file or
5786
#       directory structure.
5787
#
5788
#------------------------------------------------------------------------------
5789
{
5790
    # correct number of parameters?
5791
    if ( ($#_+1) != 3 )
5792
    {
1534 dpurdie 5793
        Error("Incorrect number of params passed to " .
1530 dpurdie 5794
                  "chmod() function. Check deploy config.");
5795
    }
5796
 
5797
 
5798
    # lets setup the passed values.
5799
    my ($m_sDirTag, $m_sfile, $m_ownPerms) = @_;
5800
 
5801
 
5802
    # lets just check to see if the perms are in correct format.
5803
    #
5804
    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
5805
    {
1534 dpurdie 5806
        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
1530 dpurdie 5807
        return 1;
5808
    }
5809
 
5810
    # lets get the absolute src dir value
5811
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
5812
 
5813
    my($item);
5814
    if ( "x$m_sfile" eq "x" )
5815
    {
5816
        $item = "$m_sDirAbsoluteValue";
5817
    }
5818
    else
5819
    {
5820
        $item = "$m_sDirAbsoluteValue/$m_sfile";
5821
    }
5822
 
5823
    # check to see if item exists
5824
    #
5825
    if ( ! -f "$item" && 
5826
         ! -d "$item" )
5827
    {
1534 dpurdie 5828
        Error("Failed to find item [$item]. Check deploy config."); 
1530 dpurdie 5829
    }
1534 dpurdie 5830
    Verbose("chmod: Changing permisions of file [$m_sfile] in dirtag [$m_sDirTag] to [$m_ownPerms]");
1530 dpurdie 5831
    chmodFile("$item", $m_ownPerms);
5832
 
5833
    return 1;
5834
}
5835
 
5836
 
5837
#------------------------------------------------------------------------------
5838
sub chmodRecursive
5839
#
5840
# Description:
5841
#       This sub-routine is used to change the permissions recursively in
5842
#       the target packgae.
5843
#
5844
#------------------------------------------------------------------------------
5845
{
5846
    # correct number of parameters?
5847
    if ( ($#_+1) != 2 )
5848
    {
1534 dpurdie 5849
        Error("Incorrect number of params passed to " .
1530 dpurdie 5850
                  "chmodRecursive() function. Check deploy config.");
5851
    }
5852
 
5853
    # lets setup the passed values.
5854
    my ($m_sDirTag, $m_ownPerms) = @_;
5855
 
5856
    # lets just check to see if the perms are in correct format.
5857
    #
5858
    if ( "$m_ownPerms" !~ m/^[0-9][0-9][0-9][0-9]$/ )
5859
    {
1534 dpurdie 5860
        Error("chmod() does not support [$m_ownPerms] permission, use format 0755 etc.");
1530 dpurdie 5861
        return 1;
5862
    }
5863
 
5864
 
5865
    # lets get the absolute src dir value
5866
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
5867
 
5868
 
5869
    # check to see if item exists
5870
    #
5871
    if ( ! -f "$m_sDirAbsoluteValue" &&
5872
         ! -d "$m_sDirAbsoluteValue" )
5873
    {
1534 dpurdie 5874
        Error("Failed to find item [$m_sDirAbsoluteValue]. " .
1530 dpurdie 5875
                  "Check deploy config."); 
5876
    }
5877
 
5878
 
5879
    # if its a not a dir
5880
    #
5881
    if ( ! -d "$m_sDirAbsoluteValue" && -f "$m_sDirAbsoluteValue" )
5882
    {
1534 dpurdie 5883
        Warning("chmodRecursive: This should not happen as dirtag [$m_sDirTag] is a file, changings perms to [$m_ownPerms] anyway");
1530 dpurdie 5884
        chmodFile("$m_sDirAbsoluteValue", $m_ownPerms);
5885
    }
5886
    else
5887
    {
5888
        # it must be a dir
1534 dpurdie 5889
        Verbose("chmodRecursive: Recursively setting perms on dirtag [$m_sDirTag] to [$m_ownPerms]");
1530 dpurdie 5890
        chmodDir("$m_sDirAbsoluteValue", $m_ownPerms);
5891
    }
5892
 
5893
    return 1;
5894
}
5895
 
5896
 
5897
 
5898
 
5899
#------------------------------------------------------------------------------
5900
sub chmodDir
5901
#
5902
# Description:
5903
#       This sub-routine is used to change the permissions an entire directory tree.
5904
#
5905
#       It recurses from a starting point chmod'ing each item and if it
5906
#       finds a dir it recurses into that dir chmod'ing it as well.
5907
#
5908
#------------------------------------------------------------------------------
5909
{
5910
    # correct number of parameters?
5911
    if ( ($#_+1) != 2 )
5912
    {
1534 dpurdie 5913
        Error("Incorrect number of params passed to " .
1530 dpurdie 5914
                  "chmodDir() function.");
5915
    }
5916
 
5917
    my ($startingPoint, $perms) = @_;
5918
 
1534 dpurdie 5919
    Verbose("chmodDir: Recursively setting permsision of [$startingPoint] to [$perms]");
1530 dpurdie 5920
 
5921
    local *DIR;
5922
    opendir(DIR, $startingPoint) or
1534 dpurdie 5923
        Error("can't opendir $startingPoint: $!");
1530 dpurdie 5924
 
5925
    my ($item);
5926
    while (defined($item = readdir(DIR)))
5927
    {
5928
        if ( "$item" !~ /^\.$/  &&
5929
             "$item" !~ /^\.\.$/ )
5930
        {
5931
            if ( -d "$startingPoint/$item" )
5932
            {
5933
                chmodDir("$startingPoint/$item", $perms);
5934
            }
5935
            else
5936
            {
5937
                chmodFile("$startingPoint/$item", $perms);
5938
            }
5939
        }
5940
    }
5941
    close (DIR);
5942
 
5943
    # lets deal with starting dir
5944
    # 
5945
    chmodFile("$startingPoint", $perms);
5946
 
5947
    return 1;
5948
}
5949
 
5950
 
5951
 
5952
#------------------------------------------------------------------------------
5953
sub chmodFile
5954
#
5955
#    this function is used to chmod the perms od an item
5956
#    it is passed the absolute path to the item and the associated 
5957
#    perms.
5958
#
5959
#------------------------------------------------------------------------------
5960
{
5961
    my ($item, $perms) = @_;
5962
 
5963
    my ($cmd) = "CORE::chmod $perms, $item";
5964
    my ($noItems) = CORE::chmod oct($perms), $item;
5965
    if ( $noItems == 0 )
5966
    {
1534 dpurdie 5967
        Error("Failed to complete command [$cmd], retVal=[$noItems]");
1530 dpurdie 5968
    }
5969
    else
5970
    {
1534 dpurdie 5971
        Debug("Executed command: [$cmd]");
1530 dpurdie 5972
    }
5973
 
5974
    return 1;
5975
}
5976
 
5977
 
5978
 
5979
#------------------------------------------------------------------------------
5980
sub createSymbolicLink
5981
#
5982
# Description:
5983
#       This sub-routine is used to copy a local deployment file into
5984
#       the target destination dir. 
5985
#
5986
#
5987
#------------------------------------------------------------------------------
5988
{
5989
    # correct number of parameters?
5990
    if ( ($#_+1) != 3 )
5991
    {
1534 dpurdie 5992
        Error("Incorrect number of params passed to " .
1530 dpurdie 5993
                  "createSymbolicLink() function. Check deploy config.");
5994
    }
5995
 
5996
 
5997
    # lets just check to see if we can execute this function on
5998
    # this machine.
5999
    #
6000
    if ( "$MachType" ne "sparc" )
6001
    {
1534 dpurdie 6002
        Verbose("createSymbolicLink() not supported on this machine type.");
1530 dpurdie 6003
        return 1;
6004
    }
6005
 
6006
 
6007
    # lets setup the passed values.
6008
    my ($m_sDirTag, $m_srcStr, $m_linkStr) = @_;
6009
 
6010
    # lets get the absolute src dir value
6011
    my ($m_sDirAbsoluteValue) = getTargetDstDirValue($m_sDirTag, "A");
6012
 
6013
 
6014
    # lets see if the source item exists
6015
    #
6016
    if ( ! -f "$m_sDirAbsoluteValue/$m_srcStr" )
6017
    {
1534 dpurdie 6018
        Error("Failed to locate item [$m_sDirAbsoluteValue/$m_srcStr], link not created.");
1530 dpurdie 6019
    }
6020
 
6021
 
6022
 
6023
    my ($cmd) = "cd $m_sDirAbsoluteValue; ln -s $m_srcStr $m_linkStr";
6024
    system("$cmd");
6025
    if ( $? != 0 )
6026
    {
1534 dpurdie 6027
        Error("Failed to complete command: [$cmd]");
1530 dpurdie 6028
    }
6029
    else
6030
    {
1534 dpurdie 6031
        Verbose("Executed command: [$cmd]");
1530 dpurdie 6032
    }
6033
 
6034
    return 1;
6035
}
6036
 
6037
 
6038
#------------------------------------------------------------------------------
6039
sub createPrototypeFile2
6040
#
6041
# Description:
6042
#       This sub-routine is used to create the required package prototype file
6043
#       fom a known directory struture using the a=b format.
6044
#
6045
#------------------------------------------------------------------------------
6046
{
6047
    # correct number of parameters?
6048
    if ( ($#_+1) != 3 )
6049
    {
1534 dpurdie 6050
        Error("Incorrect number of params passed to " .
1530 dpurdie 6051
                  "createPrototypeFile2() function. Check deploy config.");
6052
    }
6053
 
6054
    # lets just check to see if we can execute this function on
6055
    # this machine.
6056
    #
6057
    if ( "$MachType" ne "sparc" )
6058
    {
1534 dpurdie 6059
        Verbose("createPrototypeFile2() not supported on this machine type.");
1530 dpurdie 6060
        return 1;
6061
    }
6062
 
6063
    # lets take the passed in args.
6064
    my ($uid, $gid, $mask) = @_;
6065
 
6066
 
6067
    # we need to determine whiich file we are dealing with
6068
    my ($protoTypeFile);
6069
    my ($targetBaseDir);
6070
    my ($pkgBaseDir);
6071
    $protoTypeFile = "$ProtoTypeFile"; 
6072
    $targetBaseDir = "$PkgBaseDir/$TargetBaseDir"; 
6073
    $pkgBaseDir    = "$PkgBaseDir"; 
6074
 
6075
 
6076
    # we need to locate the prototype file
6077
    if ( -f "$protoTypeFile" )
6078
    {
6079
        unlink("$protoTypeFile");
1534 dpurdie 6080
        Verbose("Removing prototype file [$protoTypeFile].");
1530 dpurdie 6081
    }
6082
 
6083
    # lets open the prototype file.
6084
    #    
6085
    local *FILE;
6086
    open ( FILE, "> $protoTypeFile") or
1534 dpurdie 6087
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 6088
    # lets populate the prototype file.
6089
    printf FILE ("!default $mask $uid $gid\n");
6090
    printf FILE ("i pkginfo\n");
6091
    close (FILE);
6092
 
6093
 
6094
    # lets put the pre-deinfed generic entries into the
6095
    # prototype file
6096
    #
6097
    if ( "x$PkgPatchNum" ne "x" )
6098
    {
6099
        addPatchInfo2ProtoTypeFile();
6100
    }
6101
 
6102
 
6103
    # lets set the associated uid, gid and mask
6104
    # for the bits in the prototype file.
6105
    #
6106
    $m_UID  = $uid;
6107
    $m_GID  = $gid;
6108
    $m_MASK = $mask;
6109
 
6110
 
6111
    # now we need to add entries for each directory we will 
6112
    # be installing 
6113
    File::Find::find(\&prototype2Find, "$targetBaseDir");
6114
 
6115
 
6116
    # lets populate the prototype file with a newline.
6117
    open ( FILE, ">> $protoTypeFile") or
1534 dpurdie 6118
        Error("Failed to open file [$protoTypeFile].");
1530 dpurdie 6119
    printf FILE ("\n");
6120
    close (FILE);
6121
 
6122
 
1534 dpurdie 6123
    Information("Created prototype file [$protoTypeFile].");
1530 dpurdie 6124
 
6125
    return 1;
6126
}
6127
 
1534 dpurdie 6128
#-------------------------------------------------------------------------------
6129
# Function        : createZip
6130
#
6131
# Description     : Create a ZIp file of a given directory
6132
#
6133
# Inputs          : --Recurse               - Recurse subdirs
6134
#                   --NoRecurse             - Done recurse subdirs
6135
#                   --Dirnames              - Record Dir names
6136
#                   --NoDirnames            - Don't record dirnames
6137
#                   --NoQuiet               - Display the operatios
6138
#                   --Dir=xxxx              - Symbolic Directory to zip
6139
#                   --ZipDir=ttt            - Symbolic target directory
6140
#                   --ZipFile=yyyy          - Zipfile to create
6141
#
6142
# Returns         : Will not return on error
6143
#                   Requires 'zip' to be provided by a 'package' such as InfoZip
6144
#
6145
sub createZip
6146
{
6147
    my $recurse = 1;
6148
    my $dirnames = 0;
6149
    my $quiet = 1;
6150
    my $sdir;
6151
    my $tdir;
6152
    my $tfile;
1530 dpurdie 6153
 
1534 dpurdie 6154
    #
6155
    #   Only on Windows at the moment.
6156
    #   Perhaps Unix should create a .gz file
6157
    #
6158
    Warning ("createZip not supported on $MachType. Operation skipped")
6159
        unless ( "$MachType" eq "win32" );
6160
 
6161
    #
6162
    #   Process user arguments
6163
    #
6164
    foreach ( @_ )
6165
    {
6166
        if ( m/^--Recurse/ ) {
6167
            $recurse = 1;
6168
 
6169
        } elsif ( m/^--NoRecurse/) {
6170
            $recurse = 0;
6171
 
6172
        } elsif ( m/^--Dirnames/ ) {
6173
            $dirnames = 1;
6174
 
6175
        } elsif ( m/^--NoDirnames/ ) {
6176
            $dirnames = 0;
6177
 
6178
        } elsif ( m/^--NoQuiets/ ) {
6179
            $quiet = 0;
6180
 
6181
        } elsif ( m/^--Dir=(.*)/ ) {
6182
            $sdir = $1;
6183
 
6184
        } elsif ( m/^--ZipDir=(.*)/ ) {
6185
            $tdir = $1;
6186
 
6187
        } elsif ( m/^--ZipFile=(.*)/ ) {
6188
            $tfile = $1;
6189
 
6190
        } else {
6191
            Warning("createZip: Unknown argument ignored: $_");
6192
 
6193
        }
6194
    }
6195
 
6196
    #
6197
    #   Convert the source directory TAG into a real directory
6198
    #
6199
    Error ("createZip: Source directory not specified") unless ( $sdir );
6200
    my $sdir_a = getTargetDstDirValue($sdir, "A");
6201
 
6202
    #
6203
    #   Convert the destination directory tag into a real directory
6204
    #
6205
    Error ("createZip: Target directory not specified") unless ( $tdir );
6206
    Error ("createZip: Target filename not specified") unless ( $tfile );
6207
    my $tdir_a = getTargetDstDirValue($tdir, "A");
6208
 
6209
    #
6210
    #   Locate the 'zip' uitilty
6211
    #
6212
    my $prog = LocateProgInPath( 'zip' );
6213
    Error ("createZip: Cannot locate ZIP executable",
6214
            "May need to use the 'infozip' package") unless ( $prog );
6215
 
6216
    #
6217
    #   Generate command file
6218
    #
6219
    my $args = '-9';
6220
    $args .= 'q' unless ( (! $quiet) || IsVerbose(1));
6221
    $args .= 'r' if ( $recurse );
6222
    $args .= 'j' unless ( $dirnames );
6223
 
6224
    #
6225
    #   Zip up the files
6226
    #
6227
    Information ("Create Zip File: [$tdir] $tfile");
6228
    chdir ( $sdir_a ) || Error ("Cannot cd to $sdir_a");
6229
    my $rv = System ($prog, $args, "$tdir_a/$tfile", "." );
6230
    chdir($CurrentDir) || Error ("Cannot cd to $CurrentDir");
6231
 
6232
    Error ("createZip: Zip file not created") if ( $rv );
6233
}
6234
 
6235
 
1530 dpurdie 6236
#------------------------------------------------------------------------------
6237
sub prototype2Find
6238
#
6239
#    Description:
6240
#        This subroutine is used to locate all associated package dirs.
6241
#        It also adds an entry into the prototype file for each dir.
6242
#
6243
#------------------------------------------------------------------------------
6244
{
6245
    my($file)= "$File::Find::name";
6246
    my($base)= File::Basename::basename($file);
6247
 
6248
    # we get the absolute path from the find, but we only require
6249
    # a relative path from the starting dir.
6250
    # so our start dir.
6251
 
6252
    # we need to determine which file we are dealing with
6253
    my ($pfile);
6254
    my ($tDir);
6255
    $pfile = "$ProtoTypeFile";
6256
    $tDir = "$PkgBaseDir/$TargetBaseDir";
6257
 
6258
    if ( "$file" ne "$tDir" )
6259
    {
6260
        my ($m_sfile) = $file;
6261
        if ( "x$TargetBaseDir" eq "x." )
6262
        {
6263
            $tDir = $tDir . "/";
6264
            $file =~ s/$tDir//;
6265
        }
6266
        else
6267
        {
6268
            $file =~ s/$tDir/$TargetBaseDir/;
6269
        }
6270
 
6271
        # if TargetBaseDir is "." then find will find the pkginfo & prototype 
6272
        # files so we need to exclude them
6273
        if ( "$file" ne "$ProtoTypeFileName" &&
6274
             "$file" ne "$PkgInfoFileName")
6275
        {
6276
            open ( FILE, ">> $pfile") or
1534 dpurdie 6277
                Error("Failed to open file [$pfile].");
1530 dpurdie 6278
 
6279
            if ( -f "$m_sfile" )
6280
            {
6281
                printf FILE ("f none $file=$file $m_MASK $m_UID $m_GID\n");
6282
            }
6283
 
6284
            if ( -d "$m_sfile" )
6285
            {
6286
                printf FILE ("d none $file $m_MASK $m_UID $m_GID\n");
6287
            }
6288
 
6289
            close (FILE);
6290
        }
6291
    }
6292
}
6293
 
6294
 
6295
#------------------------------------------------------------------------------
6296
sub convertFile
6297
#
6298
# Description:
6299
#       This sub-routine is used to remove all carrage return\line feeds
6300
#       from a line and replace them with the platform specific equivalent chars.
6301
#
6302
#       We let PERL determine what characters are written to the file base on the 
6303
#       platform you are running on.
6304
#
6305
#
6306
#       i.e. LF    for unix
6307
#            CR\LF for win32
6308
#
6309
#------------------------------------------------------------------------------
6310
{
6311
   # correct number of parameters?
6312
    if ( ($#_+1) != 2 )
6313
    {
1534 dpurdie 6314
        Error("Incorrect number of params passed to " .
1530 dpurdie 6315
                  "convertFile() function. Check deploy config.");
6316
    }
6317
    my ($m_targetDirTag, $m_nfile) = @_;
6318
 
6319
 
6320
    # lets get the src dir value
6321
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
6322
 
6323
 
6324
    # this is our file that we want to clean.
6325
    my ($m_ifileLoc) = "$m_targetDirValue/$m_nfile";
6326
    my ($m_tfileLoc) = "$m_targetDirValue/$m_nfile\.tmp";
6327
 
6328
 
6329
    # we will check to see if the file exists.
6330
    #
6331
    local *IFILE;
6332
    local *TFILE;
6333
    if ( -f "$m_ifileLoc" )
6334
    {
6335
        open (IFILE, "< $m_ifileLoc" ) or
1534 dpurdie 6336
            Error("Failed to open file [$m_ifileLoc] : $!");
1530 dpurdie 6337
 
6338
        open (TFILE, "> $m_tfileLoc" ) or
1534 dpurdie 6339
            Error("Failed to open file [$m_tfileLoc] : $!");
1530 dpurdie 6340
 
6341
        while ( <IFILE> ) 
6342
        {
6343
            chomp;
6344
            print TFILE "$_\n";
6345
        }
6346
    }
6347
    else
6348
    {
1534 dpurdie 6349
        Error("Deploy file [$m_ifileLoc] does not exist.");
1530 dpurdie 6350
    }
6351
 
6352
    close IFILE;
6353
    close TFILE;
6354
 
6355
 
6356
    # lets replace our original file with the new one
6357
    #
6358
    if(File::Copy::move("$m_tfileLoc", "$m_ifileLoc"))
6359
    {
1534 dpurdie 6360
        Information("Renamed [$m_tfileLoc] to [$m_ifileLoc] ...");
1530 dpurdie 6361
    }
6362
    else
6363
    {
1534 dpurdie 6364
        Error("Failed to crename file [$m_tfileLoc] to [$m_ifileLoc]: $!");
1530 dpurdie 6365
    }
6366
 
6367
    return 1;
6368
}
6369
 
1534 dpurdie 6370
#-------------------------------------------------------------------------------
6371
# Function        : installDeployFile
1530 dpurdie 6372
#
1534 dpurdie 6373
# Description     : This sub-routine is used to copy a local deployment file into
6374
#                   the target destination dir.
1530 dpurdie 6375
#
1534 dpurdie 6376
# Inputs          : m_srcDirTag             - Tag for Source Dir name
6377
#                                             Tag defined in %LocalSrcDirStructure
6378
#                   m_sfile                 - Name of the source file
6379
#                   m_targetDirTag          - Tag for the target directory
6380
#                                             Tag defined in %TargetDstDirStructure
6381
#                   m_nfile                 - Target filename
6382
#                                             Must be specified. If set to "", then
6383
#                                             the source filename will be used.
1530 dpurdie 6384
#
1534 dpurdie 6385
# Returns         : True
6386
#
1530 dpurdie 6387
#------------------------------------------------------------------------------
1534 dpurdie 6388
 
6389
sub installDeployFile
1530 dpurdie 6390
{
6391
    # correct number of parameters?
6392
    if ( ($#_+1) != 4 )
6393
    {
1534 dpurdie 6394
        Error("Incorrect number of params passed to " .
1530 dpurdie 6395
                  "installDeployFile() function. Check deploy config.");
6396
    }
6397
 
6398
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_nfile) = @_;
6399
 
6400
    # lets get the src dir value
6401
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
6402
 
6403
    # lets get the target dir value
6404
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
6405
 
6406
 
6407
    # we know where we are getting this from and where we 
6408
    # going to put them.
6409
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
6410
 
6411
    my ($m_nfileLoc) = "";
6412
    # lets determine what we are going to call the new file.
6413
    #
6414
    if ( "x$m_nfile" eq "x" )
6415
    {
6416
        $m_nfileLoc = "$m_targetDirValue/$m_sfile";
6417
    }
6418
    else
6419
    {
6420
        $m_nfileLoc = "$m_targetDirValue/$m_nfile";
6421
    }
6422
 
6423
 
6424
    # we will check to see if the file exists.
6425
    #
6426
    if ( -f "$m_sfileLoc" )
6427
    {
6428
        # now we need to copy the file. 
6429
        if(File::Copy::copy("$m_sfileLoc", "$m_nfileLoc"))
6430
        {
1534 dpurdie 6431
            Verbose("Copied [$m_sfile] to [$m_nfileLoc] ...");
1530 dpurdie 6432
 
6433
            # now we need to ensure the item is writable as it
6434
            # has come from our VOB that is by definition read-only
6435
            #
6436
            CORE::chmod oct("0755"), $m_nfileLoc;
6437
 
6438
        }
6439
        else
6440
        {
1534 dpurdie 6441
            Error("Failed to copy lib [$m_sfileLoc]: $!"); 
1530 dpurdie 6442
        }
6443
    }
6444
    else
6445
    {
1534 dpurdie 6446
        Error("Deploy file [$m_sfileLoc] does not exist.");
1530 dpurdie 6447
    }
6448
 
6449
    return 1;
6450
}
6451
 
6452
 
6453
#------------------------------------------------------------------------------
6454
sub getGenericNameForLib
6455
#
6456
# Description:
6457
#       This sub-routine is used to determine the generic name for
6458
#       a library. I.E remove the buildtype and version number.
6459
#
6460
#       It also checks if the name provided should be excluded from
6461
#       the build.
6462
#
6463
#------------------------------------------------------------------------------
6464
{
6465
   # correct number of parameters?
6466
    if ( ($#_+1) != 1 )
6467
    {
1534 dpurdie 6468
        Error("Incorrect number of params passed to " .
1530 dpurdie 6469
                  "getGenericNameForLib() function. Check deploy config.");
6470
    }
6471
 
6472
    # lets just check to see if we can execute this function on
6473
    # this machine.
6474
    #
6475
    if ( "$MachType" ne "sparc" )
6476
    {
1534 dpurdie 6477
        Verbose("getGenericNameForLib() not supported on this machine type.");
1530 dpurdie 6478
        return "";
6479
    }
6480
 
6481
 
6482
    my($itemName) = @_;
6483
 
6484
    # first we need to check to see if it belongs in this build
6485
    #
6486
    my ($gName) = "";
6487
    if(excludeItemFromBuild($itemName))
6488
    {
1534 dpurdie 6489
        Verbose("Excluding item [$itemName] from build as not compatible with build type " .
1530 dpurdie 6490
                "[$BuildType].");
6491
        return "";  # file should be excluded.
6492
    }
6493
    else
6494
    {
6495
        $gName = removeBuildTypeFromItemName($itemName);
6496
        $gName = removeVersionNumberFromItemName($gName);
6497
 
6498
        return "$gName";
6499
    }
6500
 
6501
    return 1;
6502
}
6503
 
6504
 
6505
#------------------------------------------------------------------------------
6506
sub getGenericNameNoVersionForLib
6507
#
6508
# Description:
6509
#       This sub-routine is used to determine the generic name for
6510
#       a library. I.E removes the version number.
6511
#
6512
#       It also checks if the name provided should be excluded from
6513
#       the build.
6514
#
6515
#------------------------------------------------------------------------------
6516
{
6517
   # correct number of parameters?
6518
    if ( ($#_+1) != 1 )
6519
    {
1534 dpurdie 6520
        Error("Incorrect number of params passed to " .
1530 dpurdie 6521
                  "getGenericNameNoVersionForLib() function. Check deploy config.");
6522
    }
6523
 
6524
    # lets just check to see if we can execute this function on
6525
    # this machine.
6526
    #
6527
    if ( "$MachType" ne "sparc" )
6528
    {
1534 dpurdie 6529
        Verbose("getGenericNameNoVersionForLib() not supported on this machine type.");
1530 dpurdie 6530
        return "";
6531
    }
6532
 
6533
 
6534
    my($itemName) = @_;
6535
 
6536
    # first we need to check to see if it belongs in this build
6537
    #
6538
    my ($gName) = "";
6539
    if(excludeItemFromBuild($itemName))
6540
    {
1534 dpurdie 6541
        Verbose("Excluding item [$itemName] from build as not compatible with build type " .
1530 dpurdie 6542
                "[$BuildType].");
6543
        return "";  # file should be excluded.
6544
    }
6545
    else
6546
    {
6547
        $gName = removeVersionNumberFromItemName($itemName);
6548
        return "$gName";
6549
    }
6550
 
6551
    return 1;
6552
}
6553
 
6554
 
6555
#------------------------------------------------------------------------------
6556
sub getGenericNameNoVersionForXML
6557
#
6558
# Description:
6559
#       This sub-routine is used to determine the generic name for
6560
#       an XML file. I.E removes the version number.
6561
#
6562
#------------------------------------------------------------------------------
6563
{
6564
   # correct number of parameters?
6565
    if ( ($#_+1) != 1 )
6566
    {
1534 dpurdie 6567
        Error("Incorrect number of params passed to " .
1530 dpurdie 6568
                  "getGenericNameNoVersionForXML() function. Check deploy config.");
6569
    }
6570
 
6571
    my($itemName) = @_;
6572
    my ($gName) = "";
6573
    $gName = removeVersionNumberFromXMLItemName($itemName);
6574
    return "$gName";
6575
 
6576
    return 1;
6577
}
6578
 
6579
 
6580
#------------------------------------------------------------------------------
6581
sub removeVersionNumberFromXMLItemName
6582
#
6583
#    Description:
6584
#        This sub-routine is used to remove the version number from the item name.
6585
#        i.e.  myFile_1_2_3.xml ==> myFile.xml
6586
#
6587
#    INPUT:
6588
#        item name
6589
#
6590
#    RETURN:
6591
#        new item name.
6592
#
6593
#------------------------------------------------------------------------------
6594
{
6595
    my ($file)  = @_;
6596
    my ($nfile) = $file;
6597
 
6598
    if ( $nfile =~ m/_[0-9]+_[0-9]+_[0-9]+\.xml$/ )
6599
    {
6600
        # if we match lets deal with it.
6601
        $nfile =~ s/_[0-9]+_[0-9]+_[0-9]+\.xml$/\.xml/;
6602
    }
6603
    else
6604
    {
1534 dpurdie 6605
        Warning("Filename [$nfile] does not contain required format [myfile_N_N_N.xml].");
1530 dpurdie 6606
    }
6607
    return "$nfile";
6608
}
6609
 
6610
 
6611
#------------------------------------------------------------------------------
6612
sub createDpkgArchive
6613
#
6614
# Description:
6615
#       This sub-routine is used to create a dpkg_archive directory
6616
#       structure.
6617
#
6618
#------------------------------------------------------------------------------
6619
{
6620
    # correct number of parameters?
6621
    if ( ($#_+1) != 1 )
6622
    {
1534 dpurdie 6623
        Error("Incorrect number of params passed to " .
1530 dpurdie 6624
                  "createDpkgArchive() function. Check deploy config.");
6625
    }
6626
 
6627
    my ($desc) = @_;
6628
 
6629
    # lets just check to see if we can execute this function on
6630
    # for  this build.
6631
    #
6632
    if ( "x$PkgPatchNum" ne "x" )
6633
    {
1534 dpurdie 6634
        Verbose("createDpkgArchive() can only be called during a RELEASE build.");
1530 dpurdie 6635
        return 1;
6636
    }
6637
 
6638
 
6639
    # 1. we create a dpkg_archive top level dir within the output directory
6640
    #
6641
    my ($m_tmpDir) = "$PkgBaseDir/dpkg_archive";
1534 dpurdie 6642
    make_directory( $m_tmpDir, 0777 );
6643
 
1530 dpurdie 6644
    # 2. we create a sub-directory with the package name
6645
    #
6646
    $m_tmpDir = "$PkgBaseDir/dpkg_archive/$TargetBaseDir";
1534 dpurdie 6647
    make_directory( $m_tmpDir, 0777 );
1530 dpurdie 6648
 
6649
    # 3. we create a sub-directory with the package version number
6650
    #
6651
    my ($m_tmpDir2) = "$PkgBaseDir/dpkg_archive/$TargetBaseDir/" .
6652
                      "$PkgVersion" .  "." . "$ProjectAcronym";
1534 dpurdie 6653
    make_directory( $m_tmpDir2, 0777 );
1530 dpurdie 6654
 
6655
 
6656
    # 4. we replacate the contents of the original outputdir/package name
6657
    #    to do this we shall execute a find starting within the original package target dir
6658
    #    any copy all items we find to the new location under the dpkg_archive/package/version dir.
6659
    #
6660
    File::Find::find( \&DpkgFind, "$PkgBaseDir/$TargetBaseDir");
6661
 
6662
 
6663
    # 5. we create a descpkg file, with the Package Name, Version and Desc
6664
    #
6665
    my ($m_DescPkgFile) = "$PkgBaseDir/dpkg_archive/$TargetBaseDir/$PkgVersion\.$ProjectAcronym/descpkg";
6666
 
6667
    # now we need to update the prototype file
6668
    #
6669
    local *FILE;
6670
    open ( FILE, ">> $m_DescPkgFile") or
1534 dpurdie 6671
        Error("Failed to open file [$m_DescPkgFile].");
1530 dpurdie 6672
    printf FILE ("$PkgName, $PkgVersion.$ProjectAcronym - $desc\n");
6673
    close (FILE);
6674
 
6675
 
6676
    # done.
1534 dpurdie 6677
    Information("createDpkgArchive() completed.");
1530 dpurdie 6678
 
6679
    return 1;
6680
}
6681
 
6682
 
6683
#------------------------------------------------------------------------------
6684
sub DpkgFind
6685
#
6686
#    Description:
6687
#        This subroutine is used to locate all associated items to
6688
#        create a new dpkg_archive directory structure. 
6689
#
6690
#------------------------------------------------------------------------------
6691
{
6692
    my($item)= "$File::Find::name";
6693
    my($base)= File::Basename::basename($item);
6694
 
6695
 
6696
    # we get the absolute path from the find, but we only require
6697
    # a relative path from the starting dir.
6698
 
6699
 
6700
    # we need to determine which file we are dealing with
6701
    if ( ! -d "$item")
6702
    {
6703
        my ($m_sfile) = $item;
6704
        $item =~ s/$PkgBaseDir\/$TargetBaseDir/$PkgBaseDir\/dpkg_archive\/$TargetBaseDir\/$PkgVersion\.$ProjectAcronym/;
6705
 
6706
        if(File::Copy::copy("$m_sfile", "$item"))
6707
        {
1534 dpurdie 6708
            Verbose("Copied [$base] to [$item] ...");
1530 dpurdie 6709
        }
6710
        else
6711
        {
1534 dpurdie 6712
            Error("Failed to copy pkg file [$m_sfile] to [$item]: $!");
1530 dpurdie 6713
        }
6714
    }
6715
    else
6716
    {
6717
        # we have found a dir
6718
        my ($m_sDir) = $item;
1534 dpurdie 6719
        $item =~ s~$PkgBaseDir/$TargetBaseDir~$PkgBaseDir/dpkg_archive/$TargetBaseDir/$PkgVersion\.$ProjectAcronym~;
6720
        make_directory( $item, 0777 );
1530 dpurdie 6721
    }
6722
}
6723
 
6724
 
6725
 
6726
 
6727
#------------------------------------------------------------------------------
6728
sub getRmDetails
6729
#
6730
#    Description:
6731
#        This is called to update the RM class objects with details from RM database
6732
#------------------------------------------------------------------------------
6733
{
1534 dpurdie 6734
    #
6735
    #   If this script is invoked by the AutoBuildTool, then we may not be able
6736
    #   to create a Release Note as the RM entry may not be available. More over
6737
    #   the ABT will create a release note as the package is made official
6738
    #
6739
    if ( $autobuild )
6740
    {
6741
        Debug('getRmDetails: AutoBuild Environment supresses function');
6742
        return;
6743
    }
6744
 
6745
 
1530 dpurdie 6746
    if ( ! defined($RmPkgDetails) )
6747
    {
6748
        # Set defaults for elements in RM if not found
6749
        DeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);
6750
        DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);
6751
 
6752
        $RmPkgDetails = DeployUtils::RmPkgInfo->new( 
6753
                                    { PKG_NAME => $PkgName, 
6754
                                      PKG_VERSION => ( "$PkgPatchNum" ne "" ) ? $PkgPatchID : $PkgVersionUser } );
6755
 
6756
        # lets check to see if we got something
6757
        if ( $RmPkgDetails->foundPkg() )
6758
        {
6759
            $RmPvPkgDetails = DeployUtils::RmPkgInfo->new( { PKG_NAME => $PkgName, 
6760
                                                             PKG_VERSION => $PkgPreviousVersionStr } );
6761
            if ( $RmPvPkgDetails->foundDetails() )
6762
            {
1534 dpurdie 6763
                sub MultiLineVerb
6764
                {
6765
                    my ($prefix, $text ) = @_;
6766
                    my $zap = 0;
6767
 
6768
                    foreach my $line ( split /[\r\n]+/, $text  )
6769
                    {
6770
                        Verbose($prefix . "[" . $line . "]");
6771
                        unless ( $zap )
6772
                        {
6773
                            $prefix = ' ' x length($prefix);
6774
                            $zap = 1;
6775
                        }
6776
                    }
6777
                }
6778
 
6779
                Information("Retrieved Package Details from Release Manager");
6780
                if ( IsVerbose(1) )
6781
                {
6782
                    MultiLineVerb("RM pkg_name       = ",  $RmPkgDetails->pkg_name()       );
6783
                    MultiLineVerb("RM pkg_id         = ",  $RmPkgDetails->pkg_id()         );
6784
                    MultiLineVerb("RM pv_id          = ",  $RmPkgDetails->pv_id()          );
6785
                    MultiLineVerb("RM pv_description = ",  $RmPkgDetails->pv_description() );
6786
                    MultiLineVerb("RM pv_overview    = ",  $RmPkgDetails->pv_overview()    );
6787
                    MultiLineVerb("RM pv_reason      = ",  $RmPkgDetails->pv_reason()      );
6788
                    MultiLineVerb("RM pv_label       = ",  $RmPkgDetails->pv_label()       );
6789
                    MultiLineVerb("RM previousPv_id  = ",  $RmPvPkgDetails->pv_id()        );
6790
                    MultiLineVerb("RM pv_dlocked     = ",  $RmPvPkgDetails->pv_dlocked()   );
6791
                }
1530 dpurdie 6792
            }
6793
            else
6794
            {
6795
                # our package does not exist in release manager
1534 dpurdie 6796
                Warning("Could not retrieve package $PkgName $PkgVersionUser previous version " .
1530 dpurdie 6797
                        "details from Release Manager.")
6798
            }
6799
        }
6800
        else
6801
        {
6802
            # our package does not exist in release manager 
1534 dpurdie 6803
            Warning("Package $PkgName $PkgVersionUser does not exist in the Release Manager",
6804
                    "Please check configuration.")
1530 dpurdie 6805
        }
6806
    }
6807
}  
6808
 
6809
 
6810
 
6811
# This is now depricated
6812
sub generateReleaseNote
6813
{
1534 dpurdie 6814
    Error("generateReleaseNote is depricated please use generateHtmlReleaseNote");
1530 dpurdie 6815
    return 1;
6816
}
6817
 
6818
 
6819
 
6820
#------------------------------------------------------------------------------
6821
sub generateHtmlReleaseNote
6822
#
6823
#    Description:
6824
#
6825
#------------------------------------------------------------------------------
6826
{
1532 dpurdie 6827
 
1530 dpurdie 6828
    #
1532 dpurdie 6829
    #   If this script is invoked by the AutoBuildTool, then we may not be able
6830
    #   to create a Release Note as the RM entry may not be available. More over
6831
    #   the ABT will create a release note as the package is made official
6832
    #
6833
    if ( $autobuild )
6834
    {
1534 dpurdie 6835
        Warning('AutoBuild Environment. Release notes generated later');
1532 dpurdie 6836
        return;
6837
    }
6838
 
6839
    #
1530 dpurdie 6840
    #   Ensure the Release directory is present
6841
    #
1534 dpurdie 6842
    make_directory( $ReleaseDir, 0777 );
1530 dpurdie 6843
 
6844
    if ( ! getRmReleaseNote() )
6845
    {
1534 dpurdie 6846
        Error("No Release Manager details, release note not generated.");
1530 dpurdie 6847
    }
6848
}
6849
 
6850
 
6851
 
6852
#------------------------------------------------------------------------------
6853
sub getRmReleaseNote
6854
#
6855
#    Description:
6856
#
6857
#------------------------------------------------------------------------------
6858
{
6859
    # lets get some details for our package
6860
    getRmDetails();
6861
 
6862
 
6863
    # now we need to ensure that our local build file dependencies are
6864
    # the same as those we have entered in the Release Manager database.
6865
    checkDependencies();
6866
 
6867
 
6868
    # let's update the release contents now
6869
    #
6870
    generateProductContents();
6871
 
1538 dpurdie 6872
    #
6873
    #   Is the interface available
6874
    #
6875
    unless ( $UserAgentAvailable )
6876
    {
6877
        Warning("Unable to retrieve Release Manager Release Notes: LWP module missing");
6878
        return 0;
6879
    }
1530 dpurdie 6880
 
1534 dpurdie 6881
    Information("Retrieving Release Notes From Release Manager...Please wait...");
1530 dpurdie 6882
 
6883
    my $user_agent = LWP::UserAgent->new( timeout => 30 );
6884
    my $response = $user_agent->get('http://erg:8002/ManagerSuite/Release_Manager/_adhoc_release_notes.asp?pv_id='. $RmPkgDetails->pv_id(), 
6885
                                    ':content_file' => "$PkgReleaseNote\.html");
6886
    if ( $response->is_success )
6887
    {
1534 dpurdie 6888
        Verbose("Retrieved Release Manager HTML Release note [$PkgReleaseNote\.html]");
1530 dpurdie 6889
        return 1;
6890
    }
6891
    else
6892
    {
1534 dpurdie 6893
        Warning("Unable to retrieve Release Manager Release Notes");
1530 dpurdie 6894
        return 0;
6895
    }
6896
}
6897
 
6898
#------------------------------------------------------------------------------
6899
sub checkDependencies
6900
#
6901
#------------------------------------------------------------------------------
6902
{
6903
    my ($i);
6904
    my ($retValue) = 0;
6905
 
6906
    # first we want to loop through all our local build archives
6907
    # 
6908
    my ($versionStr) = "";
6909
    foreach $i ( $BuildFileInfo->getDpkgArchiveList() )
6910
    {
6911
        my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
6912
 
6913
        $versionStr = "$moduleInfo->{version}"; 
6914
        $versionStr .= "\.$moduleInfo->{proj}" if ( $moduleInfo->{proj} ne "" );
6915
        my $depObj = $RmPkgDetails->getDependencyObject($i);
6916
 
6917
        if ( defined ( $depObj ) )
6918
        {
6919
            if ( $depObj->pkg_version() ne "$versionStr" )
6920
            {
1534 dpurdie 6921
                Warning("Dependency difference, [$i] Local version $versionStr, RM version " . $depObj->pkg_version());
1530 dpurdie 6922
                $retValue = 1;
6923
            }
6924
        }  
6925
        else
6926
        {
1534 dpurdie 6927
            Warning("Dependency difference, [$i] Cannot locate archive in Release Manager database.");
1530 dpurdie 6928
            $retValue = 1;
6929
        }
6930
    }
6931
 
6932
    # lets check to see if we detected a difference 
6933
    if ( $retValue != 0 )
6934
    { 
1534 dpurdie 6935
        Error("Difference detected between the local build.pl and Release Manager config.",
6936
              "Please check Release Manager configuration.");
1530 dpurdie 6937
    }
6938
 
6939
 
6940
 
6941
    # now we check release manager details against our local ones
6942
    #
6943
    foreach $i ( $RmPkgDetails->getDependencyNames() )
6944
    {
6945
        if ( "$i" eq "ishieldlibimg" || "$i" eq "ishieldlibicon" )
6946
        {
6947
            # these two packages are a special case,
6948
            # we do not include them in the dependecy check
6949
            #
6950
            next;
6951
        }
6952
 
6953
        my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
6954
 
6955
        if ( defined ( $moduleInfo ) )
6956
        {
6957
            $versionStr = "$moduleInfo->{version}"; 
6958
            $versionStr .= "\.$moduleInfo->{proj}" if ( $moduleInfo->{proj} ne "" );
6959
            my $depObj = $RmPkgDetails->getDependencyObject($i);
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, cannot locate archive [$i] in local build.pl.");
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 Release Manager config and the local build.pl. ",
6978
               "Please check the local configuration.");
1530 dpurdie 6979
    }
6980
 
6981
    return 1;
6982
}
6983
 
1544 dpurdie 6984
#-------------------------------------------------------------------------------
6985
# Function        : generateXmlDependancy
6986
#
6987
# Description     : Generate an XML file that describes the despendencies of the
6988
#                   released package.
6989
#
6990
#                   The generated file needs to be packaged for deployment. This
6991
#                   function will only create the file. It needs to be added to the
6992
#                   files that are deployed into the field. The file is primarily
6993
#                   to be used by Windows based applications, but its use may be
6994
#                   extended to other platforms.
6995
#
6996
#                   The file 'should' be deployed in the same directory as the main
6997
#                   application executable, so that the executable may locate it.
6998
#
6999
#                   The XML file is named after the package. It is prefixed with
7000
#                   the string "PkgInfo_".
7001
#
7002
#                   By default file will be placed in the 'TargetBaseDir'.
7003
#                   This behaviour may be modified by the user.
7004
#
7005
#                   Refer to package_info.xsd for details on the structure of the
7006
#                   generated XML file. Do not randomly chnage the structure.
7007
#                   It is being used.
7008
#
7009
#                   This function requires access to Release Manager in order
7010
#                   to locate the package description and build-time information
7011
#
7012
#                   The function will use the current/last version of the package
7013
#                   in an attempt to locate package information.
7014
#
7015
#
7016
# Inputs          : platform        - Platforms for which the file will be created
7017
#                                     '*' indicate ALL platforms.
7018
#                   options         - Options to control the detail of the generated file
7019
#
7020
#                   Valid options
7021
#                       --TargetDir         - Symbolic target directory
7022
#                                             Default: TargetBaseDir
7023
#
7024
#                       --Depth=nn          - Depth to traverse the dependancy tree
7025
#                                             All packages below this depth will be ignored
7026
#                                             Default: 0. All packages will be included
7027
#                       --VisibleDepth=nn   - Package beyond this depth will be marked as invisible
7028
#                                             Default: 1. Only top level packages will be marked
7029
#                                             as visible.
7030
#                       --Ignore=name       - Ignore this package
7031
#                                             It will not be included in the dependancy list
7032
#                                             Default: None
7033
#                       --IgnoreChildren=name   - Do not include children of this package\
7034
#                                             Default: None
7035
#                       --Invisible=name    - Mark this package and its dependents as invisible
7036
#                                             Default: None
7037
#                       --InvisibleChildren=name
7038
#                                           - Mark this package as visible, but its dependents as invisible
7039
#                                             Default: None
7040
#
7041
# Example:
7042
#               generateXmlDependancy('*', '--TargetDir=OcpDir' );
7043
#               
7044
#
7045
# Returns         : Nothing
7046
#
7047
sub generateXmlDependancy
7048
{
7049
    my ($platforms, @opts) = @_;
7050
    my %data;
7051
    my $filename = "PkgInfo_$PkgName" . '.xml';
7052
    my $targetTag;
1530 dpurdie 7053
 
1544 dpurdie 7054
    return if ( ! ActivePlatform($platforms) );
7055
    Information("Generating XML dependancy information from RM data: $filename");
1530 dpurdie 7056
 
1544 dpurdie 7057
    #
7058
    #   Insert defaults
7059
    #
7060
    $data{default_visible} = 1;
7061
 
7062
    #
7063
    #   Parse the user options
7064
    #
7065
    foreach ( @opts )
7066
    {
7067
        if ( m/^--Depth=(\d+)/ ) {
7068
            $data{default_depth} = $1;
7069
 
7070
        } elsif ( m/^--VisibleDepth=(\d+)/ ) {
7071
            $data{default_visible} = $1;
7072
 
7073
        } elsif ( m/^--Ignore=(.*)/ ) {
7074
            $data{ignore}{$1} = 1;
7075
 
7076
        } elsif ( m/^--IgnoreChildren=(.*)/ ) {
7077
            $data{ignore_child}{$1} = 1;
7078
 
7079
        } elsif ( m/^--Invisible=(.*)/ ) {
7080
            $data{invisible}{$1} = 1;
7081
 
7082
        } elsif ( m/^--InvisibleChildren=(.*)/ ) {
7083
            $data{invisible_child}{$1} = 1;
7084
 
7085
        } elsif ( m/^--TargetDir=(.*)/ ) {
7086
            $targetTag = $1;
7087
 
7088
        } else {
7089
            Error ("generateXmlDependancy: Unknown option: $_");
7090
        }
7091
    }
7092
 
7093
    #
7094
    #   Sanity Tests
7095
    #
7096
    if ( $data{default_visible} && $data{default_depth} )
7097
    {
7098
        Error ("generateXmlDependancy:Visible depth must be less than total depth")
7099
            if ( $data{default_visible} > $data{default_depth} );
7100
    }
7101
 
7102
    # lets check to see if the target tag exists
7103
    # if does not the process with log an error.
7104
    #
7105
    my $targetValue;
7106
    if ( $targetTag )
7107
    {
7108
        $targetValue = getTargetDstDirValue($targetTag, "A");
7109
    }
7110
    else
7111
    {
7112
        $targetValue = "$PkgBaseDir/$TargetBaseDir";
7113
    }
7114
    $filename = $targetValue . '/' . $filename;
7115
 
7116
 
7117
    #
7118
    #   Determine package information.
7119
    #   Must cater for a number of situations
7120
    #       1) Package rebuild
7121
    #       2) Package ripple
7122
    #       3) New package
7123
    #
7124
 
7125
 
7126
    # Set defaults for elements in RM if not found
7127
    DeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);
7128
    DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);
7129
 
7130
    #
7131
    #   Try with the current package version. It may be in RM
7132
    #
7133
    $RmPkgDetails = DeployUtils::RmPkgInfo->new( {
7134
                        PKG_NAME => $PkgName,
7135
                        PKG_VERSION => $PkgVersionUser,
7136
                        NO_WARN => 1
7137
                    } );
7138
 
7139
    unless ( $RmPkgDetails->foundDetails() && $PkgPreviousVersionStr )
7140
    {
7141
        #
7142
        #   Try with the 'Previous' package
7143
        #
7144
        my $RmPkgDetailsPrev = DeployUtils::RmPkgInfo->new( {
7145
                        PKG_NAME => $PkgName,
7146
                        PKG_VERSION => $PkgPreviousVersionStr,
7147
                        NO_WARN => 1
7148
                    } );
7149
 
7150
        if ( $RmPkgDetailsPrev->foundDetails() )
7151
        {
7152
            Information ("generateXmlDependancy. Using previous version ($PkgPreviousVersionStr)");
7153
            $RmPkgDetails = $RmPkgDetailsPrev;
7154
        }
7155
    }
7156
 
7157
    unless ( $RmPkgDetails->foundDetails() )
7158
    {
7159
        Warning ("generateXmlDependancy. Package Information not in RM. Using defaults");
7160
    }
7161
 
7162
 
7163
    #
7164
    #   %packages   - information on packages that we have discovered
7165
    #   @to_process - An array of packages discovered, but not yet processed
7166
    #
7167
    my @to_process;
7168
 
7169
    #
7170
    #   Create the initial entry in the packages array
7171
    #
7172
    my @deps;
7173
    foreach my $i ( $BuildFileInfo->getDpkgArchiveList() )
7174
    {
7175
        my $moduleInfo = $BuildFileInfo->getDpkgArchiveInfo($i);
7176
        my $tag = join ($;, $i, $moduleInfo->{versionFull} );
7177
        push @deps, $tag;
7178
    }
7179
 
7180
    $data{packages}{$PkgName}{$PkgVersionUser}{date} = $RmPkgDetails->pv_modified_time() || localtime() ;
7181
    $data{packages}{$PkgName}{$PkgVersionUser}{overview} = $RmPkgDetails->pv_description();
7182
    $data{packages}{$PkgName}{$PkgVersionUser}{deps} = [ @deps ] ;
7183
 
7184
 
7185
    push @to_process, @deps;
7186
 
7187
    while ( my $entry = pop @to_process )
7188
    {
7189
        my ($package, $version) = split ( $;, $entry );
7190
 
7191
        #
7192
        #   Extract and save information for this package
7193
        #
7194
        next if ( exists $data{packages}{$package}{$version} );
7195
 
7196
        #
7197
        #   Some packages need to be totally ignored
7198
        #
7199
        next if ( exists $data{ignore}{$package} );
7200
 
7201
        my $RmPkgDetails = DeployUtils::RmPkgInfo->new(
7202
                        {
7203
                            PKG_NAME => $package,
7204
                            PKG_VERSION => $version,
7205
                        } );
7206
        Error ("generateXmlDependancy: Cannot locate base package: $package, $version")
7207
            unless ( $RmPkgDetails->foundPkg() );
7208
 
7209
        #
7210
        #   Determine the dependancies, unless we are ignoring the children too
7211
        #   Do not use the RmPkgInfo class method getDependencyNames to fetch the
7212
        #   dependancy information as this:
7213
        #       1) gets it wrong
7214
        #       2) Extracts a lot of data that we dont want.
7215
        #
7216
        my @deps;
7217
        unless ( exists $data{ignore_child}{$package} )
7218
        {
7219
            my $deps = $RmPkgDetails->getDependenciesHash();
7220
            foreach my $pkg ( keys %{$deps} )
7221
            {
7222
                foreach my $ver ( keys %{$deps->{$pkg}}  )
7223
                {
7224
                    my $tag = join ($;, $pkg, $ver );
7225
                    push @deps, $tag;
7226
                }
7227
            }
7228
        }
7229
 
7230
        $data{packages}{$package}{$version}{date} = $RmPkgDetails->pv_modified_time();
7231
        $data{packages}{$package}{$version}{overview} = $RmPkgDetails->pv_description();
7232
        $data{packages}{$package}{$version}{deps} = [ @deps ] ;
7233
 
7234
        push @to_process, @deps;
7235
    }
7236
#DebugDumpData ("Packages", \%packages);
7237
 
7238
    #
7239
    #   Now walk the tree and generate XML
7240
    #
7241
    sub output_entry
7242
    {
7243
        my ($datap, $depth, $package, $version, $vis ) = @_;
7244
        my $fh = $datap->{fh};
7245
        $depth++;
7246
 
7247
        #
7248
        #   Skip if too deep or an ignored package
7249
        #
7250
        return if ( $datap->{ignore}{$package} );
7251
        return if ( $datap->{default_depth} && $depth > $datap->{default_depth} );
7252
 
7253
        #
7254
        #   Check for invisible packages
7255
        #
7256
        $vis = 0 if ( $datap->{invisible}{$package} );
7257
 
7258
 
7259
        my $indent = "    " x ($depth - 1);
7260
        my $date = $datap->{packages}{$package}{$version}{date};
7261
        my $overview = $datap->{packages}{$package}{$version}{overview};
7262
 
7263
        #
7264
        #   Clean up the overview
7265
        #
7266
        $overview =~ s~\s+$~~;
7267
        $overview =~ s~\r\n~\n~g;
7268
        $overview =~ s~\n\r~\n~g;
7269
 
7270
        #
7271
        #   Determine visibility
7272
        #
7273
        $vis = 0 if ( $datap->{default_visible} && $depth > $datap->{default_visible} );
7274
        my $visible = ( $vis > 0 ) ? 'true' : 'false';
7275
        $vis = 0 if ( $datap->{invisible_child}{$package} );
7276
 
7277
        #
7278
        #   The top level entry is different
7279
        #
7280
        if ( $depth == 0 )
7281
        {
7282
            $indent = "    " ;
7283
            print $fh "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
7284
            print $fh "<ERG_Package xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xsi:noNamespaceSchemaLocation=\"package_info.xsd\" SchemaVersion=\"1.0.0\">\n";
7285
            print $fh "$indent<Package_Name>$package</Package_Name>\n";
7286
            print $fh "$indent<Package_Version>$version</Package_Version>\n";
7287
            print $fh "$indent<Package_Overview>$overview</Package_Overview>\n";
7288
            print $fh "$indent<Build_Date>$date</Build_Date>\n";
7289
        }
7290
        else
7291
        {
7292
            print $fh "${indent}<Package Name=\"$package\" Version=\"$version\" BuildDate=\"$date\" Visible=\"$visible\">\n";
7293
		    print $fh "${indent}    ";
7294
            print $fh "<Overview>${overview}" if ($overview);
7295
		    print $fh "</Overview>\n";
7296
        }
7297
 
7298
        #
7299
        #   Process dependancies
7300
        #
7301
        unless ( $datap->{ignore_child}{$package} )
7302
        {
7303
            foreach my $entry ( @{ $datap->{packages}{$package}{$version}{deps} } )
7304
            {
7305
                my ($package, $version) = split ( $;, $entry );
7306
                output_entry ( $datap, $depth, $package, $version, $vis );
7307
            }
7308
        }
7309
 
7310
        if ( $depth == 0 )
7311
        {
7312
            print $fh "</ERG_Package>\n";
7313
        }
7314
        else
7315
        {
7316
		    print $fh "${indent}</Package>\n";
7317
        }
7318
    }
7319
 
7320
    #
7321
    #   Output the XML header and information about the first package
7322
    #
7323
    Information ( "Creating file $filename" );
7324
    open ( $data{fh}, ">", $filename ) || Error( "Cannot create $filename");
7325
    output_entry ( \%data, -1, $PkgName, $PkgVersionUser, 1 );
7326
    close $data{fh};
7327
 
7328
#    DebugDumpData( "DATA", \%data );
7329
}
7330
 
7331
 
1530 dpurdie 7332
#------------------------------------------------------------------------------
7333
sub createPerlSvcWin32
7334
#
7335
# Description:
7336
#       This sub-routine is used to create a Win32  service 
7337
#       using a PERL script as the input.
7338
#
7339
#       note we assume here that you have installed ther ActiveState PERL
7340
#       developement KIT and have also installed a valid license key.
7341
#
7342
#------------------------------------------------------------------------------
7343
{
7344
    # lets just check to see if we can execute this function on
7345
    # this machine.
7346
    #
7347
    if ( "$MachType" ne "win32" )
7348
    {
1534 dpurdie 7349
        Information("createPerlSvcWin32() not supported on this machine type.");
1530 dpurdie 7350
        return 1;
7351
    }
7352
 
7353
 
7354
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;
7355
 
7356
 
7357
    # lets get the src dir value
7358
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
7359
 
7360
 
7361
    # lets get the lib src dir value
7362
    my (@m_libDirValue) = ();
7363
    my $i;
7364
    my ($_libStr) = "";
7365
    foreach $i ( 0 .. $#m_libDirTags )
7366
    {
7367
        $m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");
7368
        $_libStr = $_libStr . "$m_libDirValue[$i];"
7369
    }
7370
    if ( -d $DpkgScriptsDir )
7371
    {
7372
        $_libStr = $_libStr . "$DpkgScriptsDir";
7373
    }
1534 dpurdie 7374
    Verbose("additional places to look for perl modules, [$_libStr]");
1530 dpurdie 7375
 
7376
 
7377
    # lets get the target dir value
7378
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
7379
 
7380
    # we know where we are getting this from and where we
7381
    # going to put them.
7382
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
7383
 
7384
 
7385
    my ($_cmdStr) = "perlsvc --verbose --lib $_libStr --exe $m_targetDirValue/$m_ofile $m_sfileLoc";
7386
 
7387
 
7388
    # lets execute the package commands.
7389
    my ($retVal);
7390
    $retVal = system("$_cmdStr");
7391
    if ( $retVal != 0 )
7392
    {
1534 dpurdie 7393
        Error("Failed to complete command [$_cmdStr].");
1530 dpurdie 7394
    }
7395
 
7396
    # done.
7397
    return 1;
7398
}
7399
 
7400
 
7401
#------------------------------------------------------------------------------
7402
sub createPerlAppWin32
7403
#
7404
# Description:
7405
#       This sub-routine is used to create a Win32 free-standing application 
7406
#       using a PERL script as the input.
7407
#
7408
#       note we assume here that you have installed ther ActiveState PERL
7409
#       developement KIT and have also installed a valid license key.
7410
#
7411
#------------------------------------------------------------------------------
7412
{
7413
    # lets just check to see if we can execute this function on
7414
    # this machine.
7415
    #
7416
    if ( "$MachType" ne "win32" )
7417
    {
1534 dpurdie 7418
        Information("createPerlAppWin32() not supported on this machine type.");
1530 dpurdie 7419
        return 1;
7420
    }
7421
 
7422
 
7423
    my ($m_srcDirTag, $m_sfile, $m_targetDirTag, $m_ofile, @m_libDirTags) = @_;
7424
 
7425
 
7426
    # lets get the src dir value
7427
    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");
7428
 
7429
 
7430
    # lets get the lib src dir value
7431
    my (@m_libDirValue) = ();
7432
    my $i;
7433
    my ($_libStr) = "";
7434
    foreach $i ( 0 .. $#m_libDirTags )
7435
    {
7436
        $m_libDirValue[$i] = getLocalDirValue($m_libDirTags[$i], "A");
7437
        $_libStr = $_libStr . "$m_libDirValue[$i];"
7438
    }
7439
    if ( -d $DpkgScriptsDir )
7440
    {
7441
        $_libStr = $_libStr . "$DpkgScriptsDir";
7442
    }
1534 dpurdie 7443
    Verbose("additional places to look for perl modules, [$_libStr]");
1530 dpurdie 7444
 
7445
 
7446
    # lets get the target dir value
7447
    my ($m_srcDirValue) = getLocalDirValue($m_srcDirTag, "A");
7448
 
7449
    # we know where we are getting this from and where we
7450
    # going to put them.
7451
    my ($m_sfileLoc) = "$m_srcDirValue/$m_sfile";
7452
 
7453
 
7454
    my ($_cmdStr) = "perlapp --verbose --clean --force --lib $_libStr --exe $m_targetDirValue/$m_ofile --script $m_sfileLoc";
7455
 
7456
 
7457
    # lets execute the package commands.
7458
    my ($retVal);
7459
    $retVal = system("$_cmdStr");
7460
    if ( $retVal != 0 )
7461
    {
1534 dpurdie 7462
        Error("Failed to complete command [$_cmdStr].");
1530 dpurdie 7463
    }
7464
 
7465
    # done.
7466
    return 1;
7467
}
7468
 
7469
 
7470
#------------------------------------------------------------------------------
7471
sub generateProductContents
7472
#
7473
#------------------------------------------------------------------------------
7474
{
7475
    if ( ! defined($RmPkgDetails) )
7476
    {
7477
        # Set defaults for elements in RM if not found
7478
        DeployUtils::RmPkgInfo->DefaultDescription($PkgDesc);
7479
        DeployUtils::RmPkgInfo->DefaultLabel($PkgLabel);
7480
 
7481
        $RmPkgDetails = DeployUtils::RmPkgInfo->new( 
7482
                        {
7483
                            PKG_NAME => $PkgName,
7484
                            PKG_VERSION => ( "$PkgPatchNum" ne "" ) ? $PkgPatchID : $PkgVersionUser
7485
                        } );
7486
    }
7487
 
7488
 
7489
    # we only go on if we have a pkg 
7490
    if ( $RmPkgDetails->foundPkg() )
7491
    {
7492
        # lets zap the product contents
7493
        # only if the release manager entry is not locked.
7494
        if ( $RmPkgDetails->pv_dlocked() ne "Y" )
7495
        {
1534 dpurdie 7496
           Error("Failed to zap product contents.")
1530 dpurdie 7497
                if ( ! $RmPkgDetails->zapProductContents( $Platform ) );
7498
        }
7499
 
7500
 
7501
        # lets get a listing of the products contents
7502
        #
7503
        File::Find::find( \&ProductContentsFind, "$PkgBaseDir/$TargetBaseDir");
7504
    }
7505
    else
7506
    {
1534 dpurdie 7507
        Warning("Unable to load product contents because we do not have a connection to Release Manager.");
1530 dpurdie 7508
    }
7509
 
7510
 
7511
    # done
7512
    return 1;
7513
}
7514
 
7515
 
7516
#------------------------------------------------------------------------------
7517
sub ProductContentsFind
7518
#
7519
#    Description:
7520
#        This subroutine is used to locate all associated items that 
7521
#        have been designated for the product.
7522
#
7523
#------------------------------------------------------------------------------
7524
{
7525
    my($item)= "$File::Find::name";
7526
    my($base)= File::Basename::basename($item);
7527
 
7528
 
7529
    # we get the absolute path from the find, but we only require
7530
    # a relative path from the starting dir.
7531
 
7532
    my ($_item)   = $item;
7533
    my ($_subStr) = "$PkgBaseDir\/$TargetBaseDir";
7534
    $_item =~ s/$_subStr//;
7535
 
7536
    my $cksumStr;
7537
    my $cksumValue;
7538
    my $cksumSize;
7539
    my $cksumName;
7540
    my $_tmpStr;
7541
    my $retVal;
7542
    my $cksumPath;
7543
 
7544
    if ( "$base" ne "." && "$base" ne ".." && "x$_item" ne "x" )
7545
    {
7546
        $_item =~ s/^\///;
7547
        $cksumPath = $_item;
7548
        $cksumName = File::Basename::basename($_item);
7549
 
7550
        # we need to determine which file we are dealing with
7551
        if ( ! -d "$item")
7552
        {
7553
            $cksumStr  = `cksum "$item"`;
7554
            $retVal    = $? / 256;
7555
            if ( $retVal != 0 )
7556
            {
1534 dpurdie 7557
                Error("Failed to determine cksum for product content item [$item].") 
1530 dpurdie 7558
            }
7559
            else
7560
            {
7561
                chomp($cksumStr);
7562
                $cksumStr =~ s/^\s+|\s+$//g;
7563
                if ( $cksumStr =~ m/^([0-9]*)\s*([0-9]*)\s*(.*)$/ )
7564
                {
7565
                    ($cksumValue, $cksumSize, $_tmpStr) = ($1, $2, $3);
7566
                    $cksumValue =~ s/^\s+|\s+$//g;
7567
                    $cksumSize  =~ s/^\s+|\s+$//g;
7568
                    $_tmpStr    =~ s/^\s+|\s+$//g;
7569
                }
7570
                else
7571
                {
7572
                    $cksumValue = '';
7573
                    $cksumSize  = 0;
7574
                    $_tmpStr    = '';
7575
                }
7576
            }
7577
 
7578
            $cksumPath = File::Basename::dirname($_item);
7579
            if ( $cksumPath eq "." )
7580
            {
7581
                $cksumPath = '';
7582
            }
7583
            else
7584
            {
7585
                $cksumPath =~ s/$/\//;
7586
            }
7587
 
7588
            # we only mess with the product contents
7589
            # if the package is not released.
7590
            if ( $RmPkgDetails->pv_dlocked() ne "Y" )
7591
            {
1534 dpurdie 7592
                Error("Failed to insert product content item.")
1530 dpurdie 7593
                     if ( ! $RmPkgDetails->insertProductContentItem( $Target, $cksumPath, $cksumName, '', $cksumSize, $cksumValue) );
7594
            }
7595
            else
7596
            {
1534 dpurdie 7597
                Verbose("product item - $Target, $cksumPath, $cksumName, '', $cksumSize, $cksumValue");
1530 dpurdie 7598
            }
7599
        }
7600
        else
7601
        {
7602
            $cksumPath =~ s/$/\//;
7603
            if ( $RmPkgDetails->pv_dlocked() ne "Y" )
7604
            {
1534 dpurdie 7605
               Error("Failed to insert product content item.")
1530 dpurdie 7606
                     if ( ! $RmPkgDetails->insertProductContentItem( $Target, $cksumPath, '', '', 0, '') );
7607
            }
7608
            else
7609
            {
1534 dpurdie 7610
                Verbose("product dir - $Target, $cksumPath, '', '', 0, ''");
1530 dpurdie 7611
            }
7612
        }
7613
    }
7614
}
7615
 
1534 dpurdie 7616
#-------------------------------------------------------------------------------
7617
# Function        : make_directory
7618
#
7619
# Description     : Create a directory if it does not already exist
7620
#                   Simple function to provide user messages on the way
7621
#                   Will create a complete path. There is no need to
7622
#                   break it into bits.
7623
#
7624
# Inputs          : name        - path to the directory
7625
#                   umask       - umask
7626
#                   text        - User text (optional)
7627
#
7628
# Returns         :
7629
#
7630
 
7631
sub make_directory
7632
{
7633
    my ($name, $umask, $text ) = @_;
7634
 
7635
    Error ("make_directory needs a umask") unless ( $umask );
7636
    Error ("make_directory needs a path") unless ( $name );
7637
    $text = "Create directory"  unless ( $text );
7638
 
7639
    my $umask_text = sprintf( "0%o", $umask );
7640
 
7641
    unless ( -d $name )
7642
    {
7643
        Verbose ( "$text: $name [$umask_text]");
7644
        mkpath ( $name, 0, $umask);
7645
    }
7646
    else
7647
    {
7648
        Verbose2 ( "$text: $name [$umask_text] - already exists");
7649
    }
7650
}
7651
 
1544 dpurdie 7652
 
7653
#-------------------------------------------------------------------------------
7654
# Function        : ActivePlatform
7655
#
7656
# Description     : Determine if the specified platform is currently 'active'
7657
#                   This is used by all user directives in order to determine
7658
#                   if the directive should be ignored for the current platform
7659
#
7660
# Inputs          : $platform_spec      - A (simple)platform specifier
7661
#
7662
# Returns         : TRUE if the platform spec contains the current platform
7663
#
7664
sub ActivePlatform
7665
{
7666
    my( $platform_spec ) = @_;
7667
 
7668
    Error ("No platform specified in some directive") unless ( $platform_spec );
7669
 
7670
    #
7671
    #   Wild card
7672
    #
7673
    return 1 if ( $platform_spec eq '*' );
7674
 
7675
    #
7676
    #   Simple test
7677
    #
7678
    foreach ( split (',', $platform_spec))
7679
    {
7680
        return 1 if ( $_ eq $Platform );
7681
    }
7682
 
7683
    #
7684
    #   Not for me
7685
    #
7686
    return 0;
7687
}
7688
 
1530 dpurdie 7689
#------------------------------------------------------------------------------
7690
1;