Subversion Repositories DevTools

Rev

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

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