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