Subversion Repositories DevTools

Rev

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