Subversion Repositories DevTools

Rev

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

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