Subversion Repositories DevTools

Rev

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