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