Subversion Repositories DevTools

Rev

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