Subversion Repositories DevTools

Rev

Rev 1598 | Rev 1602 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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