Subversion Repositories DevTools

Rev

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